From gitlab at gitlab.haskell.org Sat Jul 1 09:35:21 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 01 Jul 2023 05:35:21 -0400 Subject: [Git][ghc/ghc][wip/supersven/imulMayOflo_x86] Add test(s) for %mulmayoflo primop Message-ID: <649ff35978294_238a8e18d3cfbc5100f@gitlab.mail> Sven Tennie pushed to branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC Commits: 34029a7d by Sven Tennie at 2023-07-01T09:33:42+00:00 Add test(s) for %mulmayoflo primop One test checks the minimal contract (see MulMayOflo.hs), the other checks a perfect implementation. - - - - - 4 changed files: - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - + testsuite/tests/codeGen/should_run/MulMayOflo_minimal.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +{- + N.B. the contract of '%mulmayoflo' is a bit weak: "Return non-zero if there is + any possibility that the signed multiply of a and b might overflow. Return zero + only if you are absolutely sure that it won't overflow. If in doubt, return + non-zero." (Stg.h) + + So, this test is split into two parts: + - the minimal contract + - for architectures which have a perfect implementation, also assert that + The decission which variant to run is made in `all.T`. +-} + +module Main where + +import GHC.Exts + +-- The argument and return types are unimportant: They're only used to force +-- evaluation, but carry no information. +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm ===================================== @@ -0,0 +1,98 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_minimal.cmm ===================================== @@ -0,0 +1,39 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,18 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) + +test('MulMayOflo_minimal', + [extra_files(['MulMayOflo.hs']),ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_minimal.cmm', '')], '']) +test('MulMayOflo_full', + [ extra_files(['MulMayOflo.hs']), + when(unregisterised(), skip), + unless(arch('x86_64') or arch('i386') + or arch('aarch64') + or arch('powerpc') or arch('powerpc64'), + skip), + ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34029a7d2a4f3ea48c9a47f3dcc8a0a1ac1e2ea7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34029a7d2a4f3ea48c9a47f3dcc8a0a1ac1e2ea7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 13:30:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 09:30:42 -0400 Subject: [Git][ghc/ghc][wip/T23577] hadrian: Only pass -Wno-nonportable-include-path on Darwin Message-ID: <64a02a82c2e0_238a8e18d3cfbc5243f8@gitlab.mail> Ben Gamari pushed to branch wip/T23577 at Glasgow Haskell Compiler / GHC Commits: 0a27f0ec by Ben Gamari at 2023-07-01T09:29:25-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 1 changed file: - hadrian/src/Settings/Warnings.hs Changes: ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -2,6 +2,7 @@ module Settings.Warnings (defaultGhcWarningsArgs, ghcWarningsArgs) where import Expression import Oracles.Flag +import Oracles.Setting (isOsxTarget, isWinTarget) import Packages -- See @mk/warnings.mk@ for warning-related arguments in the Make build system. @@ -12,7 +13,11 @@ defaultGhcWarningsArgs = mconcat [ notStage0 ? arg "-Wnoncanonical-monad-instances" , notM (flag CcLlvmBackend) ? arg "-optc-Wno-error=inline" , flag CcLlvmBackend ? arg "-optc-Wno-unknown-pragmas" - , arg "-optP-Wno-nonportable-include-path" -- #17798 + -- Cabal can seemingly produce filepaths with incorrect case on filesystems + -- with case-insensitive names. Ignore such issues for now as they seem benign. + -- See #17798. + , isOsxTarget ? arg "-optP-Wno-nonportable-include-path" + , isWinTarget ? arg "-optP-Wno-nonportable-include-path" ] -- | Package-specific warnings-related arguments, mostly suppressing various warnings. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a27f0ec18e703986dc121e19c684cf9fda159d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a27f0ec18e703986dc121e19c684cf9fda159d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 13:44:51 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 09:44:51 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 11 commits: Define FFI_GO_CLOSURES Message-ID: <64a02dd345622_238a8e18f7fff452517c@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7c1e31d6 by Ben Gamari at 2023-07-01T09:43:55-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 894d4ea8 by Ben Gamari at 2023-07-01T09:44:30-04:00 Drop circle-ci-job.sh - - - - - da5a642d by Ben Gamari at 2023-07-01T09:44:30-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 0073a6bf by Ben Gamari at 2023-07-01T09:44:30-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - compiler/GHC/Driver/CodeOutput.hs - hadrian/src/Flavour.hs - hadrian/src/Rules/Documentation.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/Schedule.c - rts/Sparks.c - rts/Trace.h - rts/TraverseHeap.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/GC.c - rts/sm/NonMoving.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bdc8b135cbc079b415837c2c412e1df5372fa69...0073a6bf19b0f3c947b81adc62c57df1c24a1710 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3bdc8b135cbc079b415837c2c412e1df5372fa69...0073a6bf19b0f3c947b81adc62c57df1c24a1710 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 13:45:31 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 09:45:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/opaque-occset Message-ID: <64a02dfbb81d2_238a8e280c5805257d1@gitlab.mail> Ben Gamari pushed new branch wip/opaque-occset at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/opaque-occset You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 13:45:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 09:45:44 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 14 commits: Define FFI_GO_CLOSURES Message-ID: <64a02e08df797_238a8e280c58052593a@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7c1e31d6 by Ben Gamari at 2023-07-01T09:43:55-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 894d4ea8 by Ben Gamari at 2023-07-01T09:44:30-04:00 Drop circle-ci-job.sh - - - - - da5a642d by Ben Gamari at 2023-07-01T09:44:30-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 0073a6bf by Ben Gamari at 2023-07-01T09:44:30-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 3d343e1a by Ben Gamari at 2023-07-01T09:44:53-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 623b1158 by Ben Gamari at 2023-07-01T09:45:38-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 2a6ac260 by Ben Gamari at 2023-07-01T09:45:38-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Flavour.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/Schedule.c - rts/Sparks.c - rts/Trace.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e0c11f65c1ae36db50e54001e3645f36a7f8ed7...2a6ac260caaf1dfd4f7874646c5efd24a9572bc1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e0c11f65c1ae36db50e54001e3645f36a7f8ed7...2a6ac260caaf1dfd4f7874646c5efd24a9572bc1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 14:31:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 10:31:03 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch` Message-ID: <64a038a78a832_238a8e1e64f8d45286c1@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: 91333a91 by Ben Gamari at 2023-07-01T10:30:51-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 22 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - + compiler/GHC/Utils/Touch.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Settings/Default.hs - m4/fp_settings.m4 - − utils/touchy/Makefile - − utils/touchy/touchy.c - − utils/touchy/touchy.cabal Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -259,6 +259,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Utils.Touch import qualified GHC.LanguageExtensions as LangExt @@ -269,7 +270,6 @@ import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) import GHC.Data.Maybe -import qualified GHC.SysTools import GHC.SysTools (initSysTools) import GHC.SysTools.BaseDir (findTopDir) @@ -1262,7 +1262,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do -- .hie files. let hie_file = ml_hie_file mod_location whenM (doesFileExist hie_file) $ - GHC.SysTools.touch logger dflags "Touching hie file" hie_file + GHC.Utils.Touch.touch hie_file else -- See Note [Strictness in ModIface] forceModIface iface ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -72,6 +72,7 @@ import System.IO import GHC.Linker.ExtraObj import GHC.Linker.Dynamic import GHC.Utils.Panic +import GHC.Utils.Touch import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder @@ -363,14 +364,10 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- | Run the JS Backend postHsc phase. runJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath -runJsPhase _pipe_env hsc_env _location input_fn = do - let dflags = hsc_dflags hsc_env - let logger = hsc_logger hsc_env - +runJsPhase _pipe_env _hsc_env _location input_fn = do -- The object file is already generated. We only touch it to ensure the -- timestamp is refreshed, see Note [JS Backend .o file procedure]. - touchObjectFile logger dflags input_fn - + touchObjectFile input_fn return input_fn -- | Deal with foreign JS files (embed them into .o files) @@ -552,7 +549,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - HsBootFile -> touchObjectFile logger dflags o_file + HsBootFile -> touchObjectFile o_file HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" -- MP: I wonder if there are any lurking bugs here because we @@ -1148,10 +1145,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do -touchObjectFile :: Logger -> DynFlags -> FilePath -> IO () -touchObjectFile logger dflags path = do +touchObjectFile :: FilePath -> IO () +touchObjectFile path = do createDirectoryIfMissing True $ takeDirectory path - GHC.SysTools.touch logger dflags "Touching object file" path + GHC.Utils.Touch.touch path -- Note [-fPIC for assembler] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_l, sPgm_lm, sPgm_dll, - sPgm_T, sPgm_windres, sPgm_ar, sPgm_ranlib, @@ -137,7 +136,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_dll, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags -pgm_T :: DynFlags -> String -pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Settings , sPgm_l , sPgm_lm , sPgm_dll - , sPgm_T , sPgm_windres , sPgm_ar , sPgm_otool @@ -111,7 +110,6 @@ data ToolSettings = ToolSettings -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String , toolSettings_pgm_otool :: String @@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings sPgm_dll :: Settings -> (String, [Option]) sPgm_dll = toolSettings_pgm_dll . sToolSettings -sPgm_T :: Settings -> String -sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String sPgm_windres = toolSettings_pgm_windres . sToolSettings sPgm_ar :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -125,8 +125,6 @@ initSettings top_dir = do install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" - touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -191,7 +189,6 @@ initSettings top_dir = do , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) - , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path , toolSettings_pgm_otool = otool_path ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do mb_env <- getGccEnv cc_args runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env -touch :: Logger -> DynFlags -> String -> String -> IO () -touch logger dflags purpose arg = traceSystoolCommand logger "touch" $ - runSomething logger purpose (pgm_T dflags) [FileOption "" arg] ===================================== compiler/GHC/Utils/Touch.hs ===================================== @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} + +module GHC.Utils.Touch (touch) where + +import GHC.Prelude + +#if defined(mingw32_HOST_OS) +import System.Win32.File +import System.Win32.Time +#else +import System.Posix.Files +import System.Posix.IO +#endif + +-- | Set the mtime of the given file to the current time. +touch :: FilePath -> IO () +touch file = do +#if defined(mingw32_HOST_OS) + hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing + t <- getSystemTimeAsFileTime + setFileTime hdl Nothing Nothing (Just t) + closeHandle hdl +#else +#if MIN_VERSION_unix(2,8,0) + let oflags = defaultFileFlags { noctty = True, creat = Just 0o666 } + fd <- openFd file WriteOnly oflags +#else + let oflags = defaultFileFlags { noctty = True } + fd <- openFd file WriteOnly (Just 0o666) oflags +#endif + touchFd fd + closeFd fd +#endif + ===================================== compiler/ghc.cabal.in ===================================== @@ -902,6 +902,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== hadrian/bindist/Makefile ===================================== @@ -102,7 +102,6 @@ lib/settings : config.mk @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsTouchCommand = @SettingsTouchCommand@ SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ -settings-touch-command = @SettingsTouchCommand@ settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -236,7 +236,6 @@ instance H.Builder Builder where pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the @@ -245,7 +244,6 @@ instance H.Builder Builder where return $ [ unlitPath ] ++ ghcdeps - ++ [ touchyPath | windowsHost ] ++ [ root -/- mingwStamp | windowsHost ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -49,8 +49,8 @@ class ShakeValue b => Builder b where -- capture the @stdout@ result and return it. askBuilderWith :: b -> BuildInfo -> Action String - -- | Runtime dependencies of a builder. For example, on Windows GHC requires - -- the utility @touchy.exe@ to be available on a specific path. + -- | Runtime dependencies of a builder. For example, GHC requires the + -- utility @unlit@ to be available on a specific path. runtimeDependencies :: b -> Action [FilePath] runtimeDependencies _ = return [] ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -125,7 +125,6 @@ data SettingsFileSetting | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand @@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -40,7 +40,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, - terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, + terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package @@ -117,7 +117,6 @@ terminfo = lib "terminfo" text = lib "text" time = lib "time" timeout = util "timeout" `setPath` "testsuite/timeout" -touchy = util "touchy" transformers = lib "transformers" unlit = util "unlit" unix = lib "unix" @@ -192,12 +191,12 @@ programName Context {..} = do -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context at Context {..} = do - -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of - -- @bin@, which is likely just a historical accident that should be fixed. - -- See: https://github.com/snowleopard/hadrian/issues/570 - -- Likewise for @iserv@ and @unlit at . + -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory + -- instead of @bin@, which is likely just a historical accident that should + -- be fixed. See: + -- https://github.com/snowleopard/hadrian/issues/570 name <- programName context - path <- if package `elem` [iserv, touchy, unlit] + path <- if package `elem` [iserv, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage return $ path -/- name <.> exe @@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) -- TODO: Combine this with 'programName'. -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -461,7 +461,6 @@ generateSettings = do , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do (True, s) | s > stage0InTree -> do srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -105,7 +105,6 @@ stage0Packages = do ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] - ++ [ touchy | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] @@ -155,9 +154,8 @@ stage1Packages = do , runGhc ] , when (winTarget && not cross) - [ touchy - -- See Note [Hadrian's ghci-wrapper package] - , ghciWrapper + [ -- See Note [Hadrian's ghci-wrapper package] + ghciWrapper ] ] @@ -185,16 +183,14 @@ defaultLibraryWays = Set.fromList <$> defaultRtsWays :: Ways defaultRtsWays = Set.fromList <$> mconcat - [ pure [vanilla] + [ pure [vanilla, threaded] , notStage0 ? pure - [ profiling, debugProfiling - , debug + [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling + , debug, threadedDebug ] - , notStage0 ? targetSupportsThreadedRts ? pure [threaded, threadedProfiling, threadedDebugProfiling, threadedDebug] , notStage0 ? platformSupportsSharedLibs ? pure - [ dynamic, debugDynamic + [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] - , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure [ threadedDynamic, threadedDebugDynamic ] ] -- TODO: Move C source arguments here ===================================== m4/fp_settings.m4 ===================================== @@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS], SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' else # This case handles the "normal" platforms (e.g. not Windows) where we @@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="$WindresCmd" fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi - if test "$EnableDistroToolchain" = "YES"; then # If the user specified --enable-distro-toolchain then we just use the # executable names, not paths. @@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) ===================================== utils/touchy/Makefile deleted ===================================== @@ -1,37 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -# -# Substitute for 'touch' on win32 platforms (without an Unix toolset installed). -# -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=touchy.c -C_PROG=touchy -SRC_CC_OPTS += -O - -# -# Install touchy in lib/.* -# -INSTALL_LIBEXECS += $(C_PROG) - -include $(TOP)/mk/target.mk - -# Get it over with! -boot :: all - -binary-dist: - $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy - $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/ - $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/ - ===================================== utils/touchy/touchy.c deleted ===================================== @@ -1,123 +0,0 @@ -/* - * Simple 'touch' program for Windows - * - */ -#if !defined(_WIN32) -#error "Win32-only, the platform you're using is supposed to have 'touch' already." -#else -#include -#include -#include -#include -#include -#include -#include - -/* -touch is used by GHC both during building and during compilation of -Haskell files. Unfortunately this means we need a 'touch' like program -in the GHC bindist. Since touch is not standard on Windows and msys2 -doesn't include a mingw-w64 build of coreutils we need touchy for now. - -With Windows 7 in a virtual box VM on OS X, some very odd things happen -with dates and time stamps when SSHing into cygwin. e.g. here the -"Change" time is in the past: - -$ date; touch foo; stat foo -Fri Dec 2 16:58:07 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:58:07.414457900 +0000 -Modify: 2011-12-02 16:58:07.414457900 +0000 -Change: 2011-12-02 16:58:03.495141800 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - -And if we copy such a file, then the copy is older (as determined by the -"Modify" time) than the original: - -$ date; touch foo; stat foo; cp foo bar; stat bar -Fri Dec 2 16:59:10 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:10.118457900 +0000 -Modify: 2011-12-02 16:59:10.118457900 +0000 -Change: 2011-12-02 16:59:06.189477700 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - File: `bar' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:06.394555800 +0000 -Modify: 2011-12-02 16:59:06.394555800 +0000 -Change: 2011-12-02 16:59:06.395532400 +0000 - Birth: 2011-12-02 16:58:40.921899600 +0000 - -This means that make thinks that things are out of date when it -shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS -infinite-recursion test triggers. - -The touchy program, like most other programs, creates files with both -Modify and Change in the past, which is still a little odd, but is -consistent, so doesn't break make. - -We used to use _utime(argv[i],NULL)) to set the file modification times, -but after a BST -> GMT change this started giving files a modification -time an hour in the future: - -$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile -Tue, Oct 30, 2012 11:33:06 PM - File: `testfile' - Size: 0 Blocks: 0 IO Block: 65536 regular empty file -Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1 -Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2012-10-31 00:33:06.000000000 +0000 -Modify: 2012-10-31 00:33:06.000000000 +0000 -Change: 2012-10-30 23:33:06.769118900 +0000 - Birth: 2012-10-30 23:33:06.769118900 +0000 - -so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime. -*/ - -int -main(int argc, char** argv) -{ - int i; - FILETIME ft; - BOOL b; - HANDLE hFile; - - if (argc == 1) { - fprintf(stderr, "Usage: %s \n", argv[0]); - return 1; - } - - for (i = 1; i < argc; i++) { - hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, - FILE_ATTRIBUTE_NORMAL, NULL); - if (hFile == INVALID_HANDLE_VALUE) { - fprintf(stderr, "Unable to open %s\n", argv[i]); - exit(1); - } - GetSystemTimeAsFileTime(&ft); - b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft); - if (b == 0) { - fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]); - exit(1); - } - b = CloseHandle(hFile); - if (b == 0) { - fprintf(stderr, "Closing failed for %s\n", argv[i]); - exit(1); - } - } - - return 0; -} -#endif ===================================== utils/touchy/touchy.cabal deleted ===================================== @@ -1,15 +0,0 @@ -cabal-version: 2.2 -Name: touchy -Version: 0.1 -Copyright: XXX -License: BSD-3-Clause -Author: XXX -Maintainer: XXX -Synopsis: @touch@ for windows -Description: XXX -Category: Development -build-type: Simple - -Executable touchy - Default-Language: Haskell2010 - Main-Is: touchy.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91333a9108701b0e069771707962ff4f2c8f6f7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91333a9108701b0e069771707962ff4f2c8f6f7d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:24:46 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 01 Jul 2023 11:24:46 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-comb2] EPA: Simplify GHC/Parser.y comb2 Message-ID: <64a0453e2db95_238a8e280c5805330cd@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-comb2 at Glasgow Haskell Compiler / GHC Commits: e0d8d292 by Alan Zimmerman at 2023-07-01T16:24:24+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 3 changed files: - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -14,6 +14,7 @@ {-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- For the HasLoc instances {- Main functions for .hie file generation @@ -541,43 +542,26 @@ bax (x :: a) = ... -- a is in scope here This case in handled in the instance for HsPatSigType -} -class HasLoc a where - -- ^ conveniently calculate locations for things without locations attached - loc :: a -> SrcSpan - instance HasLoc thing => HasLoc (PScoped thing) where - loc (PS _ _ _ a) = loc a - -instance HasLoc (Located a) where - loc (L l _) = l - -instance HasLoc (LocatedA a) where - loc (L la _) = locA la - -instance HasLoc (LocatedN a) where - loc (L la _) = locA la - -instance HasLoc a => HasLoc [a] where - loc [] = noSrcSpan - loc xs = foldl1' combineSrcSpans $ map loc xs + getHasLoc (PS _ _ _ a) = getHasLoc a instance HasLoc a => HasLoc (DataDefnCons a) where - loc = loc . toList + getHasLoc = getHasLocList . toList instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where - loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of + getHasLoc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of HsOuterImplicit{} -> - foldl1' combineSrcSpans [loc a, loc b, loc c] + foldl1' combineSrcSpans [getHasLoc a, getHasLocList b, getHasLoc c] HsOuterExplicit{hso_bndrs = tvs} -> - foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c] + foldl1' combineSrcSpans [getHasLoc a, getHasLocList tvs, getHasLocList b, getHasLoc c] instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg p tm ty) where - loc (HsValArg tm) = loc tm - loc (HsTypeArg _ ty) = loc ty - loc (HsArgPar sp) = sp + getHasLoc (HsValArg tm) = getHasLoc tm + getHasLoc (HsTypeArg _ ty) = getHasLoc ty + getHasLoc (HsArgPar sp) = sp instance HasLoc (HsDataDefn GhcRn) where - loc def@(HsDataDefn{}) = loc $ dd_cons def + getHasLoc def@(HsDataDefn{}) = getHasLoc $ dd_cons def -- Only used for data family instances, so we only need rhs -- Most probably the rest will be unhelpful anyway @@ -1370,7 +1354,7 @@ instance ( ToHie (RFContext label) ) => ToHie (RContext (LocatedA (HsFieldBind label arg))) where toHie (RC c (L span recfld)) = concatM $ makeNode recfld (locA span) : case recfld of HsFieldBind _ label expr _ -> - [ toHie $ RFC c (getRealSpan $ loc expr) label + [ toHie $ RFC c (getRealSpan $ getHasLoc expr) label , toHie expr ] @@ -1514,7 +1498,7 @@ instance ToHie (LocatedA (TyClDecl GhcRn)) where where context_scope = mkLScopeA $ fromMaybe (noLocA []) context rhs_scope = foldl1' combineScopes $ map mkScope - [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps] + [ getHasLocList deps, getHasLocList sigs, getHasLocList (bagToList meths), getHasLocList typs, getHasLocList deftyps] instance ToHie (LocatedA (FamilyDecl GhcRn)) where toHie (L span decl) = concatM $ makeNodeA decl span : case decl of @@ -1567,14 +1551,14 @@ instance ToHie (TScoped (FamEqn GhcRn (LocatedA (HsType GhcRn)))) where instance (ToHie rhs, HasLoc rhs) => ToHie (FamEqn GhcRn rhs) where toHie fe@(FamEqn _ var outer_bndrs pats _ rhs) = concatM $ - [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var + [ toHie $ C (Decl InstDec $ getRealSpan $ getHasLoc fe) var , toHie $ TVS (ResolvedScopes []) scope outer_bndrs , toHie pats , toHie rhs ] where scope = combineScopes patsScope rhsScope - patsScope = mkScope (loc pats) - rhsScope = mkScope (loc rhs) + patsScope = mkScope (getHasLocList pats) + rhsScope = mkScope (getHasLoc rhs) instance ToHie (LocatedAn NoEpAnns (InjectivityAnn GhcRn)) where toHie (L span ann) = concatM $ makeNodeA ann span : case ann of @@ -1677,14 +1661,14 @@ instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsSigType GhcRn)))) wh [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names , toHie $ TS sc a ] - where span = loc a + where span = getHasLoc a instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsType GhcRn)))) where toHie (TS sc (HsWC names a)) = concatM $ [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names , toHie a ] - where span = loc a + where span = getHasLoc a instance ToHie (LocatedA (StandaloneKindSig GhcRn)) where toHie (L sp sig) = concatM [makeNodeA sig sp, toHie sig] @@ -1855,7 +1839,7 @@ instance ToHie (TScoped (LHsQTyVars GhcRn)) where , toHie $ tvScopes sc NoScope vars ] where - varLoc = loc vars + varLoc = getHasLocList vars bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where @@ -1867,7 +1851,7 @@ instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where instance ToHie (LocatedA (ConDeclField GhcRn)) where toHie (L span field) = concatM $ makeNode field (locA span) : case field of ConDeclField _ fields typ doc -> - [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields + [ toHie $ map (RFC RecFieldDecl (getRealSpan $ getHasLoc typ)) fields , toHie typ , toHie doc ] ===================================== compiler/GHC/Parser.y ===================================== @@ -1030,7 +1030,7 @@ export :: { OrdList (LIE GhcPs) } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) - ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 (reLoc loc)) $1) $2 } + ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) @@ -1115,7 +1115,7 @@ importdecls importdecls_semi :: { [LImportDecl GhcPs] } importdecls_semi : importdecls_semi importdecl semis1 - {% do { i <- amsAl $2 (comb2 (reLoc $2) $3) (reverse $ unLoc $3) + {% do { i <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3) ; return (i : $1)} } | {- empty -} { [] } @@ -1242,7 +1242,7 @@ topdecls :: { OrdList (LHsDecl GhcPs) } -- May have trailing semicolons, can be empty topdecls_semi :: { OrdList (LHsDecl GhcPs) } - : topdecls_semi topdecl semis1 {% do { t <- amsAl $2 (comb2 (reLoc $2) $3) (reverse $ unLoc $3) + : topdecls_semi topdecl semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3) ; return ($1 `snocOL` t) }} | {- empty -} { nilOL } @@ -1255,7 +1255,7 @@ topdecls_cs :: { OrdList (LHsDecl GhcPs) } -- May have trailing semicolons, can be empty topdecls_cs_semi :: { OrdList (LHsDecl GhcPs) } - : topdecls_cs_semi topdecl_cs semis1 {% do { t <- amsAl $2 (comb2 (reLoc $2) $3) (reverse $ unLoc $3) + : topdecls_cs_semi topdecl_cs semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3) ; return ($1 `snocOL` t) }} | {- empty -} { nilOL } @@ -1307,7 +1307,7 @@ ty_decl :: { LTyClDecl GhcPs } -- -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkTySynonym (comb2A $1 $4) $2 $4 [mj AnnType $1,mj AnnEqual $3] } + {% mkTySynonym (comb2 $1 $4) $2 $4 [mj AnnType $1,mj AnnEqual $3] } -- type family declarations | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info @@ -1348,7 +1348,7 @@ ty_decl :: { LTyClDecl GhcPs } -- standalone kind signature standalone_kind_sig :: { LStandaloneKindSig GhcPs } : 'type' sks_vars '::' sigktype - {% mkStandaloneKindSig (comb2A $1 $4) (L (gl $2) $ unLoc $2) $4 + {% mkStandaloneKindSig (comb2 $1 $4) (L (gl $2) $ unLoc $2) $4 [mj AnnType $1,mu AnnDcolon $3]} -- See also: sig_vars @@ -1377,7 +1377,7 @@ inst_decl :: { LInstDecl GhcPs } -- type instance declarations | 'type' 'instance' ty_fam_inst_eqn - {% mkTyFamInst (comb2A $1 $3) (unLoc $3) + {% mkTyFamInst (comb2 $1 $3) (unLoc $3) (mj AnnType $1:mj AnnInstance $2:[]) } -- data/newtype instance declaration @@ -1478,11 +1478,11 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } : 'forall' tv_bndrs '.' type '=' ktype {% do { hintExplicitForall $1 ; tvbs <- fromSpecTyVarBndrs $2 - ; let loc = comb2A $1 $> + ; let loc = comb2 $1 $> ; cs <- getCommentsFor loc ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs) $4 $6 [mj AnnEqual $5] }} | type '=' ktype - {% mkTyFamInstEqn (comb2A (reLoc $1) $>) mkHsOuterImplicit $1 $3 (mj AnnEqual $2:[]) } + {% mkTyFamInstEqn (comb2 $1 $>) mkHsOuterImplicit $1 $3 (mj AnnEqual $2:[]) } -- Note the use of type for the head; this allows -- infix type constructors and type patterns @@ -1519,10 +1519,10 @@ at_decl_cls :: { LHsDecl GhcPs } -- default type instances, with optional 'instance' keyword | 'type' ty_fam_inst_eqn - {% liftM mkInstD (mkTyFamInst (comb2A $1 $2) (unLoc $2) + {% liftM mkInstD (mkTyFamInst (comb2 $1 $2) (unLoc $2) [mj AnnType $1]) } | 'type' 'instance' ty_fam_inst_eqn - {% liftM mkInstD (mkTyFamInst (comb2A $1 $3) (unLoc $3) + {% liftM mkInstD (mkTyFamInst (comb2 $1 $3) (unLoc $3) (mj AnnType $1:mj AnnInstance $2:[]) )} opt_family :: { [AddEpAnn] } @@ -1540,7 +1540,7 @@ at_decl_inst :: { LInstDecl GhcPs } : 'type' opt_instance ty_fam_inst_eqn -- Note the use of type for the head; this allows -- infix type constructors and type patterns - {% mkTyFamInst (comb2A $1 $3) (unLoc $3) + {% mkTyFamInst (comb2 $1 $3) (unLoc $3) (mj AnnType $1:$2) } -- data/newtype instance declaration, with optional 'instance' keyword @@ -1615,7 +1615,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs } | 'forall' tv_bndrs '.' type {% do { hintExplicitForall $1 ; tvbs <- fromSpecTyVarBndrs $2 - ; let loc = comb2 $1 (reLoc $>) + ; let loc = comb2 $1 $> ; cs <- getCommentsFor loc ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } @@ -2428,7 +2428,7 @@ gadt_constrlist :: { Located ([AddEpAnn] gadt_constrs :: { Located [LConDecl GhcPs] } : gadt_constr ';' gadt_constrs {% do { h <- addTrailingSemiA $1 (gl $2) - ; return (L (comb2 (reLoc $1) $3) (h : unLoc $3)) }} + ; return (L (comb2 $1 $3) (h : unLoc $3)) }} | gadt_constr { L (glA $1) [$1] } | {- empty -} { noLoc [] } @@ -2443,7 +2443,7 @@ gadt_constr :: { LConDecl GhcPs } -- Returns a list because of: C,D :: ty -- TODO:AZ capture the optSemi. Why leading? : optSemi con_list '::' sigtype - {% mkGadtDecl (comb2A $2 $>) (unLoc $2) (hsUniTok $3) $4 } + {% mkGadtDecl (comb2 $2 $>) (unLoc $2) (hsUniTok $3) $4 } {- Note [Difference in parsing GADT and data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2507,7 +2507,7 @@ fielddecls1 :: { [LConDeclField GhcPs] } fielddecl :: { LConDeclField GhcPs } -- A list because of f,g :: Int : sig_vars '::' ctype - {% acsA (\cs -> L (comb2 $1 (reLoc $3)) + {% acsA (\cs -> L (comb2 $1 $3) (ConDeclField (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reverse (map (\ln@(L l n) -> L (l2l l) $ FieldOcc noExtField ln) (unLoc $1))) $3 Nothing))} @@ -2525,15 +2525,15 @@ derivings :: { Located (HsDeriving GhcPs) } -- know the rightmost extremity of the 'deriving' clause deriving :: { LHsDerivingClause GhcPs } : 'deriving' deriv_clause_types - {% let { full_loc = comb2A $1 $> } + {% let { full_loc = comb2 $1 $> } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) Nothing $2) } | 'deriving' deriv_strategy_no_via deriv_clause_types - {% let { full_loc = comb2A $1 $> } + {% let { full_loc = comb2 $1 $> } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $2) $3) } | 'deriving' deriv_clause_types deriv_strategy_via - {% let { full_loc = comb2 $1 (reLoc $>) } + {% let { full_loc = comb2 $1 $> } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $3) $2) } deriv_clause_types :: { LDerivClauseTys GhcPs } @@ -2574,7 +2574,7 @@ decl_no_th :: { LHsDecl GhcPs } : sigdecl { $1 } | infixexp opt_sig rhs {% runPV (unECP $1) >>= \ $1 -> - do { let { l = comb2Al $1 $> } + do { let { l = comb2 $1 $> } ; r <- checkValDef l $1 $2 $3; -- Depending upon what the pattern looks like we might get either -- a FunBind or PatBind back from checkValDef. See Note @@ -2608,7 +2608,7 @@ gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 -> - acsA (\cs -> sL (comb2A $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mj AnnEqual $3)) cs) (unLoc $2) $4) } + acsA (\cs -> sL (comb2 $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mj AnnEqual $3)) cs) (unLoc $2) $4) } sigdecl :: { LHsDecl GhcPs } : @@ -2712,7 +2712,7 @@ exp :: { ECP } { ECP $ unECP $1 >>= \ $1 -> rejectPragmaPV $1 >> - mkHsTySigPV (noAnnSrcSpan $ comb2Al $1 (reLoc $>)) $1 $3 + mkHsTySigPV (noAnnSrcSpan $ comb2 $1 $>) $1 $3 [(mu AnnDcolon $2)] } | infixexp '-<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> @@ -2747,7 +2747,7 @@ infixexp :: { ECP } unECP $1 >>= \ $1 -> unECP $3 >>= \ $3 -> rejectPragmaPV $1 >> - (mkHsOpAppPV (comb2A (reLoc $1) $3) $1 $2 $3) } + (mkHsOpAppPV (comb2 $1 $3) $1 $2 $3) } -- AnnVal annotation for NPlusKPat, which discards the operator exp10p :: { ECP } @@ -2764,7 +2764,7 @@ exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] : '-' fexp %shift { ECP $ unECP $2 >>= \ $2 -> - mkHsNegAppPV (comb2A $1 $>) $2 + mkHsNegAppPV (comb2 $1 $>) $2 [mj AnnMinus $1] } -- See Note [%shift: exp10 -> fexp] | fexp %shift { $1 } @@ -2836,12 +2836,12 @@ fexp :: { ECP } superFunArg $ unECP $1 >>= \ $1 -> unECP $2 >>= \ $2 -> - mkHsAppPV (noAnnSrcSpan $ comb2A (reLoc $1) $>) $1 $2 } + mkHsAppPV (noAnnSrcSpan $ comb2 $1 $>) $1 $2 } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | fexp PREFIX_AT atype { ECP $ unECP $1 >>= \ $1 -> - mkHsAppTypePV (noAnnSrcSpan $ comb2 (reLoc $1) (reLoc $>)) $1 (hsTok $2) $3 } + mkHsAppTypePV (noAnnSrcSpan $ comb2 $1 $>) $1 (hsTok $2) $3 } | 'static' aexp {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ @@ -2854,45 +2854,45 @@ aexp :: { ECP } : qvar TIGHT_INFIX_AT aexp { ECP $ unECP $3 >>= \ $3 -> - mkHsAsPatPV (comb2 (reLocN $1) (reLoc $>)) $1 (hsTok $2) $3 } + mkHsAsPatPV (comb2 $1 $>) $1 (hsTok $2) $3 } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE aexp { ECP $ unECP $2 >>= \ $2 -> - mkHsLazyPatPV (comb2 $1 (reLoc $>)) $2 [mj AnnTilde $1] } + mkHsLazyPatPV (comb2 $1 $>) $2 [mj AnnTilde $1] } | PREFIX_BANG aexp { ECP $ unECP $2 >>= \ $2 -> - mkHsBangPatPV (comb2 $1 (reLoc $>)) $2 [mj AnnBang $1] } + mkHsBangPatPV (comb2 $1 $>) $2 [mj AnnBang $1] } | PREFIX_MINUS aexp { ECP $ unECP $2 >>= \ $2 -> - mkHsNegAppPV (comb2A $1 $>) $2 [mj AnnMinus $1] } + mkHsNegAppPV (comb2 $1 $>) $2 [mj AnnMinus $1] } | '\\' apats '->' exp { ECP $ unECP $4 >>= \ $4 -> - mkHsLamPV (comb2 $1 (reLoc $>)) (\cs -> mkMatchGroup FromSource + mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource (reLocA $ sLLlA $1 $> [reLocA $ sLLlA $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 - , m_grhss = unguardedGRHSs (comb2 $3 (reLoc $4)) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])) } + , m_grhss = unguardedGRHSs (comb2 $3 $4) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])) } | 'let' binds 'in' exp { ECP $ unECP $4 >>= \ $4 -> - mkHsLetPV (comb2A $1 $>) (hsTok $1) (unLoc $2) (hsTok $3) $4 } + mkHsLetPV (comb2 $1 $>) (hsTok $1) (unLoc $2) (hsTok $3) $4 } | '\\' 'lcase' altslist(pats1) { ECP $ $3 >>= \ $3 -> - mkHsLamCasePV (comb2 $1 (reLoc $>)) LamCase $3 [mj AnnLam $1,mj AnnCase $2] } + mkHsLamCasePV (comb2 $1 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] } | '\\' 'lcases' altslist(apats) { ECP $ $3 >>= \ $3 -> - mkHsLamCasePV (comb2 $1 (reLoc $>)) LamCases $3 [mj AnnLam $1,mj AnnCases $2] } + mkHsLamCasePV (comb2 $1 $>) LamCases $3 [mj AnnLam $1,mj AnnCases $2] } | 'if' exp optSemi 'then' exp optSemi 'else' exp {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) -> return $ ECP $ unECP $5 >>= \ $5 -> unECP $8 >>= \ $8 -> - mkHsIfPV (comb2A $1 $>) $2 (snd $3) $5 (snd $6) $8 + mkHsIfPV (comb2 $1 $>) $2 (snd $3) $5 (snd $6) $8 (AnnsIf { aiIf = glAA $1 , aiThen = glAA $4 @@ -2914,13 +2914,13 @@ aexp :: { ECP } hintQualifiedDo $1 return $ ECP $ $2 >>= \ $2 -> - mkHsDoPV (comb2A $1 $2) + mkHsDoPV (comb2 $1 $2) (fmap mkModuleNameFS (getDO $1)) $2 (AnnList (Just $ glAR $2) Nothing Nothing [mj AnnDo $1] []) } | MDO stmtlist {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 -> fmap ecpFromExp $ - acsA (\cs -> L (comb2A $1 $2) + acsA (\cs -> L (comb2 $1 $2) (mkHsDoAnns (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) $2 @@ -2938,7 +2938,7 @@ aexp1 :: { ECP } getBit OverloadedRecordUpdateBit >>= \ overloaded -> unECP $1 >>= \ $1 -> $3 >>= \ $3 -> - mkHsRecordPV overloaded (comb2 (reLoc $1) $>) (comb2 $2 $4) $1 $3 + mkHsRecordPV overloaded (comb2 $1 $>) (comb2 $2 $4) $1 $3 [moc $2,mcc $4] } @@ -2947,7 +2947,7 @@ aexp1 :: { ECP } {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in - mkRdrGetField (noAnnSrcSpan $ comb2 (reLoc $1) (reLoc $>)) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } + mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } | aexp2 { $1 } @@ -3098,13 +3098,13 @@ texp :: { ECP } superInfixOp $ unECP $2 >>= \ $2 -> $1 >>= \ $1 -> - pvA $ mkHsSectionR_PV (comb2 (reLocN $1) (reLoc $>)) (n2l $1) $2 } + pvA $ mkHsSectionR_PV (comb2 $1 $>) (n2l $1) $2 } -- View patterns get parenthesized above | exp '->' texp { ECP $ unECP $1 >>= \ $1 -> unECP $3 >>= \ $3 -> - mkHsViewPatPV (comb2 (reLoc $1) (reLoc $>)) $1 $3 [mu AnnRarrow $2] } + mkHsViewPatPV (comb2 $1 $>) $1 $3 [mu AnnRarrow $2] } -- Always at least one comma or bar. -- Though this can parse just commas (without any expressions), it won't @@ -3338,7 +3338,7 @@ alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) } ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : '->' exp { unECP $2 >>= \ $2 -> - acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 (reLoc $2)) $2)) } + acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } | gdpats { $1 >>= \gdpats -> return $ sL1 gdpats (reverse (unLoc gdpats)) } @@ -3360,7 +3360,7 @@ ifgdpats :: { Located ([AddEpAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) } gdpat :: { forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b)) } : '|' guardquals '->' exp { unECP $4 >>= \ $4 -> - acsA (\cs -> sL (comb2A $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mu AnnRarrow $3)) cs) (unLoc $2) $4) } + acsA (\cs -> sL (comb2 $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mu AnnRarrow $3)) cs) (unLoc $2) $4) } -- 'pat' recognises a pattern, including one with a bang at the top -- e.g. "!x" or "!(x,y)" or "C a b" etc @@ -3483,13 +3483,13 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } { do let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) - lf' = comb2 $2 (reLoc $ L lf ()) + lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t final = last fields - l = comb2 (reLoc $1) $3 + l = comb2 $1 $3 isPun = False $5 <- unECP $5 - fmap Right $ mkHsProjUpdatePV (comb2 (reLoc $1) (reLoc $5)) (L l fields) $5 isPun + fmap Right $ mkHsProjUpdatePV (comb2 $1 $5) (L l fields) $5 isPun [mj AnnEqual $4] } @@ -3499,10 +3499,10 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } { do let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) - lf' = comb2 $2 (reLoc $ L lf ()) + lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t final = last fields - l = comb2 (reLoc $1) $3 + l = comb2 $1 $3 isPun = True var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final)) fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun [] @@ -4087,18 +4087,8 @@ stringLiteralToHsDocWst :: Located StringLiteral -> Located (WithHsDocIdentifier stringLiteralToHsDocWst = lexStringLiteral parseIdentifier -- Utilities for combining source spans -comb2 :: Located a -> Located b -> SrcSpan -comb2 a b = a `seq` b `seq` combineLocs a b - --- Utilities for combining source spans -comb2A :: Located a -> LocatedAn t b -> SrcSpan -comb2A a b = a `seq` b `seq` combineLocs a (reLoc b) - -comb2N :: Located a -> LocatedN b -> SrcSpan -comb2N a b = a `seq` b `seq` combineLocs a (reLocN b) - -comb2Al :: LocatedAn t a -> Located b -> SrcSpan -comb2Al a b = a `seq` b `seq` combineLocs (reLoc a) b +comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan +comb2 a b = a `seq` b `seq` combineHasLocs a b comb3 :: Located a -> Located b -> Located c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` @@ -4168,11 +4158,11 @@ sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLlA #-} sLLlA :: Located a -> LocatedAn t b -> c -> Located c -sLLlA x y = sL (comb2A x y) -- #define LL sL (comb2 $1 $>) +sLLlA x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAl #-} sLLAl :: LocatedAn t a -> Located b -> c -> Located c -sLLAl x y = sL (comb2A y x) -- #define LL sL (comb2 $1 $>) +sLLAl x y = sL (comb2 y x) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} sLLAsl :: [LocatedAn t a] -> Located b -> c -> Located c @@ -4580,4 +4570,7 @@ adaptWhereBinds :: Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments)) adaptWhereBinds Nothing = noLoc (EmptyLocalBinds noExtField, emptyComments) adaptWhereBinds (Just (L l (b, mc))) = L l (b, maybe emptyComments id mc) +combineHasLocs :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan +combineHasLocs a b = combineSrcSpans (getHasLoc a) (getHasLoc b) + } ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -51,6 +51,7 @@ module GHC.Parser.Annotation ( -- ** we do not care about the annotations. la2na, na2la, n2l, l2n, l2l, la2la, reLoc, reLocA, reLocL, reLocC, reLocN, + HasLoc(..), getHasLocList, srcSpan2e, la2e, realSrcSpan, @@ -90,7 +91,7 @@ import GHC.Prelude import Data.Data import Data.Function (on) -import Data.List (sortBy) +import Data.List (sortBy, foldl1') import Data.Semigroup import GHC.Data.FastString import GHC.Types.Name @@ -916,6 +917,22 @@ reLocN (L (SrcSpanAnn _ l) a) = L l a -- --------------------------------------------------------------------- +class HasLoc a where + -- ^ conveniently calculate locations for things without locations attached + getHasLoc :: a -> SrcSpan + +instance HasLoc (Located a) where + getHasLoc (L l _) = l + +instance HasLoc (LocatedAn t a) where + getHasLoc (L la _) = locA la + +getHasLocList :: HasLoc a => [a] -> SrcSpan +getHasLocList [] = noSrcSpan +getHasLocList xs = foldl1' combineSrcSpans $ map getHasLoc xs + +-- --------------------------------------------------------------------- + realSrcSpan :: SrcSpan -> RealSrcSpan realSrcSpan (RealSrcSpan s _) = s realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0d8d292b9c328361a4a2122ab6b7b2665a23d9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0d8d292b9c328361a4a2122ab6b7b2665a23d9b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:26:54 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 01 Jul 2023 11:26:54 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] 2 commits: Implement MOV for ImmInt immediates Message-ID: <64a045be2b30d_238a8e193933705336e7@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 44ae8f25 by Sven Tennie at 2023-07-01T17:19:50+02:00 Implement MOV for ImmInt immediates These cases were likely just forgotten. - - - - - 518a5645 by Sven Tennie at 2023-07-01T17:24:56+02:00 Load integers in their positive representation and don't sign extend unsigned values in foreign C calls Otherwise, the sign bits mess up everything! - - - - - 2 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -504,26 +504,31 @@ getRegister' config plat expr = CmmLit lit -> case lit of CmmInt 0 w -> pure $ Fixed (intFormat w) zero_reg nilOL - CmmInt i w | isEncodeableInWidth w i -> do - pure (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInteger i))))) + CmmInt i w | isEncodeableInWidth w i -> + -- narrowU is important: Negative immediates may be + -- sign-extended on load! + let imm = OpImm . ImmInteger $ narrowU w i + in + pure (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) imm))) -- i does not fit. Be careful to keep the sign. - CmmInt i w -> do + CmmInt i w -> let -- select all but the sign (most significant) bit mask = allOneMask (maxBitNo - 1) numBits = i .&. mask truncatedI = numBits .|. signBit i - pure - ( Any - (intFormat w) - ( \dst -> - toOL - [ annExpr - expr - (MOV (OpReg w dst) (OpImm (ImmInteger truncatedI))) - ] - ) - ) + imm = OpImm . ImmInteger $ narrowU w truncatedI + in + pure $ + Any + (intFormat w) + ( \dst -> + toOL + [ annExpr + expr + (MOV (OpReg w dst) imm) + ] + ) where allOneMask :: Int -> Integer allOneMask 0 = bit 0 @@ -1744,8 +1749,17 @@ genCCall target dest_regs arg_regs bid = do -- -- Still have GP regs, and we want to pass an GP argument. - passArguments pack (gpReg:gpRegs) fpRegs ((r, format, hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do - platform <- getPlatform + passArguments pack (gpReg:gpRegs) fpRegs ((r, format, hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format , hint == NoHint = do + -- Do not sign-extend unsigned register values. Otherwise, unsigned + -- parameters (e.g. uint8_t) are messed up with sign bits. + let w = formatToWidth format + mov = MOV (OpReg w gpReg) (OpReg w r) + accumCode' = accumCode `appOL` + code_r `snocOL` + ann (text "Pass gp argument (NoHint): " <> ppr r) mov + passArguments pack gpRegs fpRegs args stackSpace (gpReg:accumRegs) accumCode' + + passArguments pack (gpReg:gpRegs) fpRegs ((r, format, _hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do -- RISCV64 Integer Calling Convention: "When passed in registers or on the -- stack, integer scalars narrower than XLEN bits are widened according to -- the sign of their type up to 32 bits, then sign-extended to XLEN bits." ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -522,12 +522,17 @@ pprInstr platform instr = case instr of | isFloatOp o1 && not (isFloatOp o2) && isDoubleOp o1 -> op2 (text "\tfmv.d.x") o1 o2 | not (isFloatOp o1) && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.x.w") o1 o2 | not (isFloatOp o1) && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.x.d") o1 o2 - | isImmOp o2 - , (OpImm (ImmInteger i)) <- o2 + | (OpImm (ImmInteger i)) <- o2 , fitsIn12bitImm i -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ] - | isImmOp o2 - , (OpImm (ImmInteger i)) <- o2 + | (OpImm (ImmInt i)) <- o2 + , fitsIn12bitImm i + -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ] + | (OpImm (ImmInteger i)) <- o2 + , fitsIn32bits i + -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")" + , text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")" ] + | (OpImm (ImmInt i)) <- o2 , fitsIn32bits i -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")" , text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7687dd327d436475c451670c0de1f22bd799d901...518a5645b59d215b2ba1f663fd460e3a0e79a110 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7687dd327d436475c451670c0de1f22bd799d901...518a5645b59d215b2ba1f663fd460e3a0e79a110 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:27:06 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 01 Jul 2023 11:27:06 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-comb2] 26 commits: Configure CPP into settings Message-ID: <64a045cad4b70_238a8e28a56ba85340d9@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-comb2 at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7bb7d91a by Alan Zimmerman at 2023-07-01T16:26:14+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 30 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - − compiler/GHC/SysTools/Info.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0d8d292b9c328361a4a2122ab6b7b2665a23d9b...7bb7d91a018147db5a0e4c8b2e49b81cafd707a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e0d8d292b9c328361a4a2122ab6b7b2665a23d9b...7bb7d91a018147db5a0e4c8b2e49b81cafd707a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:29:32 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 01 Jul 2023 11:29:32 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-comb3] 27 commits: Configure CPP into settings Message-ID: <64a0465c5ec72_238a8e18d3cfbc53461@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-comb3 at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7bb7d91a by Alan Zimmerman at 2023-07-01T16:26:14+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 9aacd650 by Alan Zimmerman at 2023-07-01T16:28:55+01:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - 30 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - − compiler/GHC/SysTools/Info.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/830589c29795b70375e98540d5eb9cd9f504701d...9aacd650341205ac32ceafe77501ad99a78a12d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/830589c29795b70375e98540d5eb9cd9f504701d...9aacd650341205ac32ceafe77501ad99a78a12d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:30:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 11:30:59 -0400 Subject: [Git][ghc/ghc][wip/T22710] 3 commits: hadrian: Fix dependencies of docs:* rule Message-ID: <64a046b313d32_238a8e19393370534818@gitlab.mail> Ben Gamari pushed to branch wip/T22710 at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7d4e56ee by Ben Gamari at 2023-07-01T11:30:46-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 14 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - hadrian/src/Rules/Documentation.hs - libraries/ghc-prim/changelog.md - + testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr - + testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - + testsuite/tests/primops/should_run/T22710.hs - testsuite/tests/primops/should_run/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1922,6 +1922,14 @@ primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp with has_side_effects = True +primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp + ByteArray# s -> State# s -> (# State# s, MutableByteArray# #) + {Make an immutable byte array mutable, without copying. + + @since 0.12.0.0} + with + has_side_effects = True + primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp ByteArray# -> Int# {Return the size of the array in bytes.} ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -371,6 +371,10 @@ emitPrimOp cfg primop = UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) arg +-- #define unsafeThawByteArrayzh(r,a) r=(a) + UnsafeThawByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> + emitAssign (CmmLocal res) arg + -- Reading/writing pointer arrays ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -652,6 +652,7 @@ genPrim prof bound ty op = case op of ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + UnsafeThawByteArrayOp -> \[a] [b] -> PrimInline $ a |= b SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -258,6 +258,15 @@ buildPackageDocumentation = do need [ takeDirectory file -/- "haddock-prologue.txt"] haddocks <- haddockDependencies context + -- Build Haddock documentation + -- TODO: Pass the correct way from Rules via Context. + dynamicPrograms <- dynamicGhcPrograms =<< flavour + let haddockWay = if dynamicPrograms then dynamic else vanilla + + -- Build the dependencies of the package we are going to build documentation for + dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p}) + | (p, _) <- haddocks] + -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just -- for Haddock. We need to 'union' (instead of '++') to avoid passing -- 'GHC.PrimopWrappers' (which unfortunately shows up in both @@ -266,12 +275,8 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ (map snd haddocks) + need $ srcs ++ (map snd haddocks) ++ dep_pkgs - -- Build Haddock documentation - -- TODO: Pass the correct way from Rules via Context. - dynamicPrograms <- dynamicGhcPrograms =<< flavour - let haddockWay = if dynamicPrograms then dynamic else vanilla statsFilesDir <- haddockStatsFilesDir createDirectory statsFilesDir build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file] ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -1,3 +1,10 @@ +## 0.12.0 + +- Shipped with GHC 9.10.1 + +- The `unsafeThawByteArray#` primop was added, serving as a inverse to the existing + `unsafeFreezeByteArray#` primop (see #22710). + ## 0.11.0 - Shipped with GHC 9.8.1 ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_A where + +import T22106_aux ( foo ) + +xyzzy = foo ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_B where + +import T22106_aux ( T(foo) ) + +xyzzy r = r { foo = 3 } ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_C where + +import T22106_aux ( bar ) + +xyzzy = bar ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr ===================================== @@ -0,0 +1,6 @@ + +T22106_C.hs:5:9: error: [GHC-88464] + Variable not in scope: bar + Suggested fix: + Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’ + that has been suppressed by NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_D where + +import T22106_aux ( T(bar) ) + +xyzzy r = r { bar = 7 } ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module T22106_aux where + +data T = MkT { foo :: Int, bar :: Int } +foo = () ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -50,3 +50,8 @@ test('BootFldReexport' test('T23220' , [req_th, extra_files(['T23220_aux.hs'])] , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0']) + +test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0']) +test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) +test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) +test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) ===================================== testsuite/tests/primops/should_run/T22710.hs ===================================== @@ -0,0 +1,55 @@ +-- | Test 'unsafeThawByteArray#'. + +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Exts (newByteArray#, indexWord8Array#, writeWord8Array#, + unsafeFreezeByteArray#, unsafeThawByteArray#, + ByteArray#, MutableByteArray#, Int(I#)) +import GHC.Word +import GHC.ST +import Prelude hiding (toList) + +main :: IO () +main = do + res <- return $ runST $ do + let n = 32 :: Int + marr <- newByteArray n + mapM_ (\i -> writeWord8Array marr i (fromIntegral i)) [0..n-1] + arr <- unsafeFreezeByteArray marr + marr' <- unsafeThawByteArray arr + arr' <- unsafeFreezeByteArray marr' + return $ toList arr' 5 + + print res + +data ByteArray = ByteArray { unBA :: ByteArray# } +data MByteArray s = MByteArray { unMBA :: MutableByteArray# s } + +newByteArray :: Int -> ST s (MByteArray s) +newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +indexWord8Array :: ByteArray -> Int -> Word8 +indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of + a -> W8# a + +writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s () +writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# -> + case writeWord8Array# (unMBA marr) i# a s# of + s2# -> (# s2#, () #) + +unsafeFreezeByteArray :: MByteArray s -> ST s ByteArray +unsafeFreezeByteArray marr = ST $ \ s# -> + case unsafeFreezeByteArray# (unMBA marr) s# of + (# s2#, arr# #) -> (# s2#, ByteArray arr# #) + +unsafeThawByteArray :: ByteArray -> ST s (MByteArray s) +unsafeThawByteArray arr = ST $ \ s# -> + case unsafeThawByteArray# (unBA arr) s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +toList :: ByteArray -> Int -> [Word8] +toList arr n = go 0 + where + go i | i >= n = [] + | otherwise = indexWord8Array arr i : go (i+1) ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -72,3 +72,4 @@ test('FMA_ConstantFold' test('T21624', normal, compile_and_run, ['']) test('T23071', ignore_stdout, compile_and_run, ['']) +test('T22710', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42e6a8b057a858c68cb9740301f8126b108ab126...7d4e56eeb5e6b46094ac1d0f4a6c9ea1a9909824 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42e6a8b057a858c68cb9740301f8126b108ab126...7d4e56eeb5e6b46094ac1d0f4a6c9ea1a9909824 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:31:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 11:31:38 -0400 Subject: [Git][ghc/ghc][wip/T22710] primops: Introduce unsafeThawByteArray# Message-ID: <64a046da7f75c_238a8e1a29554453555b@gitlab.mail> Ben Gamari pushed to branch wip/T22710 at Glasgow Haskell Compiler / GHC Commits: e00a806a by Ben Gamari at 2023-07-01T11:31:29-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 6 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/ghc-prim/changelog.md - + testsuite/tests/primops/should_run/T22710.hs - testsuite/tests/primops/should_run/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1922,6 +1922,14 @@ primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp with has_side_effects = True +primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp + ByteArray# -> State# s -> (# State# s, MutableByteArray# s #) + {Make an immutable byte array mutable, without copying. + + @since 0.12.0.0} + with + has_side_effects = True + primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp ByteArray# -> Int# {Return the size of the array in bytes.} ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -371,6 +371,10 @@ emitPrimOp cfg primop = UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) arg +-- #define unsafeThawByteArrayzh(r,a) r=(a) + UnsafeThawByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> + emitAssign (CmmLocal res) arg + -- Reading/writing pointer arrays ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -652,6 +652,7 @@ genPrim prof bound ty op = case op of ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + UnsafeThawByteArrayOp -> \[a] [b] -> PrimInline $ a |= b SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -1,3 +1,10 @@ +## 0.12.0 + +- Shipped with GHC 9.10.1 + +- The `unsafeThawByteArray#` primop was added, serving as a inverse to the existing + `unsafeFreezeByteArray#` primop (see #22710). + ## 0.11.0 - Shipped with GHC 9.8.1 ===================================== testsuite/tests/primops/should_run/T22710.hs ===================================== @@ -0,0 +1,55 @@ +-- | Test 'unsafeThawByteArray#'. + +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Exts (newByteArray#, indexWord8Array#, writeWord8Array#, + unsafeFreezeByteArray#, unsafeThawByteArray#, + ByteArray#, MutableByteArray#, Int(I#)) +import GHC.Word +import GHC.ST +import Prelude hiding (toList) + +main :: IO () +main = do + res <- return $ runST $ do + let n = 32 :: Int + marr <- newByteArray n + mapM_ (\i -> writeWord8Array marr i (fromIntegral i)) [0..n-1] + arr <- unsafeFreezeByteArray marr + marr' <- unsafeThawByteArray arr + arr' <- unsafeFreezeByteArray marr' + return $ toList arr' 5 + + print res + +data ByteArray = ByteArray { unBA :: ByteArray# } +data MByteArray s = MByteArray { unMBA :: MutableByteArray# s } + +newByteArray :: Int -> ST s (MByteArray s) +newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +indexWord8Array :: ByteArray -> Int -> Word8 +indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of + a -> W8# a + +writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s () +writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# -> + case writeWord8Array# (unMBA marr) i# a s# of + s2# -> (# s2#, () #) + +unsafeFreezeByteArray :: MByteArray s -> ST s ByteArray +unsafeFreezeByteArray marr = ST $ \ s# -> + case unsafeFreezeByteArray# (unMBA marr) s# of + (# s2#, arr# #) -> (# s2#, ByteArray arr# #) + +unsafeThawByteArray :: ByteArray -> ST s (MByteArray s) +unsafeThawByteArray arr = ST $ \ s# -> + case unsafeThawByteArray# (unBA arr) s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +toList :: ByteArray -> Int -> [Word8] +toList arr n = go 0 + where + go i | i >= n = [] + | otherwise = indexWord8Array arr i : go (i+1) ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -72,3 +72,4 @@ test('FMA_ConstantFold' test('T21624', normal, compile_and_run, ['']) test('T23071', ignore_stdout, compile_and_run, ['']) +test('T22710', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e00a806ac22a444d941bf85d199ccbaf36c461cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e00a806ac22a444d941bf85d199ccbaf36c461cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:31:56 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 01 Jul 2023 11:31:56 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-sll] 28 commits: Configure CPP into settings Message-ID: <64a046ec45bea_238a8e19387ffc5360c0@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-sll at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7bb7d91a by Alan Zimmerman at 2023-07-01T16:26:14+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 9aacd650 by Alan Zimmerman at 2023-07-01T16:28:55+01:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - f773ffc4 by Alan Zimmerman at 2023-07-01T16:31:27+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 30 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - − compiler/GHC/SysTools/Info.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ada9d8493f6183837736dce8cad1d388dc6f364...f773ffc44dbb6b04ba51e63dba6fdf73941af4c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ada9d8493f6183837736dce8cad1d388dc6f364...f773ffc44dbb6b04ba51e63dba6fdf73941af4c8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:40:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 11:40:24 -0400 Subject: [Git][ghc/ghc][wip/T22710] primops: Introduce unsafeThawByteArray# Message-ID: <64a048e825842_238a8e1a2955445362a7@gitlab.mail> Ben Gamari pushed to branch wip/T22710 at Glasgow Haskell Compiler / GHC Commits: 629d2e2e by Ben Gamari at 2023-07-01T11:40:16-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 7 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/ghc-prim/changelog.md - + testsuite/tests/primops/should_run/T22710.hs - + testsuite/tests/primops/should_run/T22710.stdout - testsuite/tests/primops/should_run/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1922,6 +1922,14 @@ primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp with has_side_effects = True +primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp + ByteArray# -> State# s -> (# State# s, MutableByteArray# s #) + {Make an immutable byte array mutable, without copying. + + @since 0.12.0.0} + with + has_side_effects = True + primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp ByteArray# -> Int# {Return the size of the array in bytes.} ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -371,6 +371,10 @@ emitPrimOp cfg primop = UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) arg +-- #define unsafeThawByteArrayzh(r,a) r=(a) + UnsafeThawByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> + emitAssign (CmmLocal res) arg + -- Reading/writing pointer arrays ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -652,6 +652,7 @@ genPrim prof bound ty op = case op of ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + UnsafeThawByteArrayOp -> \[a] [b] -> PrimInline $ a |= b SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -1,3 +1,10 @@ +## 0.12.0 + +- Shipped with GHC 9.10.1 + +- The `unsafeThawByteArray#` primop was added, serving as a inverse to the existing + `unsafeFreezeByteArray#` primop (see #22710). + ## 0.11.0 - Shipped with GHC 9.8.1 ===================================== testsuite/tests/primops/should_run/T22710.hs ===================================== @@ -0,0 +1,55 @@ +-- | Test 'unsafeThawByteArray#'. + +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Exts (newByteArray#, indexWord8Array#, writeWord8Array#, + unsafeFreezeByteArray#, unsafeThawByteArray#, + ByteArray#, MutableByteArray#, Int(I#)) +import GHC.Word +import GHC.ST +import Prelude hiding (toList) + +main :: IO () +main = do + res <- return $ runST $ do + let n = 32 :: Int + marr <- newByteArray n + mapM_ (\i -> writeWord8Array marr i (fromIntegral i)) [0..n-1] + arr <- unsafeFreezeByteArray marr + marr' <- unsafeThawByteArray arr + arr' <- unsafeFreezeByteArray marr' + return $ toList arr' 5 + + print res + +data ByteArray = ByteArray { unBA :: ByteArray# } +data MByteArray s = MByteArray { unMBA :: MutableByteArray# s } + +newByteArray :: Int -> ST s (MByteArray s) +newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +indexWord8Array :: ByteArray -> Int -> Word8 +indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of + a -> W8# a + +writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s () +writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# -> + case writeWord8Array# (unMBA marr) i# a s# of + s2# -> (# s2#, () #) + +unsafeFreezeByteArray :: MByteArray s -> ST s ByteArray +unsafeFreezeByteArray marr = ST $ \ s# -> + case unsafeFreezeByteArray# (unMBA marr) s# of + (# s2#, arr# #) -> (# s2#, ByteArray arr# #) + +unsafeThawByteArray :: ByteArray -> ST s (MByteArray s) +unsafeThawByteArray arr = ST $ \ s# -> + case unsafeThawByteArray# (unBA arr) s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +toList :: ByteArray -> Int -> [Word8] +toList arr n = go 0 + where + go i | i >= n = [] + | otherwise = indexWord8Array arr i : go (i+1) ===================================== testsuite/tests/primops/should_run/T22710.stdout ===================================== @@ -0,0 +1 @@ +[0,1,2,3,4] ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -72,3 +72,4 @@ test('FMA_ConstantFold' test('T21624', normal, compile_and_run, ['']) test('T23071', ignore_stdout, compile_and_run, ['']) +test('T22710', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/629d2e2ea5ae3437fc341f89ac1bd2aa6502cf84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/629d2e2ea5ae3437fc341f89ac1bd2aa6502cf84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:43:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 11:43:40 -0400 Subject: =?UTF-8?Q?[Git][ghc/ghc][wip/T20983]_2735_commits:_Note_that?= =?UTF-8?Q?_ImpredicativeTypes_doesn=E2=80=99t_allow_polymorphic_instances?= Message-ID: <64a049ac7c32d_238a8e280c580536914@gitlab.mail> Ben Gamari pushed to branch wip/T20983 at Glasgow Haskell Compiler / GHC Commits: 592e4113 by Anselm Schüler at 2022-01-19T13:31:49-05:00 Note that ImpredicativeTypes doesn’t allow polymorphic instances See #20939 - - - - - 3b009e1a by Ben Gamari at 2022-01-19T13:32:25-05:00 base: Add CTYPE pragmas to all foreign types Fixes #15531 by ensuring that we know the corresponding C type for all marshalling wrappers. Closes #15531. - - - - - 516eeb9e by Robert Hensing at 2022-01-24T21:28:24-05:00 Add -fcompact-unwind This gives users the choice to enable __compact_unwind sections when linking. These were previously hardcoded to be removed. This can be used to solved the problem "C++ does not catch exceptions when used with Haskell-main and linked by ghc", https://gitlab.haskell.org/ghc/ghc/-/issues/11829 It does not change the default behavior, because I can not estimate the impact this would have. When Apple first introduced the compact unwind ABI, a number of open source projects have taken the easy route of disabling it, avoiding errors or even just warnings shortly after its introduction. Since then, about a decade has passed, so it seems quite possible that Apple itself, and presumably many programs with it, have successfully switched to the new format, to the point where the old __eh_frame section support is in disrepair. Perhaps we should get along with the program, but for now we can test the waters with this flag, and use it to fix packages that need it. - - - - - 5262b1e5 by Robert Hensing at 2022-01-24T21:28:24-05:00 Add test case for C++ exception handling - - - - - a5c94092 by Sebastian Graf at 2022-01-24T21:29:00-05:00 Write Note [Strict State monad] to explain what G.U.M.State.Strict does As requested by Simon after review of !7342. I also took liberty to define the `Functor` instance by hand, as the derived one subverts the invariants maintained by the pattern synonym (as already stated in `Note [The one-shot state monad trick]`). - - - - - 9b0d56d3 by Eric Lindblad at 2022-01-24T21:29:38-05:00 links - - - - - 4eac8e72 by Ben Gamari at 2022-01-24T21:30:13-05:00 ghc-heap: Drop mention of BlockedOnIOCompletion Fixes bootstrap with GHC 9.0 after 5a6efd218734dbb5c1350531680cd3f4177690f1 - - - - - 7d7b9a01 by Ryan Scott at 2022-01-24T21:30:49-05:00 Hadrian: update the index-state to allow building with GHC 9.0.2 Fixes #20984. - - - - - aa50e118 by Peter Trommler at 2022-01-24T21:31:25-05:00 testsuite: Mark test that require RTS linker - - - - - 871ce2a3 by Matthew Pickering at 2022-01-25T17:27:30-05:00 ci: Move (most) deb9 jobs to deb10 deb9 is now end-of-life so we are dropping support for producing bindists. - - - - - 9d478d51 by Ryan Scott at 2022-01-25T17:28:06-05:00 DeriveGeneric: look up datacon fixities using getDataConFixityFun Previously, `DeriveGeneric` would look up the fixity of a data constructor using `getFixityEnv`, but this is subtly incorrect for data constructors defined in external modules. This sort of situation can happen with `StandaloneDeriving`, as noticed in #20994. In fact, the same bug has occurred in the past in #9830, and while that bug was fixed for `deriving Read` and `deriving Show`, the fix was never extended to `DeriveGeneric` due to an oversight. This patch corrects that oversight. Fixes #20994. - - - - - 112e9e9e by Zubin Duggal at 2022-01-25T17:28:41-05:00 Fix Werror on alpine - - - - - 781323a3 by Matthew Pickering at 2022-01-25T17:29:17-05:00 Widen T12545 acceptance window This test has been the scourge of contributors for a long time. It has caused many failed CI runs and wasted hours debugging a test which barely does anything. The fact is does nothing is the reason for the flakiness and it's very sensitive to small changes in initialisation costs, in particular adding wired-in things can cause this test to fluctuate quite a bit. Therefore we admit defeat and just bump the threshold up to 10% to catch very large regressions but otherwise don't care what this test does. Fixes #19414 - - - - - e471a680 by sheaf at 2022-01-26T12:01:45-05:00 Levity-polymorphic arrays and mutable variables This patch makes the following types levity-polymorphic in their last argument: - Array# a, SmallArray# a, Weak# b, StablePtr# a, StableName# a - MutableArray# s a, SmallMutableArray# s a, MutVar# s a, TVar# s a, MVar# s a, IOPort# s a The corresponding primops are also made levity-polymorphic, e.g. `newArray#`, `readArray#`, `writeMutVar#`, `writeIOPort#`, etc. Additionally, exception handling functions such as `catch#`, `raise#`, `maskAsyncExceptions#`,... are made levity/representation-polymorphic. Now that Array# and MutableArray# also work with unlifted types, we can simply re-define ArrayArray# and MutableArrayArray# in terms of them. This means that ArrayArray# and MutableArrayArray# are no longer primitive types, but simply unlifted newtypes around Array# and MutableArrayArray#. This completes the implementation of the Pointer Rep proposal https://github.com/ghc-proposals/ghc-proposals/pull/203 Fixes #20911 ------------------------- Metric Increase: T12545 ------------------------- ------------------------- Metric Decrease: T12545 ------------------------- - - - - - 6e94ba54 by Andreas Klebinger at 2022-01-26T12:02:21-05:00 CorePrep: Don't try to wrap partial applications of primops in profiling ticks. This fixes #20938. - - - - - b55d7db3 by sheaf at 2022-01-26T12:03:01-05:00 Ensure that order of instances doesn't matter The insert_overlapping used in lookupInstEnv used to return different results depending on the order in which instances were processed. The problem was that we could end up discarding an overlapping instance in favour of a more specific non-overlapping instance. This is a problem because, even though we won't choose the less-specific instance for matching, it is still useful for pruning away other instances, because it has the overlapping flag set while the new instance doesn't. In insert_overlapping, we now keep a list of "guard" instances, which are instances which are less-specific that one that matches (and hence which we will discard in the end), but want to keep around solely for the purpose of eliminating other instances. Fixes #20946 - - - - - 61f62062 by sheaf at 2022-01-26T12:03:40-05:00 Remove redundant SOURCE import in FitTypes Fixes #20995 - - - - - e8405829 by sheaf at 2022-01-26T12:04:15-05:00 Fix haddock markup in GHC.Tc.Errors.Types - - - - - 590a2918 by Simon Peyton Jones at 2022-01-26T19:45:22-05:00 Make RULE matching insensitive to eta-expansion This patch fixes #19790 by making the rule matcher do on-the-fly eta reduction. See Note [Eta reduction the target] in GHC.Core.Rules I found I also had to careful about casts when matching; see Note [Casts in the target] and Note [Casts in the template] Lots more comments and Notes in the rule matcher - - - - - c61ac4d8 by Matthew Pickering at 2022-01-26T19:45:58-05:00 alwaysRerun generation of ghcconfig This file needs to match exactly what is passed as the testCompiler. Before this change the settings for the first compiler to be tested woudl be stored and not regenerated if --test-compiler changed. - - - - - b5132f86 by Matthew Pickering at 2022-01-26T19:45:58-05:00 Pass config.stage argument to testsuite - - - - - 83d3ad31 by Zubin Duggal at 2022-01-26T19:45:58-05:00 hadrian: Allow testing of the stage1 compiler (#20755) - - - - - a5924b38 by Joachim Breitner at 2022-01-26T19:46:34-05:00 Simplifier: Do the right thing if doFloatFromRhs = False If `doFloatFromRhs` is `False` then the result from `prepareBinding` should not be used. Previously it was in ways that are silly (but not completly wrong, as the simplifier would clean that up again, so no test case). This was spotted by Simon during a phone call. Fixes #20976 - - - - - ce488c2b by Simon Peyton Jones at 2022-01-26T19:47:09-05:00 Better occurrence analysis with casts This patch addresses #20988 by refactoring the way the occurrence analyser deals with lambdas. Previously it used collectBinders to split off a group of binders, and deal with them together. Now I deal with them one at a time in occAnalLam, which allows me to skip casts easily. See Note [Occurrence analysis for lambda binders] about "lambda-groups" This avoidance of splitting out a list of binders has some good consequences. Less code, more efficient, and I think, more clear. The Simplifier needed a similar change, now that lambda-groups can inlude casts. It turned out that I could simplify the code here too, in particular elminating the sm_bndrs field of StrictBind. Simpler, more efficient. Compile-time metrics improve slightly; here are the ones that are +/- 0.5% or greater: Baseline Test Metric value New value Change -------------------------------------------------------------------- T11303b(normal) ghc/alloc 40,736,702 40,543,992 -0.5% T12425(optasm) ghc/alloc 90,443,459 90,034,104 -0.5% T14683(normal) ghc/alloc 2,991,496,696 2,956,277,288 -1.2% T16875(normal) ghc/alloc 34,937,866 34,739,328 -0.6% T17977b(normal) ghc/alloc 37,908,550 37,709,096 -0.5% T20261(normal) ghc/alloc 621,154,237 618,312,480 -0.5% T3064(normal) ghc/alloc 190,832,320 189,952,312 -0.5% T3294(normal) ghc/alloc 1,604,674,178 1,604,608,264 -0.0% T5321FD(normal) ghc/alloc 270,540,489 251,888,480 -6.9% GOOD T5321Fun(normal) ghc/alloc 300,707,814 281,856,200 -6.3% GOOD WWRec(normal) ghc/alloc 588,460,916 585,536,400 -0.5% geo. mean -0.3% Metric Decrease: T5321FD T5321Fun - - - - - 4007905d by Roland Senn at 2022-01-26T19:47:47-05:00 Cleanup tests in directory ghci.debugger. Fixes #21009 * Remove wrong comment about panic in `break003.script`. * Improve test `break008`. * Add test `break028` to `all.T` * Fix wrong comments in `print019.script`, `print026.script` and `result001.script`. * Remove wrong comments from `print024.script` and `print031.script`. * Replace old module name with current name in `print035.script`. - - - - - 3577defb by Matthew Pickering at 2022-01-26T19:48:22-05:00 ci: Move source-tarball and test-bootstrap into full-build - - - - - 6e09b3cf by Matthew Pickering at 2022-01-27T02:39:35-05:00 ci: Add ENABLE_NUMA flag to explicitly turn on libnuma dependency In recent releases a libnuma dependency has snuck into our bindists because the images have started to contain libnuma. We now explicitly pass `--disable-numa` to configure unless explicitly told not to by using the `ENABLE_NUMA` environment variable. So this is tested, there is one random validate job which builds with --enable-numa so that the code in the RTS is still built. Fixes #20957 and #15444 - - - - - f4ce4186 by Simon Peyton Jones at 2022-01-27T02:40:11-05:00 Improve partial signatures As #20921 showed, with partial signatures, it is helpful to use the same algorithm (namely findInferredDiff) for * picking the constraints to retain for the /group/ in Solver.decideQuantification * picking the contraints to retain for the /individual function/ in Bind.chooseInferredQuantifiers This is still regrettably declicate, but it's a step forward. - - - - - 0573aeab by Simon Peyton Jones at 2022-01-27T02:40:11-05:00 Add an Outputable instance for RecTcChecker - - - - - f0adea14 by Ryan Scott at 2022-01-27T02:40:47-05:00 Expand type synonyms in markNominal `markNominal` is repsonsible for setting the roles of type variables that appear underneath an `AppTy` to be nominal. However, `markNominal` previously did not expand type synonyms, so in a data type like this: ```hs data M f a = MkM (f (T a)) type T a = Int ``` The `a` in `M f a` would be marked nominal, even though `T a` would simply expand to `Int`. The fix is simple: call `coreView` as appropriate in `markNominal`. This is much like the fix for #14101, but in a different spot. Fixes #20999. - - - - - 18df4013 by Simon Peyton Jones at 2022-01-27T08:22:30-05:00 Define and use restoreLclEnv This fixes #20981. See Note [restoreLclEnv vs setLclEnv] in GHC.Tc.Utils.Monad. I also use updLclEnv rather than get/set when I can, because it's then much clearer that it's an update rather than an entirely new TcLclEnv coming from who-knows-where. - - - - - 31088dd3 by David Feuer at 2022-01-27T08:23:05-05:00 Add test supplied in T20996 which uses data family result kind polymorphism David (@treeowl) writes: > Following @kcsongor, I've used ridiculous data family result kind > polymorphism in `linear-generics`, and am currently working on getting > it into `staged-gg`. If it should be removed, I'd appreciate a heads up, > and I imagine Csongor would too. > > What do I need by ridiculous polymorphic result kinds? Currently, data > families are allowed to have result kinds that end in `Type` (or maybe > `TYPE r`? I'm not sure), but not in concrete data kinds. However, they > *are* allowed to have polymorphic result kinds. This leads to things I > think most of us find at least quite *weird*. For example, I can write > > ```haskell > data family Silly :: k > data SBool :: Bool -> Type where > SFalse :: SBool False > STrue :: SBool True > SSSilly :: SBool Silly > type KnownBool b where > kb :: SBool b > instance KnownBool False where kb = SFalse > instance KnownBool True where kb = STrue > instance KnownBool Silly where kb = Silly > ``` > > Basically, every kind now has potentially infinitely many "legit" inhabitants. > > As horrible as that is, it's rather useful for GHC's current native > generics system. It's possible to use these absurdly polymorphic result > kinds to probe the structure of generic representations in a relatively > pleasant manner. It's a sort of "formal type application" reminiscent of > the notion of a formal power series (see the test case below). I suspect > a system more like `kind-generics` wouldn't need this extra probing > power, but nothing like that is natively available as yet. > > If the ridiculous result kind polymorphism is banished, we'll still be > able to do what we need as long as we have stuck type families. It's > just rather less ergonomical: a stuck type family has to be used with a > concrete marker type argument. Closes #20996 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 8fd2ac25 by Andreas Abel at 2022-01-27T18:34:54-05:00 Whitespace only - - - - - 7a854743 by Andreas Abel at 2022-01-27T18:34:54-05:00 Ctd. #18087: complete :since: info for all warnings in users guide Some warnings have been there "forever" and I could not trace back the exact genesis, so I wrote "since at least 5.04". The flag `helpful-errors` could have been added in 7.2 already. I wrote 7.4 since I have no 7.2 available and it is not recognized by 7.0. - - - - - f75411e8 by Andreas Abel at 2022-01-27T18:34:54-05:00 Re #18087 user's guide: add a note that -Wxxx used to be -fwarn-xxx The warning option syntax -W was introduced in GHC 8. The note should clarify what e.g. "since 7.6" means in connection with "-Wxxx": That "-fwarn-xxx" was introduced in 7.6.1. [ci skip] - - - - - 3cae7fde by Peter Trommler at 2022-01-27T18:35:30-05:00 testsuite: Fix AtomicPrimops test on big endian - - - - - 6cc6080c by Ben Gamari at 2022-01-27T18:36:05-05:00 users-guide: Document GHC_CHARENC environment variable As noted in #20963, this was introduced in 1b56c40578374a15b4a2593895710c68b0e2a717 but was no documentation was added at that point. Closes #20963. - - - - - ee21e2de by Ben Gamari at 2022-01-27T18:36:41-05:00 rts: Clean up RTS flags usage message Align flag descriptions and acknowledge that some flags may not be available unless the user linked with `-rtsopts` (as noted in #20961). Fixes #20961. - - - - - 7f8ce19e by Simon Peyton Jones at 2022-01-27T18:37:17-05:00 Fix getHasGivenEqs The second component is supposed to be "insoluble equalities arising from givens". But we were getting wanteds too; and that led to an outright duplication of constraints. It's not harmful, but it's not right either. I came across this when debugging something else. Easily fixed. - - - - - f9ef2d26 by Simon Peyton Jones at 2022-01-27T18:37:17-05:00 Set the TcLclEnv when solving a ForAll constraint Fix a simple omission in GHC.Tc.Solver.Canonical.solveForAll, where we ended up with the wrong TcLclEnv captured in an implication. Result: unhelpful error message (#21006) - - - - - bc6ba8ef by Sylvain Henry at 2022-01-28T12:14:41-05:00 Make most shifts branchless - - - - - 62a6d037 by Simon Peyton Jones at 2022-01-28T12:15:17-05:00 Improve boxity in deferAfterPreciseException As #20746 showed, the demand analyser behaved badly in a key I/O library (`GHC.IO.Handle.Text`), by unnessarily boxing and reboxing. This patch adjusts the subtle function deferAfterPreciseException; it's quite easy, just a bit subtle. See the new Note [deferAfterPreciseException] And this MR deals only with Problem 2 in #20746. Problem 1 is still open. - - - - - 42c47cd6 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/trace: Shrink tracing flags - - - - - cee66e71 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/EventLog: Mark various internal globals as static - - - - - 6b0cea29 by Ben Gamari at 2022-01-29T02:40:45-05:00 Propagate PythonCmd to make build system - - - - - 2e29edb7 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts: Refactor event types Previously we would build the eventTypes array at runtime during RTS initialization. However, this is completely unnecessary; it is completely static data. - - - - - bb15c347 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/eventlog: Ensure that flushCount is initialized - - - - - 268efcc9 by Matthew Pickering at 2022-01-29T02:41:21-05:00 Rework the handling of SkolemInfo The main purpose of this patch is to attach a SkolemInfo directly to each SkolemTv. This fixes the large number of bugs which have accumulated over the years where we failed to report errors due to having "no skolem info" for particular type variables. Now the origin of each type varible is stored on the type variable we can always report accurately where it cames from. Fixes #20969 #20732 #20680 #19482 #20232 #19752 #10946 #19760 #20063 #13499 #14040 The main changes of this patch are: * SkolemTv now contains a SkolemInfo field which tells us how the SkolemTv was created. Used when reporting errors. * Enforce invariants relating the SkolemInfoAnon and level of an implication (ic_info, ic_tclvl) to the SkolemInfo and level of the type variables in ic_skols. * All ic_skols are TcTyVars -- Check is currently disabled * All ic_skols are SkolemTv * The tv_lvl of the ic_skols agrees with the ic_tclvl * The ic_info agrees with the SkolInfo of the implication. These invariants are checked by a debug compiler by checkImplicationInvariants. * Completely refactor kcCheckDeclHeader_sig which kept doing my head in. Plus, it wasn't right because it wasn't skolemising the binders as it decomposed the kind signature. The new story is described in Note [kcCheckDeclHeader_sig]. The code is considerably shorter than before (roughly 240 lines turns into 150 lines). It still has the same awkward complexity around computing arity as before, but that is a language design issue. See Note [Arity inference in kcCheckDeclHeader_sig] * I added new type synonyms MonoTcTyCon and PolyTcTyCon, and used them to be clear which TcTyCons have "finished" kinds etc, and which are monomorphic. See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] * I renamed etaExpandAlgTyCon to splitTyConKind, becuase that's a better name, and it is very useful in kcCheckDeclHeader_sig, where eta-expansion isn't an issue. * Kill off the nasty `ClassScopedTvEnv` entirely. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 0a1d0944 by Ben Gamari at 2022-01-29T14:52:55-05:00 Drop SPARC NCG - - - - - 313afb3d by Ben Gamari at 2022-01-29T14:52:56-05:00 A few comment cleanups - - - - - d85a527f by Ben Gamari at 2022-01-29T14:52:56-05:00 Rip out SPARC register support - - - - - c6bede69 by Ben Gamari at 2022-01-29T14:52:56-05:00 rts: Rip out SPARC support - - - - - a67c2471 by Ben Gamari at 2022-01-29T14:52:56-05:00 Rip out remaining SPARC support - - - - - 5771b690 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Drop RegPair SPARC was its last and only user. - - - - - 512ed3f1 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Make RealReg a newtype Now that RegPair is gone we no longer need to pay for the additional box. - - - - - 88fea6aa by Ben Gamari at 2022-01-29T14:52:56-05:00 rts: Drop redundant #include <Arena.h> - - - - - ea2a4034 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Drop ncgExpandTop This was only needed for SPARC's synthetic instructions. - - - - - 88fce740 by Ben Gamari at 2022-01-29T14:54:04-05:00 rel-notes: Note dropping of SPARC support - - - - - eb956cf1 by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite: Force-enable caret diagnostics in T17786 Otherwise GHC realizes that it's not attached to a proper tty and will disable caret diagnostics. - - - - - d07799ab by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite: Make T7275 more robust against CCid changes The cost-center numbers are somewhat unstable; normalise them out. - - - - - c76c8050 by Ben Gamari at 2022-01-30T06:27:19-05:00 rts: Don't allocate closurePtrs# pointers on C stack Previously `closurePtrs#` would allocate an aray of the size of the closure being decoded on the C stack. This was ripe for overflowing the C stack overflow. This resulted in `T12492` failing on Windows. - - - - - 3af95f7a by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite/T4029: Don't depend on echo On Windows the `cmd.exe` shell may be used to execute the command, which will print `ECHO is on.` instead of a newline if you give it no argument. Avoid this by rather using `printf`. - - - - - 3531c478 by Ben Gamari at 2022-01-30T06:27:19-05:00 Use PATH_FMT instead of %s to format `pathchar *` A few %s occurrences have snuck in over the past months. - - - - - ee5c4f9d by Zubin Duggal at 2022-01-31T16:51:55+05:30 Improve migration strategy for the XDG compliance change to the GHC application directory. We want to always use the old path (~/.ghc/..) if it exists. But we never want to create the old path. This ensures that the migration can eventually be completed once older GHC versions are no longer in circulation. Fixes #20684, #20669, #20660 - - - - - 60a54a8f by doyougnu at 2022-01-31T18:46:11-05:00 StgToCmm: decouple DynFlags, add StgToCmmConfig StgToCmm: add Config, remove CgInfoDownwards StgToCmm: runC api change to take StgToCmmConfig StgToCmm: CgInfoDownad -> StgToCmmConfig StgToCmm.Monad: update getters/setters/withers StgToCmm: remove CallOpts in StgToCmm.Closure StgToCmm: remove dynflag references StgToCmm: PtrOpts removed StgToCmm: add TMap to config, Prof - dynflags StgToCmm: add omit yields to config StgToCmm.ExtCode: remove redundant import StgToCmm.Heap: remove references to dynflags StgToCmm: codeGen api change, DynFlags -> Config StgToCmm: remove dynflags in Env and StgToCmm StgToCmm.DataCon: remove dynflags references StgToCmm: remove dynflag references in DataCon StgToCmm: add backend avx flags to config StgToCmm.Prim: remove dynflag references StgToCmm.Expr: remove dynflag references StgToCmm.Bind: remove references to dynflags StgToCmm: move DoAlignSanitisation to Cmm.Type StgToCmm: remove PtrOpts in Cmm.Parser.y DynFlags: update ipInitCode api StgToCmm: Config Module is single source of truth StgToCmm: Lazy config breaks IORef deadlock testsuite: bump countdeps threshold StgToCmm.Config: strictify fields except UpdFrame Strictifying UpdFrameOffset causes the RTS build with stage1 to deadlock. Additionally, before the deadlock performance of the RTS is noticeably slower. StgToCmm.Config: add field descriptions StgToCmm: revert strictify on Module in config testsuite: update CountDeps tests StgToCmm: update comment, fix exports Specifically update comment about loopification passed into dynflags then stored into stgToCmmConfig. And remove getDynFlags from Monad.hs exports Types.Name: add pprFullName function StgToCmm.Ticky: use pprFullname, fixup ExtCode imports Cmm.Info: revert cmmGetClosureType removal StgToCmm.Bind: use pprFullName, Config update comments StgToCmm: update closureDescription api StgToCmm: SAT altHeapCheck StgToCmm: default render for Info table, ticky Use default rendering contexts for info table and ticky ticky, which should be independent of command line input. testsuite: bump count deps pprFullName: flag for ticky vs normal style output convertInfoProvMap: remove unused parameter StgToCmm.Config: add backend flags to config StgToCmm.Config: remove Backend from Config StgToCmm.Prim: refactor Backend call sites StgToCmm.Prim: remove redundant imports StgToCmm.Config: refactor vec compatibility check StgToCmm.Config: add allowQuotRem2 flag StgToCmm.Ticky: print internal names with parens StgToCmm.Bind: dispatch ppr based on externality StgToCmm: Add pprTickyname, Fix ticky naming Accidently removed the ctx for ticky SDoc output. The only relevant flag is sdocPprDebug which was accidental set to False due to using defaultSDocContext without altering the flag. StgToCmm: remove stateful fields in config fixup: config: remove redundant imports StgToCmm: move Sequel type to its own module StgToCmm: proliferate getCallMethod updated api StgToCmm.Monad: add FCodeState to Monad Api StgToCmm: add second reader monad to FCode fixup: Prim.hs: missed a merge conflict fixup: Match countDeps tests to HEAD StgToCmm.Monad: withState -> withCgState To disambiguate it from mtl withState. This withState shouldn't be returning the new state as a value. However, fixing this means tackling the knot tying in CgState and so is very difficult since it changes when the thunk of the knot is forced which either leads to deadlock or to compiler panic. - - - - - 58eccdbc by Ben Gamari at 2022-01-31T18:46:47-05:00 codeGen: Fix two buglets in -fbounds-check logic @Bodigrim noticed that the `compareByteArray#` bounds-checking logic had flipped arguments and an off-by-one. For the sake of clarity I also refactored occurrences of `cmmOffset` to rather use `cmmOffsetB`. I suspect the former should be retired. - - - - - 584f03fa by Simon Peyton Jones at 2022-01-31T18:47:23-05:00 Make typechecker trace less strict Fixes #21011 - - - - - 60ac7300 by Elton at 2022-02-01T12:28:49-05:00 Use braces in TH case pprint (fixes #20893) This patch ensures that the pretty printer formats `case` statements using braces (instead of layout) to remain consistent with the formatting of other statements (like `do`) - - - - - fdda93b0 by Elton at 2022-02-01T12:28:49-05:00 Use braces in TH LambdaCase and where clauses This patch ensures that the pretty printer formats LambdaCase and where clauses using braces (instead of layout) to remain consistent with the formatting of other statements (like `do` and `case`) - - - - - 06185102 by Ben Gamari at 2022-02-01T12:29:26-05:00 Consistently upper-case "Note [" This was achieved with git ls-tree --name-only HEAD -r | xargs sed -i -e 's/note \[/Note \[/g' - - - - - 88fba8a4 by Ben Gamari at 2022-02-01T12:29:26-05:00 Fix a few Note inconsistencies - - - - - 05548a22 by Douglas Wilson at 2022-02-02T19:26:06-05:00 rts: Address failures to inline - - - - - 074945de by Simon Peyton Jones at 2022-02-02T19:26:41-05:00 Two small improvements in the Simplifier As #20941 describes, this patch implements a couple of small fixes to the Simplifier. They make a difference principally with -O0, so few people will notice. But with -O0 they can reduce the number of Simplifer iterations. * In occurrence analysis we avoid making x = (a,b) into a loop breaker because we want to be able to inline x, or (more likely) do case-elimination. But HEAD does not treat x = let y = blah in (a,b) in the same way. We should though, because we are going to float that y=blah out of the x-binding. A one-line fix in OccurAnal. * The crucial function exprIsConApp_maybe uses getUnfoldingInRuleMatch (rightly) but the latter was deeply strange. In HEAD, if rule-rewriting was off (-O0) we only looked inside stable unfoldings. Very stupid. The patch simplifies. * I also noticed that in simplStableUnfolding we were failing to delete the DFun binders from the usage. So I added that. Practically zero perf change across the board, except that we get more compiler allocation in T3064 (which is compiled with -O0). There's a good reason: we get better code. But there are lots of other small compiler allocation decreases: Metrics: compile_time/bytes allocated --------------------- Baseline Test Metric value New value Change ----------------------------------------------------------------- PmSeriesG(normal) ghc/alloc 44,260,817 44,184,920 -0.2% PmSeriesS(normal) ghc/alloc 52,967,392 52,891,632 -0.1% PmSeriesT(normal) ghc/alloc 75,498,220 75,421,968 -0.1% PmSeriesV(normal) ghc/alloc 52,341,849 52,265,768 -0.1% T10421(normal) ghc/alloc 109,702,291 109,626,024 -0.1% T10421a(normal) ghc/alloc 76,888,308 76,809,896 -0.1% T10858(normal) ghc/alloc 125,149,038 125,073,648 -0.1% T11276(normal) ghc/alloc 94,159,364 94,081,640 -0.1% T11303b(normal) ghc/alloc 40,230,059 40,154,368 -0.2% T11822(normal) ghc/alloc 107,424,540 107,346,088 -0.1% T12150(optasm) ghc/alloc 76,486,339 76,426,152 -0.1% T12234(optasm) ghc/alloc 55,585,046 55,507,352 -0.1% T12425(optasm) ghc/alloc 88,343,288 88,265,312 -0.1% T13035(normal) ghc/alloc 98,919,768 98,845,600 -0.1% T13253-spj(normal) ghc/alloc 121,002,153 120,851,040 -0.1% T16190(normal) ghc/alloc 290,313,131 290,074,152 -0.1% T16875(normal) ghc/alloc 34,756,121 34,681,440 -0.2% T17836b(normal) ghc/alloc 45,198,100 45,120,288 -0.2% T17977(normal) ghc/alloc 39,479,952 39,404,112 -0.2% T17977b(normal) ghc/alloc 37,213,035 37,137,728 -0.2% T18140(normal) ghc/alloc 79,430,588 79,350,680 -0.1% T18282(normal) ghc/alloc 128,303,182 128,225,384 -0.1% T18304(normal) ghc/alloc 84,904,713 84,831,952 -0.1% T18923(normal) ghc/alloc 66,817,241 66,731,984 -0.1% T20049(normal) ghc/alloc 86,188,024 86,107,920 -0.1% T5837(normal) ghc/alloc 35,540,598 35,464,568 -0.2% T6048(optasm) ghc/alloc 99,812,171 99,736,032 -0.1% T9198(normal) ghc/alloc 46,380,270 46,304,984 -0.2% geo. mean -0.0% Metric Increase: T3064 - - - - - d2cce453 by Morrow at 2022-02-02T19:27:21-05:00 Fix @since annotation on Nat - - - - - 6438fed9 by Simon Peyton Jones at 2022-02-02T19:27:56-05:00 Refactor the escaping kind check for data constructors As #20929 pointed out, we were in-elegantly checking for escaping kinds in `checkValidType`, even though that check was guaranteed to succeed for type signatures -- it's part of kind-checking a type. But for /data constructors/ we kind-check the pieces separately, so we still need the check. This MR is a pure refactor, moving the test from `checkValidType` to `checkValidDataCon`. No new tests; external behaviour doesn't change. - - - - - fb05e5ac by Andreas Klebinger at 2022-02-02T19:28:31-05:00 Replace sndOfTriple with sndOf3 I also cleaned up the imports slightly while I was at it. - - - - - fbc77d3a by Matthew Pickering at 2022-02-02T19:29:07-05:00 testsuite: Honour PERF_BASELINE_COMMIT when computing allowed metric changes We now get all the commits between the PERF_BASELINE_COMMIT and HEAD and check any of them for metric changes. Fixes #20882 - - - - - 0a82ae0d by Simon Peyton Jones at 2022-02-02T23:49:58-05:00 More accurate unboxing This patch implements a fix for #20817. It ensures that * The final strictness signature for a function accurately reflects the unboxing done by the wrapper See Note [Finalising boxity for demand signatures] and Note [Finalising boxity for let-bound Ids] * A much better "layer-at-a-time" implementation of the budget for how many worker arguments we can have See Note [Worker argument budget] Generally this leads to a bit more worker/wrapper generation, because instead of aborting entirely if the budget is exceeded (and then lying about boxity), we unbox a bit. Binary sizes in increase slightly (around 1.8%) because of the increase in worker/wrapper generation. The big effects are to GHC.Ix, GHC.Show, GHC.IO.Handle.Internals. If we did a better job of dropping dead code, this effect might go away. Some nofib perf improvements: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- VSD +1.8% -0.5% 0.017 0.017 0.0% awards +1.8% -0.1% +2.3% +2.3% 0.0% banner +1.7% -0.2% +0.3% +0.3% 0.0% bspt +1.8% -0.1% +3.1% +3.1% 0.0% eliza +1.8% -0.1% +1.2% +1.2% 0.0% expert +1.7% -0.1% +9.6% +9.6% 0.0% fannkuch-redux +1.8% -0.4% -9.3% -9.3% 0.0% kahan +1.8% -0.1% +22.7% +22.7% 0.0% maillist +1.8% -0.9% +21.2% +21.6% 0.0% nucleic2 +1.7% -5.1% +7.5% +7.6% 0.0% pretty +1.8% -0.2% 0.000 0.000 0.0% reverse-complem +1.8% -2.5% +12.2% +12.2% 0.0% rfib +1.8% -0.2% +2.5% +2.5% 0.0% scc +1.8% -0.4% 0.000 0.000 0.0% simple +1.7% -1.3% +17.0% +17.0% +7.4% spectral-norm +1.8% -0.1% +6.8% +6.7% 0.0% sphere +1.7% -2.0% +13.3% +13.3% 0.0% tak +1.8% -0.2% +3.3% +3.3% 0.0% x2n1 +1.8% -0.4% +8.1% +8.1% 0.0% -------------------------------------------------------------------------------- Min +1.1% -5.1% -23.6% -23.6% 0.0% Max +1.8% +0.0% +36.2% +36.2% +7.4% Geometric Mean +1.7% -0.1% +6.8% +6.8% +0.1% Compiler allocations in CI have a geometric mean of +0.1%; many small decreases but there are three bigger increases (7%), all because we do more worker/wrapper than before, so there is simply more code to compile. That's OK. Perf benchmarks in perf/should_run improve in allocation by a geo mean of -0.2%, which is good. None get worse. T12996 improves by -5.8% Metric Decrease: T12996 Metric Increase: T18282 T18923 T9630 - - - - - d1ef6288 by Peter Trommler at 2022-02-02T23:50:34-05:00 Cmm: fix equality of expressions Compare expressions and types when comparing `CmmLoad`s. Fixes #21016 - - - - - e59446c6 by Peter Trommler at 2022-02-02T23:50:34-05:00 Check type first then expression - - - - - b0e1ef4a by Matthew Pickering at 2022-02-03T14:44:17-05:00 Add failing test for #20791 The test produces different output on static vs dynamic GHC builds. - - - - - cae1fb17 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Frontend01 passes with static GHC - - - - - e343526b by Matthew Pickering at 2022-02-03T14:44:17-05:00 Don't initialise plugins when there are no pipelines to run - - - - - abac45fc by Matthew Pickering at 2022-02-03T14:44:17-05:00 Mark prog003 as expected_broken on static way #20704 - - - - - 13300dfd by Matthew Pickering at 2022-02-03T14:44:17-05:00 Filter out -rtsopts in T16219 to make static/dynamic ways agree - - - - - d89439f2 by Matthew Pickering at 2022-02-03T14:44:17-05:00 T13168: Filter out rtsopts for consistency between dynamic and static ways - - - - - 00180cdf by Matthew Pickering at 2022-02-03T14:44:17-05:00 Accept new output for T14335 test This test was previously not run due to #20960 - - - - - 1accdcff by Matthew Pickering at 2022-02-03T14:44:17-05:00 Add flushes to plugin tests which print to stdout Due to #20791 you need to explicitly flush as otherwise the output from these tests doesn't make it to stdout. - - - - - d820f2e8 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Remove ghc_plugin_way Using ghc_plugin_way had the unintended effect of meaning certain tests weren't run at all when ghc_dynamic=true, if you delete this modifier then the tests work in both the static and dynamic cases. - - - - - aa5ef340 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Unbreak T13168 on windows Fixes #14276 - - - - - 84ab0153 by Matthew Pickering at 2022-02-03T14:44:53-05:00 Rewrite CallerCC parser using ReadP This allows us to remove the dependency on parsec and hence transitively on text. Also added some simple unit tests for the parser and fixed two small issues in the documentation. Fixes #21033 - - - - - 4e6780bb by Matthew Pickering at 2022-02-03T14:45:28-05:00 ci: Add debian 11 jobs (validate/release/nightly) Fixes #21002 - - - - - eddaa591 by Ben Gamari at 2022-02-04T10:01:59-05:00 compiler: Introduce and use RoughMap for instance environments Here we introduce a new data structure, RoughMap, inspired by the previous `RoughTc` matching mechanism for checking instance matches. This allows [Fam]InstEnv to be implemented as a trie indexed by these RoughTc signatures, reducing the complexity of instance lookup and FamInstEnv merging (done during the family instance conflict test) from O(n) to O(log n). The critical performance improvement currently realised by this patch is in instance matching. In particular the RoughMap mechanism allows us to discount many potential instances which will never match for constraints involving type variables (see Note [Matching a RoughMap]). In realistic code bases matchInstEnv was accounting for 50% of typechecker time due to redundant work checking instances when simplifying instance contexts when deriving instances. With this patch the cost is significantly reduced. The larger constants in InstEnv creation do mean that a few small tests regress in allocations slightly. However, the runtime of T19703 is reduced by a factor of 4. Moreover, the compilation time of the Cabal library is slightly improved. A couple of test cases are included which demonstrate significant improvements in compile time with this patch. This unfortunately does not fix the testcase provided in #19703 but does fix #20933 ------------------------- Metric Decrease: T12425 Metric Increase: T13719 T9872a T9872d hard_hole_fits ------------------------- Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 62d670eb by Matthew Pickering at 2022-02-04T10:02:35-05:00 testsuite: Run testsuite dependency calculation before GHC is built The main motivation for this patch is to allow tests to be added to the testsuite which test things about the source tree without needing to build GHC. In particular the notes linter can easily start failing and by integrating it into the testsuite the process of observing these changes is caught by normal validation procedures rather than having to run the linter specially. With this patch I can run ``` ./hadrian/build test --flavour=devel2 --only="uniques" ``` In a clean tree to run the checkUniques linter without having to build GHC. Fixes #21029 - - - - - 4bd52410 by Hécate Moonlight at 2022-02-04T16:14:10-05:00 Add the Ix class to Foreign C integral types Related CLC proposal is here: https://github.com/haskell/core-libraries-committee/issues/30 - - - - - de6d7692 by Ben Gamari at 2022-02-04T16:14:47-05:00 Drop dead code - - - - - b79206f1 by Ben Gamari at 2022-02-04T16:14:47-05:00 Add comments - - - - - 58d7faac by Ben Gamari at 2022-02-04T16:14:47-05:00 cmm: Introduce cmmLoadBWord and cmmLoadGCWord - - - - - 7217156c by Ben Gamari at 2022-02-04T16:14:47-05:00 Introduce alignment in CmmLoad - - - - - 99ea5f2c by Ben Gamari at 2022-02-04T16:14:47-05:00 Introduce alignment to CmmStore - - - - - 606b59a5 by Ben Gamari at 2022-02-04T16:14:47-05:00 Fix array primop alignment - - - - - 1cf9616a by Ben Gamari at 2022-02-04T16:14:47-05:00 llvmGen: Handle unaligned loads/stores This allows us to produce valid code for indexWord8ArrayAs*# on platforms that lack unaligned memory access. - - - - - 8c18feba by Ben Gamari at 2022-02-04T16:14:47-05:00 primops: Fix documentation of setByteArray# Previously the documentation was subtly incorrect regarding the bounds of the operation. Fix this and add a test asserting that a zero-length operation is in fact a no-op. - - - - - 88480e55 by nineonine at 2022-02-04T20:35:45-05:00 Fix unsound behavior of unlifted datatypes in ghci (#20194) Previously, directly calling a function that pattern matches on an unlifted data type which has at least two constructors in GHCi resulted in a segfault. This happened due to unaccounted return frame info table pointer. The fix is to pop the above mentioned frame info table pointer when unlifted things are returned. See Note [Popping return frame for unlifted things] authors: bgamari, nineonine - - - - - a5c7068c by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Add Outputable instance for Messages c.f. #20980 - - - - - bf495f72 by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Add a missing restoreLclEnv The commit commit 18df4013f6eaee0e1de8ebd533f7e96c4ee0ff04 Date: Sat Jan 22 01:12:30 2022 +0000 Define and use restoreLclEnv omitted to change one setLclEnv to restoreLclEnv, namely the one in GHC.Tc.Errors.warnRedundantConstraints. This new commit fixes the omission. - - - - - 6af8e71e by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Improve errors for non-existent labels This patch fixes #17469, by improving matters when you use non-existent field names in a record construction: data T = MkT { x :: Int } f v = MkT { y = 3 } The check is now made in the renamer, in GHC.Rename.Env.lookupRecFieldOcc. That in turn led to a spurious error in T9975a, which is fixed by making GHC.Rename.Names.extendGlobalRdrEnvRn fail fast if it finds duplicate bindings. See Note [Fail fast on duplicate definitions] in that module for more details. This patch was originated and worked on by Alex D (@nineonine) - - - - - 299acff0 by nineonine at 2022-02-05T19:21:49-05:00 Exit with failure when -e fails (fixes #18411 #9916 #17560) - - - - - 549292eb by Matthew Pickering at 2022-02-05T19:22:25-05:00 Make implication tidying agree with Note [Tidying multiple names at once] Note [Tidying multiple names at once] indicates that if multiple variables have the same name then we shouldn't prioritise one of them and instead rename them all to a1, a2, a3... etc This patch implements that change, some error message changes as expected. Closes #20932 - - - - - 2e9248b7 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts/m32: Accept any address within 4GB of program text Previously m32 would assume that the program image was located near the start of the address space and therefore assume that it wanted pages in the bottom 4GB of address space. Instead we now check whether they are within 4GB of whereever the program is loaded. This is necessary on Windows, which now tends to place the image in high memory. The eventual goal is to use m32 to allocate memory for linker sections on Windows. - - - - - 86589b89 by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts: Generalize mmapForLinkerMarkExecutable Renamed to mprotectForLinker and allowed setting of arbitrary protection modes. - - - - - 88ef270a by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts/m32: Add consistency-checking infrastructure This adds logic, enabled in the `-debug` RTS for checking the internal consistency of the m32 allocator. This area has always made me a bit nervous so this should help me sleep better at night in exchange for very little overhead. - - - - - 2d6f0b17 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts/m32: Free large objects back to the free page pool Not entirely convinced that this is worth doing. - - - - - e96f50be by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts/m32: Increase size of free page pool to 256 pages - - - - - fc083b48 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts: Dump memory map on memory mapping failures Fixes #20992. - - - - - 633296bc by Ben Gamari at 2022-02-06T01:43:56-05:00 Fix macro redefinition warnings for PRINTF * Move `PRINTF` macro from `Stats.h` to `Stats.c` as it's only needed in the latter. * Undefine `PRINTF` at the end of `Messages.h` to avoid leaking it. - - - - - 37d435d2 by John Ericson at 2022-02-06T01:44:32-05:00 Purge DynFlags from GHC.Stg Also derive some more instances. GHC doesn't need them, but downstream consumers may need to e.g. put stuff in maps. - - - - - 886baa34 by Peter Trommler at 2022-02-06T10:58:18+01:00 RTS: Fix cabal specification In 35bea01b xxhash.c was removed. Remove the extra-source-files stanza referring to it. - - - - - 27581d77 by Alex D at 2022-02-06T20:50:44-05:00 hadrian: remove redundant import - - - - - 4ff19981 by John Ericson at 2022-02-07T11:04:43-05:00 GHC.HsToCore.Coverage: No more HscEnv, less DynFlags Progress towards #20730 - - - - - b09389a6 by John Ericson at 2022-02-07T11:04:43-05:00 Create `CoverageConfig` As requested by @mpickering to collect the information we project from `HscEnv` - - - - - ff867c46 by Greg Steuck at 2022-02-07T11:05:24-05:00 Avoid using removed utils/checkUniques in validate Asked the question: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7460/diffs#4061f4d17546e239dd10d78c6b48668c2a288e02_1_0 - - - - - a9355e84 by sheaf at 2022-02-08T05:27:25-05:00 Allow HasField in quantified constraints We perform validity checking on user-written HasField instances, for example to disallow: data Foo a = Foo { fld :: Int } instance HasField "fld" (Foo a) Bool However, these checks were also being made on quantified constraints, e.g. data Bar where Bar :: (forall a. HasField s (Foo a) Int) => Proxy s -> Bar This patch simply skips validity checking for quantified constraints, in line with what we already do for equality constraints such as Coercible. Fixes #20989 - - - - - 6d77d3d8 by sheaf at 2022-02-08T05:28:05-05:00 Relax TyEq:N: allow out-of-scope newtype DataCon The 'bad_newtype' assertion in GHC.Tc.Solver.Canonical.canEqCanLHSFinish failed to account for the possibility that the newtype constructor might not be in scope, in which case we don't provide any guarantees about canonicalising away a newtype on the RHS of a representational equality. Fixes #21010 - - - - - a893d2f3 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Remove linter dependency on lint-submods - - - - - 457a5b9c by Ben Gamari at 2022-02-08T05:28:42-05:00 notes-util: initial commit - - - - - 1a943859 by Ben Gamari at 2022-02-08T05:28:42-05:00 gitlab-ci: Add lint-notes job - - - - - bc5cbce6 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Add notes linter to testsuite - - - - - 38c6e301 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Fix some notes - - - - - c3aac0f8 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Add suggestion mode to notes-util - - - - - 5dd29aea by Cale Gibbard at 2022-02-08T05:29:18-05:00 `hscSimpleIface` drop fingerprint param and ret `hscSimpleIface` does not depend on or modify the `Maybe Fingerprint` it is given, only passes it through, so get rid of the extraneous passing. Perhaps the intent was that there would be an iface fingerprint check of some sort? but this was never done. If/when we we want to do that, we can add it back then. - - - - - 4bcbd731 by Cale Gibbard at 2022-02-08T05:29:54-05:00 Document `hscIncrementalFrontend` and flip bool - - - - - b713db1e by John Ericson at 2022-02-08T05:30:29-05:00 StgToCmm: Get rid of GHC.Driver.Session imports `DynFlags` is gone, but let's move a few trivial things around to get rid of its module too. - - - - - f115c382 by Gleb Popov at 2022-02-08T05:31:05-05:00 Fix build on recent FreeBSD. Recent FreeBSD versions gained the sched_getaffinity function, which made two mutually exclusive #ifdef blocks to be enabled. - - - - - 3320ab40 by Ben Gamari at 2022-02-08T10:42:04-05:00 rts/MemoryMap: Use mach_-prefixed type names There appears to be some inconsistency in system-call type naming across Darwin toolchains. Specifically: * the `address` argument to `mach_vm_region` apparently wants to be a `mach_vm_address_t *`, not a `vm_address_t *` * the `vmsize` argument to `mach_vm_region` wants to be a `mach_vm_size_t`, not a `vm_size_t` - - - - - b33f0cfa by Richard Eisenberg at 2022-02-08T10:42:41-05:00 Document that reifyRoles includes kind parameters Close #21056 - - - - - bd493ed6 by PHO at 2022-02-08T10:43:19-05:00 Don't try to build stage1 with -eventlog if stage0 doesn't provide it Like -threaded, stage0 isn't guaranteed to have an event-logging RTS. - - - - - 03c2de0f by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Use absolute paths for config.libdir Fixes #21052 - - - - - ef294525 by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Clean up old/redundant predicates - - - - - a39ed908 by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Add missing dependency on ghcconfig - - - - - a172be07 by PHO at 2022-02-09T03:56:59-05:00 Implement System.Environment.getExecutablePath for NetBSD and also use it from GHC.BaseDir.getBaseDir - - - - - 62fa126d by PHO at 2022-02-09T03:57:37-05:00 Fix a portability issue in m4/find_llvm_prog.m4 `test A == B' is a Bash extension, which doesn't work on platforms where /bin/sh is not Bash. - - - - - fd9981e3 by Ryan Scott at 2022-02-09T03:58:13-05:00 Look through untyped TH splices in tcInferAppHead_maybe Previously, surrounding a head expression with a TH splice would defeat `tcInferAppHead_maybe`, preventing some expressions from typechecking that used to typecheck in previous GHC versions (see #21038 for examples). This is simple enough to fix: just look through `HsSpliceE`s in `tcInferAppHead_maybe`. I've added some additional prose to `Note [Application chains and heads]` in `GHC.Tc.Gen.App` to accompany this change. Fixes #21038. - - - - - 00975981 by sheaf at 2022-02-09T03:58:53-05:00 Add test for #21037 This program was rejected by GHC 9.2, but is accepted on newer versions of GHC. This patch adds a regression test. Closes #21037 - - - - - fad0b2b0 by Ben Gamari at 2022-02-09T08:29:46-05:00 Rename -merge-objs flag to --merge-objs For consistency with --make and friends. - - - - - 1dbe5b2a by Matthew Pickering at 2022-02-09T08:30:22-05:00 driver: Filter out our own boot module in hptSomeThingsBelow hptSomeThingsBelow would return a list of modules which contain the .hs-boot file for a particular module. This caused some problems because we would try and find the module in the HPT (but it's not there when we're compiling the module itself). Fixes #21058 - - - - - 2b1cced1 by Sylvain Henry at 2022-02-09T20:42:23-05:00 NCG: minor code factorization - - - - - e01ffec2 by Sylvain Henry at 2022-02-09T20:42:23-05:00 ByteCode: avoid out-of-bound read Cf https://gitlab.haskell.org/ghc/ghc/-/issues/18431#note_287139 - - - - - 53c26e79 by Ziyang Liu at 2022-02-09T20:43:02-05:00 Include ru_name in toHsRule message See #18147 - - - - - 3df06922 by Ben Gamari at 2022-02-09T20:43:39-05:00 rts: Rename MemoryMap.[ch] -> ReportMemoryMap.[ch] - - - - - e219ac82 by Ben Gamari at 2022-02-09T20:43:39-05:00 rts: Move mmapForLinker and friends to linker/MMap.c They are not particularly related to linking. - - - - - 30e205ca by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/linker: Drop dead IA64 code - - - - - 4d3a306d by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/linker/MMap: Use MemoryAccess in mmapForLinker - - - - - 1db4f1fe by Ben Gamari at 2022-02-09T20:43:39-05:00 linker: Don't use MAP_FIXED As noted in #21057, we really shouldn't be using MAP_FIXED. I would much rather have the process crash with a "failed to map" error than randomly overwrite existing mappings. Closes #21057. - - - - - 1eeae25c by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/mmap: Refactor mmapForLinker Here we try to separate the policy decisions of where to place mappings from the mechanism of creating the mappings. This makes things significantly easier to follow. - - - - - ac2d18a7 by sheaf at 2022-02-09T20:44:18-05:00 Add some perf tests for coercions This patch adds some performance tests for programs that create large coercions. This is useful because the existing test coverage is not very representative of real-world situations. In particular, this adds a test involving an extensible records library, a common pain-point for users. - - - - - 48f25715 by Andreas Klebinger at 2022-02-10T04:35:35-05:00 Add late cost centre support This allows cost centres to be inserted after the core optimization pipeline has run. - - - - - 0ff70427 by Andreas Klebinger at 2022-02-10T04:36:11-05:00 Docs:Mention that safe calls don't keep their arguments alive. - - - - - 1d3ed168 by Ben Gamari at 2022-02-10T04:36:46-05:00 PEi386: Drop Windows Vista fallback in addLibrarySearchPath We no longer support Windows Vista. - - - - - 2a6f2681 by Ben Gamari at 2022-02-10T04:36:46-05:00 linker/PEi386: Make addLibrarySearchPath long-path aware Previously `addLibrarySearchPath` failed to normalise the added path to UNC form before passing it to `AddDllDirectory`. Consequently, the call was subject to the MAX_PATH restriction, leading to the failure of `test-defaulting-plugin-fail`, among others. Happily, this also nicely simplifies the implementation. Closes #21059. - - - - - 2a47ee9c by Daniel Gröber at 2022-02-10T19:18:58-05:00 ghc-boot: Simplify writePackageDb permissions handling Commit ef8a3fbf1 ("ghc-boot: Fix metadata handling of writeFileAtomic") introduced a somewhat over-engineered fix for #14017 by trying to preserve the current permissions if the target file already exists. The problem in the issue is simply that the package db cache file should be world readable but isn't if umask is too restrictive. In fact the previous fix only handles part of this problem. If the file isn't already there in a readable configuration it wont make it so which isn't really ideal either. Rather than all that we now simply always force all the read access bits to allow access while leaving the owner at the system default as it's just not our business to mess with it. - - - - - a1d97968 by Ben Gamari at 2022-02-10T19:19:34-05:00 Bump Cabal submodule Adapts GHC to the factoring-out of `Cabal-syntax`. Fixes #20991. Metric Decrease: haddock.Cabal - - - - - 89cf8caa by Morrow at 2022-02-10T19:20:13-05:00 Add metadata to integer-gmp.cabal - - - - - c995b7e7 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix event type of EVENT_IPE This leads to corrupted eventlogs because the size of EVENT_IPE is completely wrong. Fixes a bug introduced in 2e29edb7421c21902b47d130d45f60d3f584a0de - - - - - 59ba8fb3 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix event type of MEM_RETURN This leads to corrupted eventlogs because the size of EVENT_MEM_RETURN is completely wrong. Fixes a bug introduced in 2e29edb7421c21902b47d130d45f60d3f584a0de - - - - - 19413d09 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Delete misleading comment in gen_event_types.py Not all events start with CapNo and there's not logic I could see which adds this to the length. - - - - - e06f49c0 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix size of TICKY_COUNTER_BEGIN_SAMPLE - - - - - 2f99255b by Matthew Pickering at 2022-02-10T19:21:24-05:00 Fix copy-pasto in prof-late-ccs docs - - - - - 19deb002 by Matthew Pickering at 2022-02-10T19:21:59-05:00 Refine tcSemigroupWarnings to work in ghc-prim ghc-prim doesn't depend on base so can't have any Monoid or Semigroup instances. However, attempting to load these definitions ran into issues when the interface for `GHC.Base` did exist as that would try and load the interface for `GHC.Types` (which is the module we are trying to compile and has no interface). The fix is to just not do this check when we are compiling a module in ghc-prim. Fixes #21069 - - - - - 34dec6b7 by sheaf at 2022-02-11T17:55:34-05:00 Decrease the size of the LargeRecord test This test was taking too long to run, so this patch makes it smaller. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 9cab90d9 by Matthew Pickering at 2022-02-11T22:27:19-05:00 Make sure all platforms have a release job The release bindists are currently a mixture of validate and release builds. This is bad because the validate builds don't have profiling libraries. The fix is to make sure there is a release job for each platform we want to produce a release for.t Fixes #21066 - - - - - 4bce3575 by Matthew Pickering at 2022-02-11T22:27:54-05:00 testsuite: Make sure all tests trigger ghc rebuild I made a mistake when implementing #21029 which meant that certain tests didn't trigger a GHC recompilation. By adding the `test:ghc` target to the default settings all tests will now depend on this target unless explicitly opting out via the no_deps modifier. - - - - - 90a26f8b by Sylvain Henry at 2022-02-11T22:28:34-05:00 Fix documentation about Word64Rep/Int64Rep (#16964) - - - - - 0e93023e by Andreas Klebinger at 2022-02-12T13:59:41+00:00 Tag inference work. This does three major things: * Enforce the invariant that all strict fields must contain tagged pointers. * Try to predict the tag on bindings in order to omit tag checks. * Allows functions to pass arguments unlifted (call-by-value). The former is "simply" achieved by wrapping any constructor allocations with a case which will evaluate the respective strict bindings. The prediction is done by a new data flow analysis based on the STG representation of a program. This also helps us to avoid generating redudant cases for the above invariant. StrictWorkers are created by W/W directly and SpecConstr indirectly. See the Note [Strict Worker Ids] Other minor changes: * Add StgUtil module containing a few functions needed by, but not specific to the tag analysis. ------------------------- Metric Decrease: T12545 T18698b T18140 T18923 LargeRecord Metric Increase: LargeRecord ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T15164 T18282 T18304 T18698a T1969 T20049 T3294 T4801 T5321FD T5321Fun T783 T9233 T9675 T9961 T19695 WWRec ------------------------- - - - - - 744f8a11 by Greg Steuck at 2022-02-12T17:13:55-05:00 Only check the exit code in derefnull & divbyzero tests on OpenBSD - - - - - eeead9fc by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/Adjustor: Ensure that allocateExecPage succeeded Previously we failed to handle the case that `allocateExecPage` failed. - - - - - afdfaff0 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Drop DEC Alpha adjustor implementation The last Alpha chip was produced in 2004. - - - - - 191dfd2d by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/adjustor: Split Windows path out of NativeAmd64 - - - - - be591e27 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Initial commit of AdjustorPool - - - - - d6d48b16 by Ben Gamari at 2022-02-13T03:26:14-05:00 Introduce initAdjustors - - - - - eab37902 by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64: Use AdjustorPool - - - - - 974e73af by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64Mingw: Use AdjustorPool - - - - - 95fab83f by Ben Gamari at 2022-02-13T03:26:14-05:00 configure: Fix result reporting of adjustors method check - - - - - ef5cf55d by nikshalark at 2022-02-13T03:26:16-05:00 (#21044) Documented arithmetic functions in base. Didn't get it right the ninth time. Now everything's formatted correctly. - - - - - acb482cc by Takenobu Tani at 2022-02-16T05:27:17-05:00 Relax load_load_barrier for aarch64 This patch relaxes the instruction for load_load_barrier(). Current load_load_barrier() implements full-barrier with `dmb sy`. It's too strong to order load-load instructions. We can relax it by using `dmb ld`. If current load_load_barrier() is used for full-barriers (load/store - load/store barrier), this patch is not suitable. See also linux-kernel's smp_rmb() implementation: https://github.com/torvalds/linux/blob/v5.14/arch/arm64/include/asm/barrier.h#L90 Hopefully, it's better to use `dmb ishld` rather than `dmb ld` to improve performance. However, I can't validate effects on a real many-core Arm machine. - - - - - 84eaa26f by Oleg Grenrus at 2022-02-16T05:27:56-05:00 Add test for #20562 - - - - - 2c28620d by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: remove struct StgRetry, it is never used - - - - - 74bf9bb5 by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: document some closure types - - - - - 316312ec by nineonine at 2022-02-16T05:29:08-05:00 ghci: fix -ddump-stg-cg (#21052) The pre-codegen Stg AST dump was not available in ghci because it was performed in 'doCodeGen'. This was now moved to 'coreToStg' area. - - - - - a6411d74 by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: mention -fprof-late-ccs in the release notes And note which compiler version it was added in. - - - - - 4127e86d by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: fix release notes formatting - - - - - 4e6c8019 by Matthew Pickering at 2022-02-17T05:25:28-05:00 Always define __GLASGOW_HASKELL_PATCHLEVEL1/2__ macros As #21076 reports if you are using `-Wcpp-undef` then you get warnings when using the `MIN_VERSION_GLASGOW_HASKELL` macro because __GLASGOW_HASKELL_PATCHLEVEL2__ is very rarely explicitliy set (as version numbers are not 4 components long). This macro was introduced in 3549c952b535803270872adaf87262f2df0295a4 and it seems the bug has existed ever since. Fixes #21076 - - - - - 67dd5724 by Ben Gamari at 2022-02-17T05:26:03-05:00 rts/AdjustorPool: Silence unused function warning bitmap_get is only used in the DEBUG RTS configuration. Fixes #21079. - - - - - 4b04f7e1 by Zubin Duggal at 2022-02-20T13:56:15-05:00 Track object file dependencies for TH accurately (#20604) `hscCompileCoreExprHook` is changed to return a list of `Module`s required by a splice. These modules are accumulated in the TcGblEnv (tcg_th_needed_mods). Dependencies on the object files of these modules are recording in the interface. The data structures in `LoaderState` are replaced with more efficient versions to keep track of all the information required. The MultiLayerModulesTH_Make allocations increase slightly but runtime is faster. Fixes #20604 ------------------------- Metric Increase: MultiLayerModulesTH_Make ------------------------- - - - - - 92ab3ff2 by sheaf at 2022-02-20T13:56:55-05:00 Use diagnostics for "missing signature" errors This patch makes the "missing signature" errors from "GHC.Rename.Names" use the diagnostic infrastructure. This encompasses missing type signatures for top-level bindings and pattern synonyms, as well as missing kind signatures for type constructors. This patch also renames TcReportMsg to TcSolverReportMsg, and adds a few convenience functions to compute whether such a TcSolverReportMsg is an expected/actual message. - - - - - 845284a5 by sheaf at 2022-02-20T13:57:34-05:00 Generically: remove redundant Semigroup constraint This patch removes a redundant Semigroup constraint on the Monoid instance for Generically. This constraint can cause trouble when one wants to derive a Monoid instance via Generically through a type that doesn't itself have a Semigroup instance, for example: data Point2D a = Point2D !a !a newtype Vector2D a = Vector2D { tip :: Point2D a } deriving ( Semigroup, Monoid ) via Generically ( Point2D ( Sum a ) ) In this case, we should not require there to be an instance Semigroup ( Point2D ( Sum a ) ) as all we need is an instance for the generic representation of Point2D ( Sum a ), i.e. Semigroup ( Rep ( Point2D ( Sum a) ) () ). - - - - - 6b468f7f by Ben Gamari at 2022-02-20T13:58:10-05:00 Bump time submodule to 1.12.1 - - - - - 2f0ceecc by Zubin Duggal at 2022-02-20T19:06:19+00:00 hadrian: detect if 'main' is not a haskell file and add it to appropriate list of sources - - - - - 7ce1b694 by Zubin Duggal at 2022-02-21T11:18:58+00:00 Reinstallable GHC This patch allows ghc and its dependencies to be built using a normal invocation of cabal-install. Each componenent which relied on generated files or additional configuration now has a Setup.hs file. There are also various fixes to the cabal files to satisfy cabal-install. There is a new hadrian command which will build a stage2 compiler and then a stage3 compiler by using cabal. ``` ./hadrian/build build-cabal ``` There is also a new CI job which tests running this command. For the 9.4 release we will upload all the dependent executables to hackage and then end users will be free to build GHC and GHC executables via cabal. There are still some unresolved questions about how to ensure soundness when loading plugins into a reinstalled GHC (#20742) which will be tighted up in due course. Fixes #19896 - - - - - 78fbc3a3 by Matthew Pickering at 2022-02-21T15:14:28-05:00 hadrian: Enable late-ccs when building profiled_ghc - - - - - 2b890c89 by Matthew Pickering at 2022-02-22T15:59:33-05:00 testsuite: Don't print names of all fragile tests on all runs This information about fragile tests is pretty useless but annoying on CI where you have to scroll up a long way to see the actual issues. - - - - - 0b36801f by sheaf at 2022-02-22T16:00:14-05:00 Forbid standalone instances for built-in classes `check_special_inst_head` includes logic that disallows hand-written instances for built-in classes such as Typeable, KnownNat and KnownSymbol. However, it also allowed standalone deriving declarations. This was because we do want to allow standalone deriving instances with Typeable as they are harmless, but we certainly don't want to allow instances for e.g. KnownNat. This patch ensures that we don't allow derived instances for KnownNat, KnownSymbol (and also KnownChar, which was previously omitted entirely). Fixes #21087 - - - - - ace66dec by Krzysztof Gogolewski at 2022-02-22T16:30:59-05:00 Remove -Wunticked-promoted-constructors from -Wall Update manual; explain ticks as optional disambiguation rather than the preferred default. This is a part of #20531. - - - - - 558c7d55 by Hugo at 2022-02-22T16:31:01-05:00 docs: fix error in annotation guide code snippet - - - - - a599abba by Richard Eisenberg at 2022-02-23T08:16:07-05:00 Kill derived constraints Co-authored by: Sam Derbyshire Previously, GHC had three flavours of constraint: Wanted, Given, and Derived. This removes Derived constraints. Though serving a number of purposes, the most important role of Derived constraints was to enable better error messages. This job has been taken over by the new RewriterSets, as explained in Note [Wanteds rewrite wanteds] in GHC.Tc.Types.Constraint. Other knock-on effects: - Various new Notes as I learned about under-described bits of GHC - A reshuffling around the AST for implicit-parameter bindings, with better integration with TTG. - Various improvements around fundeps. These were caused by the fact that, previously, fundep constraints were all Derived, and Derived constraints would get dropped. Thus, an unsolved Derived didn't stop compilation. Without Derived, this is no longer possible, and so we have to be considerably more careful around fundeps. - A nice little refactoring in GHC.Tc.Errors to center the work on a new datatype called ErrorItem. Constraints are converted into ErrorItems at the start of processing, and this allows for a little preprocessing before the main classification. - This commit also cleans up the behavior in generalisation around functional dependencies. Now, if a variable is determined by functional dependencies, it will not be quantified. This change is user facing, but it should trim down GHC's strange behavior around fundeps. - Previously, reportWanteds did quite a bit of work, even on an empty WantedConstraints. This commit adds a fast path. - Now, GHC will unconditionally re-simplify constraints during quantification. See Note [Unconditionally resimplify constraints when quantifying], in GHC.Tc.Solver. Close #18398. Close #18406. Solve the fundep-related non-confluence in #18851. Close #19131. Close #19137. Close #20922. Close #20668. Close #19665. ------------------------- Metric Decrease: LargeRecord T9872b T9872b_defer T9872d TcPlugin_RewritePerf ------------------------- - - - - - 2ed22ba1 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Introduce predicate for when to enable source notes (needSourceNotes) There were situations where we were using debugLevel == 0 as a proxy for whether to retain source notes but -finfo-table-map also enables and needs source notes so we should act consistently in both cases. Ticket #20847 - - - - - 37deb893 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Use SrcSpan from the binder as initial source estimate There are some situations where we end up with no source notes in useful positions in an expression. In this case we currently fail to provide any source information about where an expression came from. This patch improves the initial estimate by using the position from the top-binder as the guess for the location of the whole inner expression. It provides quite a course estimate but it's better than nothing. Ticket #20847 - - - - - 59b7f764 by Cheng Shao at 2022-02-23T08:17:24-05:00 Don't emit foreign exports initialiser code for empty CAF list - - - - - c7f32f76 by John Ericson at 2022-02-23T13:58:36-05:00 Prepare rechecking logic for new type in a few ways Combine `MustCompile and `NeedsCompile` into a single case. `CompileReason` is put inside to destinguish the two. This makes a number of things easier. `Semigroup RecompileRequired` is no longer used, to make sure we skip doing work where possible. `recompThen` is very similar, but helps remember. `checkList` is rewritten with `recompThen`. - - - - - e60d8df8 by John Ericson at 2022-02-23T13:58:36-05:00 Introduce `MaybeValidated` type to remove invalid states The old return type `(RecompRequired, Maybe _)`, was confusing because it was inhabited by values like `(UpToDate, Nothing)` that made no sense. The new type ensures: - you must provide a value if it is up to date. - you must provide a reason if you don't provide a value. it is used as the return value of: - `checkOldIface` - `checkByteCode` - `checkObjects` - - - - - f07b13e3 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor X86 codegen Preliminary work done to make working on #5444 easier. Mostly make make control-flow easier to follow: * renamed genCCall into genForeignCall * split genForeignCall into the part dispatching on PrimTarget (genPrim) and the one really generating code for a C call (cf ForeignTarget and genCCall) * made genPrim/genSimplePrim only dispatch on MachOp: each MachOp now has its own code generation function. * out-of-line primops are not handled in a partial `outOfLineCmmOp` anymore but in the code generation functions directly. Helper functions have been introduced (e.g. genLibCCall) for code sharing. * the latter two bullets make code generated for primops that are only sometimes out-of-line (e.g. Pdep or Memcpy) and the logic to select between inline/out-of-line much more localized * avoided passing is32bit as an argument as we can easily get it from NatM state when we really need it * changed genCCall type to avoid it being partial (it can't handle PrimTarget) * globally removed 12 calls to `panic` thanks to better control flow and types ("parse, don't validate" ftw!). - - - - - 6fa7591e by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor the way registers are handled * add getLocalRegReg to avoid allocating a CmmLocal just to call getRegisterReg * 64-bit registers: in the general case we must always use the virtual higher part of the register, so we might as well always return it with the lower part. The only exception is to implement 64-bit to 32-bit conversions. We now have to explicitly discard the higher part when matching on Reg64/RegCode64 datatypes instead of explicitly fetching the higher part from the lower part: much safer default. - - - - - bc8de322 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: inline some 64-bit primops on x86/32-bit (#5444) Several 64-bit operation were implemented with FFI calls on 32-bit architectures but we can easily implement them with inline assembly code. Also remove unused hs_int64ToWord64 and hs_word64ToInt64 C functions. - - - - - 7b7c6b95 by Matthew Pickering at 2022-02-23T14:00:00-05:00 Simplify/correct implementation of getModuleInfo - - - - - 6215b04c by Matthew Pickering at 2022-02-23T14:00:00-05:00 Remove mg_boot field from ModuleGraph It was unused in the compiler so I have removed it to streamline ModuleGraph. - - - - - 818ff2ef by Matthew Pickering at 2022-02-23T14:00:01-05:00 driver: Remove needsTemplateHaskellOrQQ from ModuleGraph The idea of the needsTemplateHaskellOrQQ query is to check if any of the modules in a module graph need Template Haskell then enable -dynamic-too if necessary. This is quite imprecise though as it will enable -dynamic-too for all modules in the module graph even if only one module uses template haskell, with multiple home units, this is obviously even worse. With -fno-code we already have similar logic to enable code generation just for the modules which are dependeded on my TemplateHaskell modules so we use the same code path to decide whether to enable -dynamic-too rather than using this big hammer. This is part of the larger overall goal of moving as much statically known configuration into the downsweep as possible in order to have fully decided the build plan and all the options before starting to build anything. I also included a fix to #21095, a long standing bug with with the logic which is supposed to enable the external interpreter if we don't have the internal interpreter. Fixes #20696 #21095 - - - - - b6670af6 by Matthew Pickering at 2022-02-23T14:00:40-05:00 testsuite: Normalise output of ghci011 and T7627 The outputs of these tests vary on the order interface files are loaded so we normalise the output to correct for these inconsequential differences. Fixes #21121 - - - - - 9ed3bc6e by Peter Trommler at 2022-02-23T14:01:16-05:00 testsuite: Fix ipeMap test Pointers to closures must be untagged before use. Produce closures of different types so we get different info tables. Fixes #21112 - - - - - 7d426148 by Ziyang Liu at 2022-02-24T04:53:34-05:00 Allow `return` in more cases in ApplicativeDo The doc says that the last statement of an ado-block can be one of `return E`, `return $ E`, `pure E` and `pure $ E`. But `return` is not accepted in a few cases such as: ```haskell -- The ado-block only has one statement x :: F () x = do return () -- The ado-block only has let-statements besides the `return` y :: F () y = do let a = True return () ``` These currently require `Monad` instances. This MR fixes it. Normally `return` is accepted as the last statement because it is stripped in constructing an `ApplicativeStmt`, but this cannot be done in the above cases, so instead we replace `return` by `pure`. A similar but different issue (when the ado-block contains `BindStmt` or `BodyStmt`, the second last statement cannot be `LetStmt`, even if the last statement uses `pure`) is fixed in !6786. - - - - - a5ea7867 by John Ericson at 2022-02-24T20:23:49-05:00 Clarify laws of TestEquality It is unclear what `TestEquality` is for. There are 3 possible choices. Assuming ```haskell data Tag a where TagInt1 :: Tag Int TagInt2 :: Tag Int ``` Weakest -- type param equality semi-decidable --------------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params may or may not be not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Nothing -- oopsie is allowed testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` This option is better demonstrated with a different type: ```haskell data Tag' a where TagInt1 :: Tag Int TagInt2 :: Tag a ``` ```haskell instance TestEquality Tag' where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Nothing -- can't be sure testEquality TagInt2 TagInt1 = Nothing -- can't be sure testEquality TagInt2 TagInt2 = Nothing -- can't be sure ``` Weaker -- type param equality decidable --------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params are not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` Strong -- Like `Eq` ------------------- `Just Refl` means the type params are equal, and the values are equal according to `Eq`. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl testEquality _ _ = Nothing ``` Strongest -- unique value concrete type --------------------------------------- `Just Refl` means the type params are equal, and the values are equal, and the class assume if the type params are equal the values must also be equal. In other words, the type is a singleton type when the type parameter is a closed term. ```haskell -- instance TestEquality -- invalid instance because two variants for `Int` ``` ------ The discussion in https://github.com/haskell/core-libraries-committee/issues/21 has decided on the "Weaker" option (confusingly formerly called the "Weakest" option). So that is what is implemented. - - - - - 06c18990 by Zubin Duggal at 2022-02-24T20:24:25-05:00 TH: fix pretty printing of GADTs with multiple constuctors (#20842) - - - - - 6555b68c by Matthew Pickering at 2022-02-24T20:25:06-05:00 Move linters into the tree This MR moves the GHC linters into the tree, so that they can be run directly using Hadrian. * Query all files tracked by Git instead of using changed files, so that we can run the exact same linting step locally and in a merge request. * Only check that the changelogs don't contain TBA when RELEASE=YES. * Add hadrian/lint script, which runs all the linting steps. * Ensure the hlint job exits with a failure if hlint is not installed (otherwise we were ignoring the failure). Given that hlint doesn't seem to be available in CI at the moment, I've temporarily allowed failure in the hlint job. * Run all linting tests in CI using hadrian. - - - - - b99646ed by Matthew Pickering at 2022-02-24T20:25:06-05:00 Add rule for generating HsBaseConfig.h If you are running the `lint:{base/compiler}` command locally then this improves the responsiveness because we don't re-run configure everytime if the header file already exists. - - - - - d0deaaf4 by Matthew Pickering at 2022-02-24T20:25:06-05:00 Suggestions due to hlint It turns out this job hasn't been running for quite a while (perhaps ever) so there are quite a few failures when running the linter locally. - - - - - 70bafefb by nineonine at 2022-02-24T20:25:42-05:00 ghci: show helpful error message when loading module with SIMD vector operations (#20214) Previously, when trying to load module with SIMD vector operations, ghci would panic in 'GHC.StgToByteCode.findPushSeq'. Now, a more helpful message is displayed. - - - - - 8ed3d5fd by Matthew Pickering at 2022-02-25T10:24:12+00:00 Remove test-bootstrap and cabal-reinstall jobs from fast-ci [skip ci] - - - - - 8387dfbe by Mario Blažević at 2022-02-25T21:09:41-05:00 template-haskell: Fix two prettyprinter issues Fix two issues regarding printing numeric literals. Fixing #20454. - - - - - 4ad8ce0b by sheaf at 2022-02-25T21:10:22-05:00 GHCi: don't normalise partially instantiated types This patch skips performing type normalisation when we haven't fully instantiated the type. That is, in tcRnExpr (used only for :type in GHCi), skip normalisation if the result type responds True to isSigmaTy. Fixes #20974 - - - - - f35aca4d by Ben Gamari at 2022-02-25T21:10:57-05:00 rts/adjustor: Always place adjustor templates in data section @nrnrnr points out that on his machine ld.lld rejects text relocations. Generalize the Darwin text-relocation avoidance logic to account for this. - - - - - cddb040a by Andreas Klebinger at 2022-02-25T21:11:33-05:00 Ticky: Gate tag-inference dummy ticky-counters behind a flag. Tag inference included a way to collect stats about avoided tag-checks. This was dony by emitting "dummy" ticky entries with counts corresponding to predicted/unpredicated tag checks. This behaviour for ticky is now gated behind -fticky-tag-checks. I also documented ticky-LNE in the process. - - - - - 948bf2d0 by Ben Gamari at 2022-02-25T21:12:09-05:00 Fix comment reference to T4818 - - - - - 9c3edeb8 by Ben Gamari at 2022-02-25T21:12:09-05:00 simplCore: Correctly extend in-scope set in rule matching Note [Matching lets] in GHC.Core.Rules claims the following: > We use GHC.Core.Subst.substBind to freshen the binding, using an > in-scope set that is the original in-scope variables plus the > rs_bndrs (currently floated let-bindings). However, previously the implementation didn't actually do extend the in-scope set with rs_bndrs. This appears to be a regression which was introduced by 4ff4d434e9a90623afce00b43e2a5a1ccbdb4c05. Moreover, the originally reasoning was subtly wrong: we must rather use the in-scope set from rv_lcl, extended with rs_bndrs, not that of `rv_fltR` Fixes #21122. - - - - - 7f9f49c3 by sheaf at 2022-02-25T21:12:47-05:00 Derive some stock instances for OverridingBool This patch adds some derived instances to `GHC.Data.Bool.OverridingBool`. It also changes the order of the constructors, so that the derived `Ord` instance matches the behaviour for `Maybe Bool`. Fixes #20326 - - - - - 140438a8 by nineonine at 2022-02-25T21:13:23-05:00 Add test for #19271 - - - - - ac9f4606 by sheaf at 2022-02-25T21:14:04-05:00 Allow qualified names in COMPLETE pragmas The parser didn't allow qualified constructor names to appear in COMPLETE pragmas. This patch fixes that. Fixes #20551 - - - - - 677c6c91 by Sylvain Henry at 2022-02-25T21:14:44-05:00 Testsuite: remove arch conditional in T8832 Taken from !3658 - - - - - ad04953b by Sylvain Henry at 2022-02-25T21:15:23-05:00 Allow hscGenHardCode to not return CgInfos This is a minor change in preparation for the JS backend: CgInfos aren't mandatory and the JS backend won't return them. - - - - - 929c280f by Sylvain Henry at 2022-02-25T21:15:24-05:00 Derive Enum instances for CCallConv and Safety This is used by the JS backend for serialization. - - - - - 75e4e090 by Sebastian Graf at 2022-02-25T21:15:59-05:00 base: Improve documentation of `throwIO` (#19854) Now it takes a better account of precise vs. imprecise exception semantics. Fixes #19854. - - - - - 61a203ba by Matthew Pickering at 2022-02-26T02:06:51-05:00 Make typechecking unfoldings from interfaces lazier The old logic was unecessarily strict in loading unfoldings because when reading the unfolding we would case on the result of attempting to load the template before commiting to which type of unfolding we were producing. Hence trying to inspect any of the information about an unfolding would force the template to be loaded. This also removes a potentially hard to discover bug where if the template failed to be typechecked for some reason then we would just not return an unfolding. Instead we now panic so these bad situations which should never arise can be identified. - - - - - 2be74460 by Matthew Pickering at 2022-02-26T02:06:51-05:00 Use a more up-to-date snapshot of the current rules in the simplifier As the prescient (now deleted) note warns in simplifyPgmIO we have to be a bit careful about when we gather rules from the EPS so that we get the rules for imported bindings. ``` -- Get any new rules, and extend the rule base -- See Note [Overall plumbing for rules] in GHC.Core.Rules -- We need to do this regularly, because simplification can -- poke on IdInfo thunks, which in turn brings in new rules -- behind the scenes. Otherwise there's a danger we'll simply -- miss the rules for Ids hidden inside imported inlinings ``` Given the previous commit, the loading of unfoldings is now even more delayed so we need to be more careful to read the EPS rule base closer to the point where we decide to try rules. Without this fix GHC performance regressed by a noticeably amount because the `zip` rule was not brought into scope eagerly enough which led to a further series of unfortunate events in the simplifer which tipped `substTyWithCoVars` over the edge of the size threshold, stopped it being inlined and increased allocations by 10% in some cases. Furthermore, this change is noticeably in the testsuite as it changes T19790 so that the `length` rules from GHC.List fires earlier. ------------------------- Metric Increase: T9961 ------------------------- - - - - - b8046195 by Matthew Pickering at 2022-02-26T02:06:52-05:00 Improve efficiency of extending a RuleEnv with a new RuleBase Essentially we apply the identity: > lookupNameEnv n (plusNameEnv_C (++) rb1 rb2) > = lookupNameEnv n rb1 ++ lookupNameEnv n rb2 The latter being more efficient as we don't construct an intermediate map. This is now quite important as each time we try and apply rules we need to combine the current EPS RuleBase with the HPT and ModGuts rule bases. - - - - - 033e9f0f by sheaf at 2022-02-26T02:07:30-05:00 Error on anon wildcards in tcAnonWildCardOcc The code in tcAnonWildCardOcc assumed that it could never encounter anonymous wildcards in illegal positions, because the renamer would have ruled them out. However, it's possible to sneak past the checks in the renamer by using Template Haskell. It isn't possible to simply pass on additional information when renaming Template Haskell brackets, because we don't know in advance in what context the bracket will be spliced in (see test case T15433b). So we accept that we might encounter these bogus wildcards in the typechecker and throw the appropriate error. This patch also migrates the error messages for illegal wildcards in types to use the diagnostic infrastructure. Fixes #15433 - - - - - 32d8fe3a by sheaf at 2022-02-26T14:15:33+01:00 Core Lint: ensure primops can be eta-expanded This patch adds a check to Core Lint, checkCanEtaExpand, which ensures that primops and other wired-in functions with no binding such as unsafeCoerce#, oneShot, rightSection... can always be eta-expanded, by checking that the remaining argument types have a fixed RuntimeRep. Two subtleties came up: - the notion of arity in Core looks through newtypes, so we may need to unwrap newtypes in this check, - we want to avoid calling hasNoBinding on something whose unfolding we are in the process of linting, as this would cause a loop; to avoid this we add some information to the Core Lint environment that holds this information. Fixes #20480 - - - - - 0a80b436 by Peter Trommler at 2022-02-26T17:21:59-05:00 testsuite: Require LLVM for T15155l - - - - - 38cb920e by Oleg Grenrus at 2022-02-28T07:14:04-05:00 Add Monoid a => Monoid (STM a) instance - - - - - d734ef8f by Hécate Moonlight at 2022-02-28T07:14:42-05:00 Make modules in base stable. fix #18963 - - - - - fbf005e9 by Sven Tennie at 2022-02-28T19:16:01-05:00 Fix some hlint issues in ghc-heap This does not fix all hlint issues as the criticised index and length expressions seem to be fine in context. - - - - - adfddf7d by Matthew Pickering at 2022-02-28T19:16:36-05:00 hadrian: Suggest to the user to run ./configure if missing a setting If a setting is missing from the configuration file it's likely the user needs to reconfigure. Fixes #20476 - - - - - 4f0208e5 by Andreas Klebinger at 2022-02-28T19:17:12-05:00 CLabel cleanup: Remove these smart constructors for these reasons: * mkLocalClosureTableLabel : Does the same as the non-local variant. * mkLocalClosureLabel : Does the same as the non-local variant. * mkLocalInfoTableLabel : Decide if we make a local label based on the name and just use mkInfoTableLabel everywhere. - - - - - 065419af by Matthew Pickering at 2022-02-28T19:17:47-05:00 linking: Don't pass --hash-size and --reduce-memory-overhead to ld These flags were added to help with the high linking cost of the old split-objs mode. Now we are using split-sections these flags appear to make no difference to memory usage or time taken to link. I tested various configurations linking together the ghc library with -split-sections enabled. | linker | time (s) | | ------ | ------ | | gold | 0.95 | | ld | 1.6 | | ld (hash-size = 31, reduce-memory-overheads) | 1.6 | | ldd | 0.47 | Fixes #20967 - - - - - 3e65ef05 by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix typo in docstring for Overlap - - - - - 80f9133e by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix docstring for Bytes It seems like a commented out section of code was accidentally included in the docstring for a field. - - - - - 54774268 by Matthew Pickering at 2022-03-01T16:23:10-05:00 Fix longstanding issue with moduleGraphNodes - no hs-boot files case In the case when we tell moduleGraphNodes to drop hs-boot files the idea is to collapse hs-boot files into their hs file nodes. In the old code * nodeDependencies changed edges from IsBoot to NonBoot * moduleGraphNodes just dropped boot file nodes The net result is that any dependencies of the hs-boot files themselves were dropped. The correct thing to do is * nodeDependencies changes edges from IsBoot to NonBoot * moduleGraphNodes merges dependencies of IsBoot and NonBoot nodes. The result is a properly quotiented dependency graph which contains no hs-boot files nor hs-boot file edges. Why this didn't cause endless issues when compiling with boot files, we will never know. - - - - - c84dc506 by Matthew Pickering at 2022-03-01T16:23:10-05:00 driver: Properly add an edge between a .hs and its hs-boot file As noted in #21071 we were missing adding this edge so there were situations where the .hs file would get compiled before the .hs-boot file which leads to issues with -j. I fixed this properly by adding the edge in downsweep so the definition of nodeDependencies can be simplified to avoid adding this dummy edge in. There are plenty of tests which seem to have these redundant boot files anyway so no new test. #21094 tracks the more general issue of identifying redundant hs-boot and SOURCE imports. - - - - - 7aeb6d29 by sheaf at 2022-03-01T16:23:51-05:00 Core Lint: collect args through floatable ticks We were not looking through floatable ticks when collecting arguments in Core Lint, which caused `checkCanEtaExpand` to fail on something like: ```haskell reallyUnsafePtrEquality = \ @a -> (src<loc> reallyUnsafePtrEquality#) @Lifted @a @Lifted @a ``` We fix this by using `collectArgsTicks tickishFloatable` instead of `collectArgs`, to be consistent with the behaviour of eta expansion outlined in Note [Eta expansion and source notes] in GHC.Core.Opt.Arity. Fixes #21152. - - - - - 75caafaa by Matthew Pickering at 2022-03-02T01:14:59-05:00 Ticky profiling improvements. This adds a number of changes to ticky-ticky profiling. When an executable is profiled with IPE profiling it's now possible to associate id-related ticky counters to their source location. This works by emitting the info table address as part of the counter which can be looked up in the IPE table. Add a `-ticky-ap-thunk` flag. This flag prevents the use of some standard thunks which are precompiled into the RTS. This means reduced cache locality and increased code size. But it allows better attribution of execution cost to specific source locations instead of simple attributing it to the standard thunk. ticky-ticky now uses the `arg` field to emit additional information about counters in json format. When ticky-ticky is used in combination with the eventlog eventlog2html can be used to generate a html table from the eventlog similar to the old text output for ticky-ticky. - - - - - aeea6bd5 by doyougnu at 2022-03-02T01:15:39-05:00 StgToCmm.cgTopBinding: no isNCG, use binBlobThresh This is a one line change. It is a fixup from MR!7325, was pointed out in review of MR!7442, specifically: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7442#note_406581 The change removes isNCG check from cgTopBinding. Instead it changes the type of binBlobThresh in DynFlags from Word to Maybe Word, where a Just 0 or a Nothing indicates an infinite threshold and thus the disable CmmFileEmbed case in the original check. This improves the cohesion of the module because more NCG related Backend stuff is moved into, and checked in, StgToCmm.Config. Note, that the meaning of a Just 0 or a Nothing in binBlobThresh is indicated in a comment next to its field in GHC.StgToCmm.Config. DynFlags: binBlobThresh: Word -> Maybe Word StgToCmm.Config: binBlobThesh add not ncg check DynFlags.binBlob: move Just 0 check to dflags init StgToCmm.binBlob: only check isNCG, Just 0 check to dflags StgToCmm.Config: strictify binBlobThresh - - - - - b27b2af3 by sheaf at 2022-03-02T14:08:36-05:00 Introduce ConcreteTv metavariables This patch introduces a new kind of metavariable, by adding the constructor `ConcreteTv` to `MetaInfo`. A metavariable with `ConcreteTv` `MetaInfo`, henceforth a concrete metavariable, can only be unified with a type that is concrete (that is, a type that answers `True` to `GHC.Core.Type.isConcrete`). This solves the problem of dangling metavariables in `Concrete#` constraints: instead of emitting `Concrete# ty`, which contains a secret existential metavariable, we simply emit a primitive equality constraint `ty ~# concrete_tv` where `concrete_tv` is a fresh concrete metavariable. This means we can avoid all the complexity of canonicalising `Concrete#` constraints, as we can just re-use the existing machinery for `~#`. To finish things up, this patch then removes the `Concrete#` special predicate, and instead introduces the special predicate `IsRefl#` which enforces that a coercion is reflexive. Such a constraint is needed because the canonicaliser is quite happy to rewrite an equality constraint such as `ty ~# concrete_tv`, but such a rewriting is not handled by the rest of the compiler currently, as we need to make use of the resulting coercion, as outlined in the FixedRuntimeRep plan. The big upside of this approach (on top of simplifying the code) is that we can now selectively implement PHASE 2 of FixedRuntimeRep, by changing individual calls of `hasFixedRuntimeRep_MustBeRefl` to `hasFixedRuntimeRep` and making use of the obtained coercion. - - - - - 81b7c436 by Matthew Pickering at 2022-03-02T14:09:13-05:00 Make -dannot-lint not panic on let bound type variables After certain simplifier passes we end up with let bound type variables which are immediately inlined in the next pass. The core diff utility implemented by -dannot-lint failed to take these into account and paniced. Progress towards #20965 - - - - - f596c91a by sheaf at 2022-03-02T14:09:51-05:00 Improve out-of-order inferred type variables Don't instantiate type variables for :type in `GHC.Tc.Gen.App.tcInstFun`, to avoid inconsistently instantianting `r1` but not `r2` in the type forall {r1} (a :: TYPE r1) {r2} (b :: TYPE r2). ... This fixes #21088. This patch also changes the primop pretty-printer to ensure that we put all the inferred type variables first. For example, the type of reallyUnsafePtrEquality# is now forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> Int# This means we avoid running into issue #21088 entirely with the types of primops. Users can still write a type signature where the inferred type variables don't come first, however. This change to primops had a knock-on consequence, revealing that we were sometimes performing eta reduction on keepAlive#. This patch updates tryEtaReduce to avoid eta reducing functions with no binding, bringing it in line with tryEtaReducePrep, and thus fixing #21090. - - - - - 1617fed3 by Richard Eisenberg at 2022-03-02T14:10:28-05:00 Make inert_cycle_breakers into a stack. Close #20231. - - - - - c8652a0a by Richard Eisenberg at 2022-03-02T14:11:03-05:00 Make Constraint not *apart* from Type. More details in Note [coreView vs tcView] Close #21092. - - - - - 91a10cb0 by doyougnu at 2022-03-02T14:11:43-05:00 GenStgAlt 3-tuple synonym --> Record type This commit alters GenStgAlt from a type synonym to a Record with field accessors. In pursuit of #21078, this is not a required change but cleans up several areas for nicer code in the upcoming js-backend, and in GHC itself. GenStgAlt: 3-tuple -> record Stg.Utils: GenStgAlt 3-tuple -> record Stg.Stats: StgAlt 3-tuple --> record Stg.InferTags.Rewrite: StgAlt 3-tuple -> record Stg.FVs: GenStgAlt 3-tuple -> record Stg.CSE: GenStgAlt 3-tuple -> record Stg.InferTags: GenStgAlt 3-tuple --> record Stg.Debug: GenStgAlt 3-tuple --> record Stg.Lift.Analysis: GenStgAlt 3-tuple --> record Stg.Lift: GenStgAlt 3-tuple --> record ByteCode.Instr: GenStgAlt 3-tuple --> record Stg.Syntax: add GenStgAlt helper functions Stg.Unarise: GenStgAlt 3-tuple --> record Stg.BcPrep: GenStgAlt 3-tuple --> record CoreToStg: GenStgAlt 3-tuple --> record StgToCmm.Expr: GenStgAlt 3-tuple --> record StgToCmm.Bind: GenStgAlt 3-tuple --> record StgToByteCode: GenStgAlt 3-tuple --> record Stg.Lint: GenStgAlt 3-tuple --> record Stg.Syntax: strictify GenStgAlt GenStgAlt: add haddock, some cleanup fixup: remove calls to pure, single ViewPattern StgToByteCode: use case over viewpatterns - - - - - 73864f00 by Matthew Pickering at 2022-03-02T14:12:19-05:00 base: Remove default method from bitraversable The default instance leads to an infinite loop. bisequenceA is defined in terms of bisquence which is defined in terms of bitraverse. ``` bitraverse f g = (defn of bitraverse) bisequenceA . bimap f g = (defn of bisequenceA) bitraverse id id . bimap f g = (defn of bitraverse) ... ``` Any instances defined without an explicitly implementation are currently broken, therefore removing it will alert users to an issue in their code. CLC issue: https://github.com/haskell/core-libraries-committee/issues/47 Fixes #20329 #18901 - - - - - 9579bf35 by Matthew Pickering at 2022-03-02T14:12:54-05:00 ci: Add check to CI to ensure compiler uses correct BIGNUM_BACKEND - - - - - c48a7c3a by Sylvain Henry at 2022-03-03T07:37:12-05:00 Use Word64# primops in Word64 Num instance Taken froù!3658 - - - - - ce65d0cc by Matthew Pickering at 2022-03-03T07:37:48-05:00 hadrian: Correctly set whether we have a debug compiler when running tests For example, running the `slow-validate` flavour would incorrectly run the T16135 test which would fail with an assertion error, despite the fact that is should be skipped when we have a debug compiler. - - - - - e0c3e757 by Matthew Pickering at 2022-03-03T13:48:41-05:00 docs: Add note to unsafeCoerce function that you might want to use coerce [skip ci] Fixes #15429 - - - - - 559d4cf3 by Matthew Pickering at 2022-03-03T13:49:17-05:00 docs: Add note to RULES documentation about locally bound variables [skip ci] Fixes #20100 - - - - - c534b3dd by Matthew Pickering at 2022-03-03T13:49:53-05:00 Replace ad-hoc CPP with constant from GHC.Utils.Constant Fixes #21154 - - - - - de56cc7e by Krzysztof Gogolewski at 2022-03-04T12:44:26-05:00 Update documentation of LiberalTypeSynonyms We no longer require LiberalTypeSynonyms to use 'forall' or an unboxed tuple in a synonym. I also removed that kind checking before expanding synonyms "could be changed". This was true when type synonyms were thought of macros, but with the extensions such as SAKS or matchability I don't see it changing. - - - - - c0a39259 by Simon Jakobi at 2022-03-04T12:45:01-05:00 base: Mark GHC.Bits not-home for haddock Most (all) of the exports are re-exported from the preferable Data.Bits. - - - - - 3570eda5 by Sylvain Henry at 2022-03-04T12:45:42-05:00 Fix comments about Int64/Word64 primops - - - - - 6f84ee33 by Artem Pelenitsyn at 2022-03-05T01:06:47-05:00 remove MonadFail instances of ST CLC proposal: https://github.com/haskell/core-libraries-committee/issues/33 The instances had `fail` implemented in terms of `error`, whereas the idea of the `MonadFail` class is that the `fail` method should be implemented in terms of the monad itself. - - - - - 584cd5ae by sheaf at 2022-03-05T01:07:25-05:00 Don't allow Float#/Double# literal patterns This patch does the following two things: 1. Fix the check in Core Lint to properly throw an error when it comes across Float#/Double# literal patterns. The check was incorrect before, because it expected the type to be Float/Double instead of Float#/Double#. 2. Add an error in the parser when the user writes a floating-point literal pattern such as `case x of { 2.0## -> ... }`. Fixes #21115 - - - - - 706deee0 by Greg Steuck at 2022-03-05T17:44:10-08:00 Make T20214 terminate promptly be setting input to /dev/null It was hanging and timing out on OpenBSD before. - - - - - 14e90098 by Simon Peyton Jones at 2022-03-07T14:05:41-05:00 Always generalise top-level bindings Fix #21023 by always generalising top-level binding; change the documentation of -XMonoLocalBinds to match. - - - - - c9c31c3c by Matthew Pickering at 2022-03-07T14:06:16-05:00 hadrian: Add little flavour transformer to build stage2 with assertions This can be useful to build a `perf+assertions` build or even better `default+no_profiled_libs+omit_pragmas+assertions`. - - - - - 89c14a6c by Matthew Pickering at 2022-03-07T14:06:16-05:00 ci: Convert all deb10 make jobs into hadrian jobs This is the first step in converting all the CI configs to use hadrian rather than make. (#21129) The metrics increase due to hadrian using --hyperlinked-source for haddock builds. (See #21156) ------------------------- Metric Increase: haddock.Cabal haddock.base haddock.compiler ------------------------- - - - - - 7bfae2ee by Matthew Pickering at 2022-03-07T14:06:16-05:00 Replace use of BIN_DIST_PREP_TAR_COMP with BIN_DIST_NAME And adds a check to make sure we are not accidently settings BIN_DIST_PREP_TAR_COMP when using hadrian. - - - - - 5b35ca58 by Matthew Pickering at 2022-03-07T14:06:16-05:00 Fix gen_contents_index logic for hadrian bindist - - - - - 273bc133 by Krzysztof Gogolewski at 2022-03-07T14:06:52-05:00 Fix reporting constraints in pprTcSolverReportMsg 'no_instance_msg' and 'no_deduce_msg' were omitting the first wanted. - - - - - 5874a30a by Simon Jakobi at 2022-03-07T14:07:28-05:00 Improve setBit for Natural Previously the default definition was used, which involved allocating intermediate Natural values. Fixes #21173. - - - - - 7a02aeb8 by Matthew Pickering at 2022-03-07T14:08:03-05:00 Remove leftover trace in testsuite - - - - - 6ce6c250 by Andreas Klebinger at 2022-03-07T23:48:56-05:00 Expand and improve the Note [Strict Worker Ids]. I've added an explicit mention of the invariants surrounding those. As well as adding more direct cross references to the Strict Field Invariant. - - - - - d0f892fe by Ryan Scott at 2022-03-07T23:49:32-05:00 Delete GenericKind_ in favor of GenericKind_DC When deriving a `Generic1` instance, we need to know what the last type variable of a data type is. Previously, there were two mechanisms to determine this information: * `GenericKind_`, where `Gen1_` stored the last type variable of a data type constructor (i.e., the `tyConTyVars`). * `GenericKind_DC`, where `Gen1_DC` stored the last universally quantified type variable in a data constructor (i.e., the `dataConUnivTyVars`). These had different use cases, as `GenericKind_` was used for generating `Rep(1)` instances, while `GenericKind_DC` was used for generating `from(1)` and `to(1)` implementations. This was already a bit confusing, but things went from confusing to outright wrong after !6976. This is because after !6976, the `deriving` machinery stopped using `tyConTyVars` in favor of `dataConUnivTyVars`. Well, everywhere with the sole exception of `GenericKind_`, which still continued to use `tyConTyVars`. This lead to disaster when deriving a `Generic1` instance for a GADT family instance, as the `tyConTyVars` do not match the `dataConUnivTyVars`. (See #21185.) The fix is to stop using `GenericKind_` and replace it with `GenericKind_DC`. For the most part, this proves relatively straightforward. Some highlights: * The `forgetArgVar` function was deleted entirely, as it no longer proved necessary after `GenericKind_`'s demise. * The substitution that maps from the last type variable to `Any` (see `Note [Generating a correctly typed Rep instance]`) had to be moved from `tc_mkRepTy` to `tc_mkRepFamInsts`, as `tc_mkRepTy` no longer has access to the last type variable. Fixes #21185. - - - - - a60ddffd by Matthew Pickering at 2022-03-08T22:51:37+00:00 Move bootstrap and cabal-reinstall test jobs to nightly CI is creaking under the pressure of too many jobs so attempt to reduce the strain by removing a couple of jobs. - - - - - 7abe3288 by Matthew Pickering at 2022-03-09T10:24:15+00:00 Add 10 minute timeout to linters job - - - - - 3cf75ede by Matthew Pickering at 2022-03-09T10:24:16+00:00 Revert "hadrian: Correctly set whether we have a debug compiler when running tests" Needing the arguments for "GHC/Utils/Constant.hs" implies a dependency on the previous stage compiler. Whilst we work out how to get around this I will just revert this commit (as it only affects running the testsuite in debug way). This reverts commit ce65d0cceda4a028f30deafa3c39d40a250acc6a. - - - - - 18b9ba56 by Matthew Pickering at 2022-03-09T11:07:23+00:00 ci: Fix save_cache function Each interation of saving the cache would copy the whole `cabal` store into a subfolder in the CACHE_DIR rather than copying the contents of the cabal store into the cache dir. This resulted in a cache which looked like: ``` /builds/ghc/ghc/cabal-cache/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/ ``` So it would get one layer deeper every CI run and take longer and longer to compress. - - - - - bc684dfb by Ben Gamari at 2022-03-10T03:20:07-05:00 mr-template: Mention timeframe for review - - - - - 7f5f4ede by Vladislav Zavialov at 2022-03-10T03:20:43-05:00 Bump submodules: containers, exceptions GHC Proposal #371 requires TypeOperators to use type equality a~b. This submodule update pulls in the appropriate forward-compatibility changes in 'libraries/containers' and 'libraries/exceptions' - - - - - 8532b8a9 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Add an inline pragma to lookupVarEnv The containers bump reduced the size of the Data.IntMap.Internal.lookup function so that it no longer experienced W/W. This means that the size of lookupVarEnv increased over the inlining threshold and it wasn't inlined into the hot code path in substTyVar. See containers#821, #21159 and !7638 for some more explanation. ------------------------- Metric Decrease: LargeRecord T12227 T13386 T15703 T18223 T5030 T8095 T9872a T9872b T9872c TcPlugin_RewritePerf ------------------------- - - - - - 844cf1e1 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Normalise output of T10970 test The output of this test changes each time the containers submodule version updates. It's easier to apply the version normaliser so that the test checks that there is a version number, but not which one it is. - - - - - 24b6af26 by Ryan Scott at 2022-03-11T19:56:28-05:00 Refactor tcDeriving to generate tyfam insts before any bindings Previously, there was an awful hack in `genInst` (now called `genInstBinds` after this patch) where we had to return a continutation rather than directly returning the bindings for a derived instance. This was done for staging purposes, as we had to first infer the instance contexts for derived instances and then feed these contexts into the continuations to ensure the generated instance bindings had accurate instance contexts. `Note [Staging of tcDeriving]` in `GHC.Tc.Deriving` described this confusing state of affairs. The root cause of this confusing design was the fact that `genInst` was trying to generate instance bindings and associated type family instances for derived instances simultaneously. This really isn't possible, however: as `Note [Staging of tcDeriving]` explains, one needs to have access to the associated type family instances before one can properly infer the instance contexts for derived instances. The use of continuation-returning style was an attempt to circumvent this dependency, but it did so in an awkward way. This patch detangles this awkwardness by splitting up `genInst` into two functions: `genFamInsts` (for associated type family instances) and `genInstBinds` (for instance bindings). Now, the `tcDeriving` function calls `genFamInsts` and brings all the family instances into scope before calling `genInstBinds`. This removes the need for the awkward continuation-returning style seen in the previous version of `genInst`, making the code easier to understand. There are some knock-on changes as well: 1. `hasStockDeriving` now needs to return two separate functions: one that describes how to generate family instances for a stock-derived instance, and another that describes how to generate the instance bindings. I factored out this pattern into a new `StockGenFns` data type. 2. While documenting `StockGenFns`, I realized that there was some inconsistency regarding which `StockGenFns` functions needed which arguments. In particular, the function in `GHC.Tc.Deriv.Generics` which generates `Rep(1)` instances did not take a `SrcSpan` like other `gen_*` functions did, and it included an extra `[Type]` argument that was entirely redundant. As a consequence, I refactored the code in `GHC.Tc.Deriv.Generics` to more closely resemble other `gen_*` functions. A happy result of all this is that all `StockGenFns` functions now take exactly the same arguments, which makes everything more uniform. This is purely a refactoring that should not have any effect on user-observable behavior. The new design paves the way for an eventual fix for #20719. - - - - - 62caaa9b by Ben Gamari at 2022-03-11T19:57:03-05:00 gitlab-ci: Use the linters image in hlint job As the `hlint` executable is only available in the linters image. Fixes #21146. - - - - - 4abd7eb0 by Matthew Pickering at 2022-03-11T19:57:38-05:00 Remove partOfGhci check in the loader This special logic has been part of GHC ever since template haskell was introduced in 9af77fa423926fbda946b31e174173d0ec5ebac8. It's hard to believe in any case that this special logic pays its way at all. Given * The list is out-of-date, which has potential to lead to miscompilation when using "editline", which was removed in 2010 (46aed8a4). * The performance benefit seems negligable as each load only happens once anyway and packages specified by package flags are preloaded into the linker state at the start of compilation. Therefore we just remove this logic. Fixes #19791 - - - - - c40cbaa2 by Andreas Klebinger at 2022-03-11T19:58:14-05:00 Improve -dtag-inference-checks checks. FUN closures don't get tagged when evaluated. So no point in checking their tags. - - - - - ab00d23b by Simon Jakobi at 2022-03-11T19:58:49-05:00 Improve clearBit and complementBit for Natural Also optimize bigNatComplementBit#. Fixes #21175, #21181, #21194. - - - - - a6d8facb by Sebastian Graf at 2022-03-11T19:59:24-05:00 gitignore all (build) directories headed by _ - - - - - 524795fe by Sebastian Graf at 2022-03-11T19:59:24-05:00 Demand: Document why we need three additional equations of multSubDmd - - - - - 6bdcd557 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make 64-bit word splitting for 32-bit targets respect target endianness This used to been broken for little-endian targets. - - - - - 9e67c69e by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix Double# literal payload for 32-bit targets Contrary to the legacy comment, the splitting didn't happen and we ended up with a single StgWord64 literal in the output code! Let's just do the splitting here. - - - - - 1eee2e28 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: use __builtin versions of memcpyish functions to fix type mismatch Our memcpyish primop's type signatures doesn't match the C type signatures. It's not a problem for typical archs, since their C ABI permits dropping the result, but it doesn't work for wasm. The previous logic would cast the memcpyish function pointer to an incorrect type and perform an indirect call, which results in a runtime trap on wasm. The most straightforward fix is: don't emit EFF_ for memcpyish functions. Since we don't want to include extra headers in .hc to bring in their prototypes, we can just use the __builtin versions. - - - - - 9d8d4837 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: emit __builtin_unreachable() when CmmSwitch doesn't contain fallback case Otherwise the C compiler may complain "warning: non-void function does not return a value in all control paths [-Wreturn-type]". - - - - - 27da5540 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make floatToWord32/doubleToWord64 faster Use castFloatToWord32/castDoubleToWord64 in base to perform the reinterpret cast. - - - - - c98e8332 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix -Wunused-value warning in ASSIGN_BaseReg When ASSIGN_BaseReg is a no-op, we shouldn't generate any C code, otherwise C compiler complains a bunch of -Wunused-value warnings when doing unregisterised codegen. - - - - - 5932247c by Ben Gamari at 2022-03-11T20:00:36-05:00 users guide: Eliminate spurious \spxentry mentions We were failing to pass the style file to `makeindex`, as is done by the mklatex configuration generated by Sphinx. Fixes #20913. - - - - - e40cf4ef by Simon Jakobi at 2022-03-11T20:01:11-05:00 ghc-bignum: Tweak integerOr The result of ORing two BigNats is always greater or equal to the larger of the two. Therefore it is safe to skip the magnitude checks of integerFromBigNat#. - - - - - cf081476 by Vladislav Zavialov at 2022-03-12T07:02:40-05:00 checkUnboxedLitPat: use non-fatal addError This enables GHC to report more parse errors in a single pass. - - - - - 7fe07143 by Andreas Klebinger at 2022-03-12T07:03:16-05:00 Rename -fprof-late-ccs to -fprof-late - - - - - 88a94541 by Sylvain Henry at 2022-03-12T07:03:56-05:00 Hadrian: avoid useless allocations in trackArgument Cf ticky report before the change: Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 696987 29044128 0 1 L main:Target.trackArgument_go5{v r24kY} (fun) - - - - - 2509d676 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: avoid allocating in stageString (#19209) - - - - - c062fac0 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: remove useless imports Added for no reason in 7ce1b694f7be7fbf6e2d7b7eb0639e61fbe358c6 - - - - - c82fb934 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: avoid allocations in WayUnit's Read instance (#19209) - - - - - ed04aed2 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: use IntSet Binary instance for Way (#19209) - - - - - ad835531 by Simon Peyton Jones at 2022-03-13T18:12:12-04:00 Fix bug in weak loop-breakers in OccurAnal Note [Weak loop breakers] explains why we need to track variables free in RHS of rules. But we need to do this for /inactive/ rules as well as active ones, unlike the rhs_fv_env stuff. So we now have two fields in node Details, one for free vars of active rules, and one for free vars of all rules. This was shown up by #20820, which is now fixed. - - - - - 76b94b72 by Sebastian Graf at 2022-03-13T18:12:48-04:00 Worker/wrapper: Preserve float barriers (#21150) Issue #21150 shows that worker/wrapper allocated a worker function for a function with multiple calls that said "called at most once" when the first argument was absent. That's bad! This patch makes it so that WW preserves at least one non-one-shot value lambda (see `Note [Preserving float barriers]`) by passing around `void#` in place of absent arguments. Fixes #21150. Since the fix is pretty similar to `Note [Protecting the last value argument]`, I put the logic in `mkWorkerArgs`. There I realised (#21204) that `-ffun-to-thunk` is basically useless with `-ffull-laziness`, so I deprecated the flag, simplified and split into `needsVoidWorkerArg`/`addVoidWorkerArg`. SpecConstr is another client of that API. Fixes #21204. Metric Decrease: T14683 - - - - - 97db789e by romes at 2022-03-14T11:36:39-04:00 Fix up Note [Bind free vars] Move GHC-specific comments from Language.Haskell.Syntax.Binds to GHC.Hs.Binds It looks like the Note was deleted but there were actually two copies of it. L.H.S.B no longer references it, and GHC.Hs.Binds keeps an updated copy. (See #19252) There are other duplicated notes -- they will be fixed in the next commit - - - - - 135888dd by romes at 2022-03-14T11:36:39-04:00 TTG Pull AbsBinds and ABExport out of the main AST AbsBinds and ABExport both depended on the typechecker, and were thus removed from the main AST Expr. CollectPass now has a new function `collectXXHsBindsLR` used for the new HsBinds extension point Bumped haddock submodule to work with AST changes. The removed Notes from Language.Haskell.Syntax.Binds were duplicated (and not referenced) and the copies in GHC.Hs.Binds are kept (and referenced there). (See #19252) - - - - - 106413f0 by sheaf at 2022-03-14T11:37:21-04:00 Add two coercion optimisation perf tests - - - - - 8eadea67 by sheaf at 2022-03-14T15:08:24-04:00 Fix isLiftedType_maybe and handle fallout As #20837 pointed out, `isLiftedType_maybe` returned `Just False` in many situations where it should return `Nothing`, because it didn't take into account type families or type variables. In this patch, we fix this issue. We rename `isLiftedType_maybe` to `typeLevity_maybe`, which now returns a `Levity` instead of a boolean. We now return `Nothing` for types with kinds of the form `TYPE (F a1 ... an)` for a type family `F`, as well as `TYPE (BoxedRep l)` where `l` is a type variable. This fix caused several other problems, as other parts of the compiler were relying on `isLiftedType_maybe` returning a `Just` value, and were now panicking after the above fix. There were two main situations in which panics occurred: 1. Issues involving the let/app invariant. To uphold that invariant, we need to know whether something is lifted or not. If we get an answer of `Nothing` from `isLiftedType_maybe`, then we don't know what to do. As this invariant isn't particularly invariant, we can change the affected functions to not panic, e.g. by behaving the same in the `Just False` case and in the `Nothing` case (meaning: no observable change in behaviour compared to before). 2. Typechecking of data (/newtype) constructor patterns. Some programs involving patterns with unknown representations were accepted, such as T20363. Now that we are stricter, this caused further issues, culminating in Core Lint errors. However, the behaviour was incorrect the whole time; the incorrectness only being revealed by this change, not triggered by it. This patch fixes this by overhauling where the representation polymorphism involving pattern matching are done. Instead of doing it in `tcMatches`, we instead ensure that the `matchExpected` functions such as `matchExpectedFunTys`, `matchActualFunTySigma`, `matchActualFunTysRho` allow return argument pattern types which have a fixed RuntimeRep (as defined in Note [Fixed RuntimeRep]). This ensures that the pattern matching code only ever handles types with a known runtime representation. One exception was that patterns with an unknown representation type could sneak in via `tcConPat`, which points to a missing representation-polymorphism check, which this patch now adds. This means that we now reject the program in #20363, at least until we implement PHASE 2 of FixedRuntimeRep (allowing type families in RuntimeRep positions). The aforementioned refactoring, in which checks have been moved to `matchExpected` functions, is a first step in implementing PHASE 2 for patterns. Fixes #20837 - - - - - 8ff32124 by Sebastian Graf at 2022-03-14T15:09:01-04:00 DmdAnal: Don't unbox recursive data types (#11545) As `Note [Demand analysis for recursive data constructors]` describes, we now refrain from unboxing recursive data type arguments, for two reasons: 1. Relating to run/alloc perf: Similar to `Note [CPR for recursive data constructors]`, it seldomly improves run/alloc performance if we just unbox a finite number of layers of a potentially huge data structure. 2. Relating to ghc/alloc perf: Inductive definitions on single-product recursive data types like the one in T11545 will (diverge, and) have very deep demand signatures before any other abortion mechanism in Demand analysis is triggered. That leads to great and unnecessary churn on Demand analysis when ultimately we will never make use of any nested strictness information anyway. Conclusion: Discard nested demand and boxity information on such recursive types with the help of `Note [Detecting recursive data constructors]`. I also implemented `GHC.Types.Unique.MemoFun.memoiseUniqueFun` in order to avoid the overhead of repeated calls to `GHC.Core.Opt.WorkWrap.Utils.isRecDataCon`. It's nice and simple and guards against some smaller regressions in T9233 and T16577. ghc/alloc performance-wise, this patch is a very clear win: Test Metric value New value Change --------------------------------------------------------------------------------------- LargeRecord(normal) ghc/alloc 6,141,071,720 6,099,871,216 -0.7% MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,740,973,040 2,705,146,640 -1.3% T11545(normal) ghc/alloc 945,475,492 85,768,928 -90.9% GOOD T13056(optasm) ghc/alloc 370,245,880 326,980,632 -11.7% GOOD T18304(normal) ghc/alloc 90,933,944 76,998,064 -15.3% GOOD T9872a(normal) ghc/alloc 1,800,576,840 1,792,348,760 -0.5% T9872b(normal) ghc/alloc 2,086,492,432 2,073,991,848 -0.6% T9872c(normal) ghc/alloc 1,750,491,240 1,737,797,832 -0.7% TcPlugin_RewritePerf(normal) ghc/alloc 2,286,813,400 2,270,957,896 -0.7% geo. mean -2.9% No noteworthy change in run/alloc either. NoFib results show slight wins, too: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- constraints -1.9% -1.4% fasta -3.6% -2.7% reverse-complem -0.3% -0.9% treejoin -0.0% -0.3% -------------------------------------------------------------------------------- Min -3.6% -2.7% Max +0.1% +0.1% Geometric Mean -0.1% -0.1% Metric Decrease: T11545 T13056 T18304 - - - - - ab618309 by Vladislav Zavialov at 2022-03-15T18:34:38+03:00 Export (~) from Data.Type.Equality (#18862) * Users can define their own (~) type operator * Haddock can display documentation for the built-in (~) * New transitional warnings implemented: -Wtype-equality-out-of-scope -Wtype-equality-requires-operators Updates the haddock submodule. - - - - - 577135bf by Aaron Allen at 2022-03-16T02:27:48-04:00 Convert Diagnostics in GHC.Tc.Gen.Foreign Converts all uses of 'TcRnUnknownMessage' to proper diagnostics. - - - - - c1fed9da by Aaron Allen at 2022-03-16T02:27:48-04:00 Suggest FFI extensions as hints (#20116) - Use extension suggestion hints instead of suggesting extensions in the error message body for several FFI errors. - Adds a test case for `TcRnForeignImportPrimExtNotSet` - - - - - a33d1045 by Zubin Duggal at 2022-03-16T02:28:24-04:00 TH: allow negative patterns in quotes (#20711) We still don't allow negative overloaded patterns. Earler all negative patterns were treated as negative overloaded patterns. Now, we expliclty check the extension field to see if the pattern is actually a negative overloaded pattern - - - - - 1575c4a5 by Sebastian Graf at 2022-03-16T02:29:03-04:00 Demand: Let `Boxed` win in `lubBoxity` (#21119) Previously, we let `Unboxed` win in `lubBoxity`, which is unsoundly optimistic in terms ob Boxity analysis. "Unsoundly" in the sense that we sometimes unbox parameters that we better shouldn't unbox. Examples are #18907 and T19871.absent. Until now, we thought that this hack pulled its weight becuase it worked around some shortcomings of the phase separation between Boxity analysis and CPR analysis. But it is a gross hack which caused regressions itself that needed all kinds of fixes and workarounds. See for example #20767. It became impossible to work with in !7599, so I want to remove it. For example, at the moment, `lubDmd B dmd` will not unbox `dmd`, but `lubDmd A dmd` will. Given that `B` is supposed to be the bottom element of the lattice, it's hardly justifiable to get a better demand when `lub`bing with `A`. The consequence of letting `Boxed` win in `lubBoxity` is that we *would* regress #2387, #16040 and parts of #5075 and T19871.sumIO, until Boxity and CPR are able to communicate better. Fortunately, that is not the case since I could tweak the other source of optimism in Boxity analysis that is described in `Note [Unboxed demand on function bodies returning small products]` so that we *recursively* assume unboxed demands on function bodies returning small products. See the updated Note. `Note [Boxity for bottoming functions]` describes why we need bottoming functions to have signatures that say that they deeply unbox their arguments. In so doing, I had to tweak `finaliseArgBoxities` so that it will never unbox recursive data constructors. This is in line with our handling of them in CPR. I updated `Note [Which types are unboxed?]` to reflect that. In turn we fix #21119, #20767, #18907, T19871.absent and get a much simpler implementation (at least to think about). We can also drop the very ad-hoc definition of `deferAfterPreciseException` and its Note in favor of the simple, intuitive definition we used to have. Metric Decrease: T16875 T18223 T18698a T18698b hard_hole_fits Metric Increase: LargeRecord MultiComponentModulesRecomp T15703 T8095 T9872d Out of all the regresions, only the one in T9872d doesn't vanish in a perf build, where the compiler is bootstrapped with -O2 and thus SpecConstr. Reason for regressions: * T9872d is due to `ty_co_subst` taking its `LiftingContext` boxed. That is because the context is passed to a function argument, for example in `liftCoSubstTyVarBndrUsing`. * In T15703, LargeRecord and T8095, we get a bit more allocations in `expand_syn` and `piResultTys`, because a `TCvSubst` isn't unboxed. In both cases that guards against reboxing in some code paths. * The same is true for MultiComponentModulesRecomp, where we get less unboxing in `GHC.Unit.Finder.$wfindInstalledHomeModule`. In a perf build, allocations actually *improve* by over 4%! Results on NoFib: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- awards -0.4% +0.3% cacheprof -0.3% +2.4% fft -1.5% -5.1% fibheaps +1.2% +0.8% fluid -0.3% -0.1% ida +0.4% +0.9% k-nucleotide +0.4% -0.1% last-piece +10.5% +13.9% lift -4.4% +3.5% mandel2 -99.7% -99.8% mate -0.4% +3.6% parser -1.0% +0.1% puzzle -11.6% +6.5% reverse-complem -3.0% +2.0% scs -0.5% +0.1% sphere -0.4% -0.2% wave4main -8.2% -0.3% -------------------------------------------------------------------------------- Summary excludes mandel2 because of excessive bias Min -11.6% -5.1% Max +10.5% +13.9% Geometric Mean -0.2% +0.3% -------------------------------------------------------------------------------- Not bad for a bug fix. The regression in `last-piece` could become a win if SpecConstr would work on non-recursive functions. The regression in `fibheaps` is due to `Note [Reboxed crud for bottoming calls]`, e.g., #21128. - - - - - bb779b90 by sheaf at 2022-03-16T02:29:42-04:00 Add a regression test for #21130 This problem was due to a bug in cloneWanted, which was incorrectly creating a coercion hole to hold an evidence variable. This bug was introduced by 8bb52d91 and fixed in 81740ce8. Fixes #21130 - - - - - 0f0e2394 by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Initial Windows C++ exception unwinding support - - - - - 36d20d4d by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Fix ADDR32NB relocations on Windows - - - - - 8a516527 by Tamar Christina at 2022-03-17T10:16:37-04:00 testsuite: properly escape string paths - - - - - 1a0dd008 by sheaf at 2022-03-17T10:17:13-04:00 Hadrian: account for change in late-ccs flag The late cost centre flag was renamed from -fprof-late-ccs to -fprof-late in 7fe07143, but this change hadn't been propagated to Hadrian. - - - - - 8561c1af by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor HsBracket - - - - - 19163397 by romes at 2022-03-18T05:10:58-04:00 Type-checking untyped brackets When HsExpr GhcTc, the HsBracket constructor should hold a HsBracket GhcRn, rather than an HsBracket GhcTc. We make use of the HsBracket p extension constructor (XBracket (XXBracket p)) to hold an HsBracket GhcRn when the pass is GhcTc See !4782 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - 310890a5 by romes at 2022-03-18T05:10:58-04:00 Separate constructors for typed and untyped brackets Split HsBracket into HsTypedBracket and HsUntypedBracket. Unfortunately, we still cannot get rid of instance XXTypedBracket GhcTc = HsTypedBracket GhcRn despite no longer requiring it for typechecking, but rather because the TH desugarer works on GhcRn rather than GhcTc (See GHC.HsToCore.Quote) - - - - - 4a2567f5 by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor bracket for desugaring during tc When desugaring a bracket we want to desugar /renamed/ rather than /typechecked/ code; So in (HsExpr GhcTc) tree, we must have a (HsExpr GhcRn) for the quotation itself. This commit reworks the TTG refactor on typed and untyped brackets by storing the /renamed/ code in the bracket field extension rather than in the constructor extension in `HsQuote` (previously called `HsUntypedBracket`) See Note [The life cycle of a TH quotation] and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - b056adc8 by romes at 2022-03-18T05:10:58-04:00 TTG: Make HsQuote GhcTc isomorphic to NoExtField An untyped bracket `HsQuote p` can never be constructed with `p ~ GhcTc`. This is because we don't typecheck `HsQuote` at all. That's OK, because we also never use `HsQuote GhcTc`. To enforce this at the type level we make `HsQuote GhcTc` isomorphic to `NoExtField` and impossible to construct otherwise, by using TTG field extensions to make all constructors, except for `XQuote` (which takes `NoExtField`), unconstructable, with `DataConCantHappen` This is explained more in detail in Note [The life cycle of a TH quotation] Related discussion: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - ac3b2e7d by romes at 2022-03-18T05:10:58-04:00 TTG: TH brackets finishing touches Rewrite the critical notes and fix outdated ones, use `HsQuote GhcRn` (in `HsBracketTc`) for desugaring regardless of the bracket being typed or untyped, remove unused `EpAnn` from `Hs*Bracket GhcRn`, zonkExpr factor out common brackets code, ppr_expr factor out common brackets code, and fix tests, to finish MR https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782. ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - d147428a by Ben Gamari at 2022-03-18T05:11:35-04:00 codeGen: Fix signedness of jump table indexing Previously while constructing the jump table index we would zero-extend the discriminant before subtracting the start of the jump-table. This goes subtly wrong in the case of a sub-word, signed discriminant, as described in the included Note. Fix this in both the PPC and X86 NCGs. Fixes #21186. - - - - - 435a3d5d by Ben Gamari at 2022-03-18T05:11:35-04:00 testsuite: Add test for #21186 - - - - - e9d8de93 by Zubin Duggal at 2022-03-19T07:35:49-04:00 TH: Fix pretty printing of newtypes with operators and GADT syntax (#20868) The pretty printer for regular data types already accounted for these, and had some duplication with the newtype pretty printer. Factoring the logic out into a common function and using it for both newtypes and data declarations is enough to fix the bug. - - - - - 244da9eb by sheaf at 2022-03-19T07:36:24-04:00 List GHC.Event.Internal in base.cabal on Windows GHC.Event.Internal was not listed in base.cabal on Windows. This caused undefined reference errors. This patch adds it back, by moving it out of the OS-specific logic in base.cabal. Fixes #21245. - - - - - d1c03719 by Andreas Klebinger at 2022-03-19T07:37:00-04:00 Compact regions: Maintain tags properly Fixes #21251 - - - - - d45bb701 by romes at 2022-03-19T07:37:36-04:00 Remove dead code HsDoRn - - - - - c842611f by nineonine at 2022-03-20T21:16:06-04:00 Revamp derived Eq instance code generation (#17240) This patch improves code generation for derived Eq instances. The idea is to use 'dataToTag' to evaluate both arguments. This allows to 'short-circuit' when tags do not match. Unfortunately, inner evals are still present when we branch on tags. This is due to the way 'dataToTag#' primop evaluates its argument in the code generator. #21207 was created to explore further optimizations. Metric Decrease: LargeRecord - - - - - 52ffd38c by Sylvain Henry at 2022-03-20T21:16:46-04:00 Avoid some SOURCE imports - - - - - b91798be by Zubin Duggal at 2022-03-23T13:39:39-04:00 hi haddock: Lex and store haddock docs in interface files Names appearing in Haddock docstrings are lexed and renamed like any other names appearing in the AST. We currently rename names irrespective of the namespace, so both type and constructor names corresponding to an identifier will appear in the docstring. Haddock will select a given name as the link destination based on its own heuristics. This patch also restricts the limitation of `-haddock` being incompatible with `Opt_KeepRawTokenStream`. The export and documenation structure is now computed in GHC and serialised in .hi files. This can be used by haddock to directly generate doc pages without reparsing or renaming the source. At the moment the operation of haddock is not modified, that's left to a future patch. Updates the haddock submodule with the minimum changes needed. - - - - - 78db231f by Cheng Shao at 2022-03-23T13:40:17-04:00 configure: bump LlvmMaxVersion to 14 LLVM 13.0.0 is released in Oct 2021, and latest head validates against LLVM 13 just fine if LlvmMaxVersion is bumped. - - - - - b06e5dd8 by Adam Sandberg Ericsson at 2022-03-23T13:40:54-04:00 docs: clarify the eventlog format documentation a little bit - - - - - 4dc62498 by Matthew Pickering at 2022-03-23T13:41:31-04:00 Fix behaviour of -Wunused-packages in ghci Ticket #21110 points out that -Wunused-packages behaves a bit unusually in GHCi. Now we define the semantics for -Wunused-packages in interactive mode as follows: * If you use -Wunused-packages on an initial load then the warning is reported. * If you explicitly set -Wunused-packages on the command line then the warning is displayed (until it is disabled) * If you then subsequently modify the set of available targets by using :load or :cd (:cd unloads everything) then the warning is (silently) turned off. This means that every :r the warning is printed if it's turned on (but you did ask for it). Fixes #21110 - - - - - fed05347 by Ben Gamari at 2022-03-23T13:42:07-04:00 rts/adjustor: Place adjustor templates in data section on all OSs In !7604 we started placing adjustor templates in the data section on Linux as some toolchains there reject relocations in the text section. However, it turns out that OpenBSD also exhibits this restriction. Fix this by *always* placing adjustor templates in the data section. Fixes #21155. - - - - - db32bb8c by Zubin Duggal at 2022-03-23T13:42:44-04:00 Improve error message when warning about unsupported LLVM version (#20958) Change the wording to make it clear that the upper bound is non-inclusive. - - - - - f214349a by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Untag function field in scavenge_PAP_payload Previously we failed to untag the function closure when scavenging the payload of a PAP, resulting in an invalid closure pointer being passed to scavenge_large_bitmap and consequently #21254. Fix this. Fixes #21254 - - - - - e6d0e287 by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Don't mark object code in markCAFs unless necessary Previously `markCAFs` would call `markObjectCode` even in non-major GCs. This is problematic since `prepareUnloadCheck` is not called in such GCs, meaning that the section index has not been updated. Fixes #21254 - - - - - 1a7cf096 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Avoid redundant imports of GHC.Driver.Session Remove GHC.Driver.Session imports that weren't considered as redundant because of the reexport of PlatformConstants. Also remove this reexport as modules using this datatype should import GHC.Platform instead. - - - - - e3f60577 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Reverse dependency between StgToCmm and Runtime.Heap.Layout - - - - - e6585ca1 by Sylvain Henry at 2022-03-23T13:44:46-04:00 Define filterOut with filter filter has fusion rules that filterOut lacks - - - - - c58d008c by Ryan Scott at 2022-03-24T06:10:43-04:00 Fix and simplify DeriveAnyClass's context inference using SubTypePredSpec As explained in `Note [Gathering and simplifying constraints for DeriveAnyClass]` in `GHC.Tc.Deriv.Infer`, `DeriveAnyClass` infers instance contexts by emitting implication constraints. Previously, these implication constraints were constructed by hand. This is a terribly trick thing to get right, as it involves a delicate interplay of skolemisation, metavariable instantiation, and `TcLevel` bumping. Despite much effort, we discovered in #20719 that the implementation was subtly incorrect, leading to valid programs being rejected. While we could scrutinize the code that manually constructs implication constraints and repair it, there is a better, less error-prone way to do things. After all, the heart of `DeriveAnyClass` is generating code which fills in each class method with defaults, e.g., `foo = $gdm_foo`. Typechecking this sort of code is tantamount to calling `tcSubTypeSigma`, as we much ensure that the type of `$gdm_foo` is a subtype of (i.e., more polymorphic than) the type of `foo`. As an added bonus, `tcSubTypeSigma` is a battle-tested function that handles skolemisation, metvariable instantiation, `TcLevel` bumping, and all other means of tricky bookkeeping correctly. With this insight, the solution to the problems uncovered in #20719 is simple: use `tcSubTypeSigma` to check if `$gdm_foo`'s type is a subtype of `foo`'s type. As a side effect, `tcSubTypeSigma` will emit exactly the implication constraint that we were attempting to construct by hand previously. Moreover, it does so correctly, fixing #20719 as a consequence. This patch implements the solution thusly: * The `PredSpec` data type (previously named `PredOrigin`) is now split into `SimplePredSpec`, which directly stores a `PredType`, and `SubTypePredSpec`, which stores the actual and expected types in a subtype check. `SubTypePredSpec` is only used for `DeriveAnyClass`; all other deriving strategies use `SimplePredSpec`. * Because `tcSubTypeSigma` manages the finer details of type variable instantiation and constraint solving under the hood, there is no longer any need to delicately split apart the method type signatures in `inferConstraintsAnyclass`. This greatly simplifies the implementation of `inferConstraintsAnyclass` and obviates the need to store skolems, metavariables, or given constraints in a `ThetaSpec` (previously named `ThetaOrigin`). As a bonus, this means that `ThetaSpec` now simply becomes a synonym for a list of `PredSpec`s, which is conceptually much simpler than it was before. * In `simplifyDeriv`, each `SubTypePredSpec` results in a call to `tcSubTypeSigma`. This is only performed for its side effect of emitting an implication constraint, which is fed to the rest of the constraint solving machinery in `simplifyDeriv`. I have updated `Note [Gathering and simplifying constraints for DeriveAnyClass]` to explain this in more detail. To make the changes in `simplifyDeriv` more manageable, I also performed some auxiliary refactoring: * Previously, every iteration of `simplifyDeriv` was skolemising the type variables at the start, simplifying, and then performing a reverse substitution at the end to un-skolemise the type variables. This is not necessary, however, since we can just as well skolemise once at the beginning of the `deriving` pipeline and zonk the `TcTyVar`s after `simplifyDeriv` is finished. This patch does just that, having been made possible by prior work in !7613. I have updated `Note [Overlap and deriving]` in `GHC.Tc.Deriv.Infer` to explain this, and I have also left comments on the relevant data structures (e.g., `DerivEnv` and `DerivSpec`) to explain when things might be `TcTyVar`s or `TyVar`s. * All of the aforementioned cleanup allowed me to remove an ad hoc deriving-related in `checkImplicationInvariants`, as all of the skolems in a `tcSubTypeSigma`–produced implication constraint should now be `TcTyVar` at the time the implication is created. * Since `simplifyDeriv` now needs a `SkolemInfo` and `UserTypeCtxt`, I have added `ds_skol_info` and `ds_user_ctxt` fields to `DerivSpec` to store these. Similarly, I have also added a `denv_skol_info` field to `DerivEnv`, which ultimately gets used to initialize the `ds_skol_info` in a `DerivSpec`. Fixes #20719. - - - - - 21680fb0 by Sebastian Graf at 2022-03-24T06:11:19-04:00 WorkWrap: Handle partial FUN apps in `isRecDataCon` (#21265) Partial FUN apps like `(->) Bool` aren't detected by `splitFunTy_maybe`. A silly oversight that is easily fixed by replacing `splitFunTy_maybe` with a guard in the `splitTyConApp_maybe` case. But fortunately, Simon nudged me into rewriting the whole `isRecDataCon` function in a way that makes it much shorter and hence clearer which DataCons are actually considered as recursive. Fixes #21265. - - - - - a2937e2b by Matthew Pickering at 2022-03-24T17:13:22-04:00 Add test for T21035 This test checks that you are allowed to explicitly supply object files for dependencies even if you haven't got the shared object for that library yet. Fixes #21035 - - - - - 1756d547 by Matthew Pickering at 2022-03-24T17:13:58-04:00 Add check to ensure we are not building validate jobs for releases - - - - - 99623358 by Matthew Pickering at 2022-03-24T17:13:58-04:00 hadrian: Correct generation of hsc2hs wrapper If you inspect the inside of a wrapper script for hsc2hs you will see that the cflag and lflag values are concatenated incorrectly. ``` HSC2HS_EXTRA="--cflag=-U__i686--lflag=-fuse-ld=gold" ``` It should instead be ``` HSC2HS_EXTRA="--cflag=-U__i686 --lflag=-fuse-ld=gold" ``` Fixes #21221 - - - - - fefd4e31 by Matthew Pickering at 2022-03-24T17:13:59-04:00 testsuite: Remove library dependenices from T21119 These dependencies would affect the demand signature depending on various rules and so on. Fixes #21271 - - - - - 5ff690b8 by Matthew Pickering at 2022-03-24T17:13:59-04:00 ci: Generate jobs for all normal builds and use hadrian for all builds This commit introduces a new script (.gitlab/gen_ci.hs) which generates a yaml file (.gitlab/jobs.yaml) which contains explicit descriptions for all the jobs we want to run. The jobs are separated into three categories: * validate - jobs run on every MR * nightly - jobs run once per day on the master branch * release - jobs for producing release artifacts The generation script is a Haskell program which includes a DSL for specifying the different jobs. The hope is that it's easier to reason about the different jobs and how the variables are merged together rather than the unclear and opaque yaml syntax. The goal is to fix issues like #21190 once and for all.. The `.gitlab/jobs.yaml` can be generated by running the `.gitlab/generate_jobs` script. You have to do this manually. Another consequence of this patch is that we use hadrian for all the validate, nightly and release builds on all platforms. - - - - - 1d673aa2 by Christiaan Baaij at 2022-03-25T11:35:49-04:00 Add the OPAQUE pragma A new pragma, `OPAQUE`, that ensures that every call of a named function annotated with an `OPAQUE` pragma remains a call of that named function, not some name-mangled variant. Implements GHC proposal 0415: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst This commit also updates the haddock submodule to handle the newly introduced lexer tokens corresponding to the OPAQUE pragma. - - - - - 83f5841b by Bodigrim at 2022-03-25T11:36:31-04:00 Add instance Lift ByteArray - - - - - 7cc1184a by Matthew Pickering at 2022-03-25T11:37:07-04:00 Make -ddump-rn-ast and -ddump-tc-ast work in GHCi Fixes #17830 - - - - - 940feaf3 by Sylvain Henry at 2022-03-25T11:37:47-04:00 Modularize Tidy (#17957) - Factorize Tidy options into TidyOpts datatype. Initialize it in GHC.Driver.Config.Tidy - Same thing for StaticPtrOpts - Perform lookups of unpackCString[Utf8]# once in initStaticPtrOpts instead of for every use of mkStringExprWithFS - - - - - 25101813 by Takenobu Tani at 2022-03-28T01:16:02-04:00 users-guide: Correct markdown for profiling This patch corrects some markdown. [skip ci] - - - - - c832ae93 by Matthew Pickering at 2022-03-28T01:16:38-04:00 hadrian: Flag cabal flag handling This patch basically deletes some ad-hoc handling of Cabal Flags and replaces it with a correct query of the LocalBuildInfo. The flags in the local build info can be modified by users by passing hadrian options For example (!4331) ``` *.genapply.cabal.configure.opts += --flags=unregisterised ``` And all the flags specified by the `Cabal Flags` builder were already passed to configure properly using `--flags`. - - - - - a9f3a5c6 by Ben Gamari at 2022-03-28T01:16:38-04:00 Disable text's dependency on simdutf by default Unfortunately we are simply not currently in a good position to robustly ship binary distributions which link against C++ code like simdutf. Fixes #20724. - - - - - eff86e8a by Richard Eisenberg at 2022-03-28T01:17:14-04:00 Add Red Herring to Note [What might equal later?] Close #21208. - - - - - 12653be9 by jberryman at 2022-03-28T01:17:55-04:00 Document typed splices inhibiting unused bind detection (#16524) - - - - - 4aeade15 by Adam Sandberg Ericsson at 2022-03-28T01:18:31-04:00 users-guide: group ticky-ticky profiling under one heading - - - - - cc59648a by Sylvain Henry at 2022-03-28T01:19:12-04:00 Hadrian: allow testsuite to run with cross-compilers (#21292) - - - - - 89cb1315 by Matthew Pickering at 2022-03-28T01:19:48-04:00 hadrian: Add show target to bindist makefile Some build systems use "make show" to query facts about the bindist, for example: ``` make show VALUE=ProjectVersion > version ``` to determine the ProjectVersion - - - - - 8229885c by Alan Zimmerman at 2022-03-28T19:23:28-04:00 EPA: let stmt with semicolon has wrong anchor The code let ;x =1 Captures the semicolon annotation, but did not widen the anchor in the ValBinds. Fix that. Closes #20247 - - - - - 2c12627c by Ryan Scott at 2022-03-28T19:24:04-04:00 Consistently attach SrcSpans to sub-expressions in TH splices Before, `GHC.ThToHs` was very inconsistent about where various sub-expressions would get the same `SrcSpan` from the original TH splice location or just a generic `noLoc` `SrcSpan`. I have ripped out all uses of `noLoc` in favor of the former instead, and I have added a `Note [Source locations within TH splices]` to officially enshrine this design choice. Fixes #21299. - - - - - 789add55 by Zubin Duggal at 2022-03-29T13:07:22-04:00 Fix all invalid haddock comments in the compiler Fixes #20935 and #20924 - - - - - 967dad03 by Zubin Duggal at 2022-03-29T13:07:22-04:00 hadrian: Build lib:GHC with -haddock and -Winvalid-haddock (#21273) - - - - - ad09a5f7 by sheaf at 2022-03-29T13:08:05-04:00 Hadrian: make DDEBUG separate from debugged RTS This patchs separates whether -DDEBUG is enabled (i.e. whether debug assertions are enabled) from whether we are using the debugged RTS (i.e. GhcDebugged = YES). This means that we properly skip tests which have been marked with `when(compiler_debugged(), skip)`. Fixes #21113, #21153 and #21234 - - - - - 840a6811 by Matthew Pickering at 2022-03-29T13:08:42-04:00 RTS: Zero gc_cpu_start and gc_cpu_end after accounting When passed a combination of `-N` and `-qn` options the cpu time for garbage collection was being vastly overcounted because the counters were not being zeroed appropiately. When -qn1 is passed, only 1 of the N avaiable GC threads is chosen to perform work, the rest are idle. At the end of the GC period, stat_endGC traverses all the GC threads and adds up the elapsed time from each of them. For threads which didn't participate in this GC, the value of the cpu time should be zero, but before this patch, the counters were not zeroed and hence we would count the same elapsed time on many subsequent iterations (until the thread participated in a GC again). The most direct way to zero these fields is to do so immediately after the value is added into the global counter, after which point they are never used again. We also tried another approach where we would zero the counter in yieldCapability but there are some (undiagnosed) siations where a capbility would not pass through yieldCapability before the GC ended and the same double counting problem would occur. Fixes #21082 - - - - - dda46e2d by Matthew Pickering at 2022-03-29T13:09:18-04:00 Add test for T21306 Fixes #21306 - - - - - f07c7766 by Jakob Brünker at 2022-03-30T03:10:33-04:00 Give parsing plugins access to errors Previously, when the parser produced non-fatal errors (i.e. it produced errors but the 'PState' is 'POk'), compilation would be aborted before the 'parsedResultAction' of any plugin was invoked. This commit changes that, so that such that 'parsedResultAction' gets collections of warnings and errors as argument, and must return them after potentially modifying them. Closes #20803 - - - - - e5dfde75 by Ben Gamari at 2022-03-30T03:11:10-04:00 Fix reference to Note [FunBind vs PatBind] This Note was renamed in 2535a6716202253df74d8190b028f85cc6d21b72 yet this occurrence was not updated. - - - - - 21894a63 by Krzysztof Gogolewski at 2022-03-30T03:11:45-04:00 Refactor: make primtypes independent of PrimReps Previously, 'pcPrimTyCon', the function used to define a primitive type, was taking a PrimRep, only to convert it to a RuntimeRep. Now it takes a RuntimeRep directly. Moved primRepToRuntimeRep to GHC.Types.RepType. It is now located next to its inverse function runtimeRepPrimRep. Now GHC.Builtin.Types.Prim no longer mentions PrimRep, and GHC.Types.RepType no longer imports GHC.Builtin.Types.Prim. Removed unused functions `primRepsToRuntimeRep` and `mkTupleRep`. Removed Note [PrimRep and kindPrimRep] - it was never referenced, didn't belong to Types.Prim, and Note [Getting from RuntimeRep to PrimRep] is more comprehensive. - - - - - 43da2963 by Matthew Pickering at 2022-03-30T09:55:49+01:00 Fix mention of non-existent "rehydrateIface" function [skip ci] Fixes #21303 - - - - - 6793a20f by gershomb at 2022-04-01T10:33:46+01:00 Remove wrong claim about naturality law. This docs change removes a longstanding confusion in the Traversable docs. The docs say "(The naturality law is implied by parametricity and thus so is the purity law [1, p15].)". However if one reads the reference a different "natural" law is implied by parametricity. The naturality law given as a law here is imposed. Further, the reference gives examples which violate both laws -- so they cannot be implied by parametricity. This PR just removes the wrong claim. - - - - - 5beeff46 by Ben Gamari at 2022-04-01T10:34:39+01:00 Refactor handling of global initializers GHC uses global initializers for a number of things including cost-center registration, info-table provenance registration, and setup of foreign exports. Previously, the global initializer arrays which referenced these initializers would live in the object file of the C stub, which would then be merged into the main object file of the module. Unfortunately, this approach is no longer tenable with the move to Clang/LLVM on Windows (see #21019). Specifically, lld's PE backend does not support object merging (that is, the -r flag). Instead we are now rather packaging a module's object files into a static library. However, this is problematic in the case of initializers as there are no references to the C stub object in the archive, meaning that the linker may drop the object from the final link. This patch refactors our handling of global initializers to instead place initializer arrays within the object file of the module to which they belong. We do this by introducing a Cmm data declaration containing the initializer array in the module's Cmm stream. While the initializer functions themselves remain in separate C stub objects, the reference from the module's object ensures that they are not dropped from the final link. In service of #21068. - - - - - 3e6fe71b by Matthew Pickering at 2022-04-01T10:35:41+01:00 Fix remaining issues in eventlog types (gen_event_types.py) * The size of End concurrent mark phase looks wrong and, it used to be 4 and now it's 0. * The size of Task create is wrong, used to be 18 and now 14. * The event ticky-ticky entry counter begin sample has the wrong name * The event ticky-ticky entry counter being sample has the wrong size, was 0 now 32. Closes #21070 - - - - - 7847f47a by Ben Gamari at 2022-04-01T10:35:41+01:00 users-guide: Fix a few small issues in eventlog format descriptions The CONC_MARK_END event description didn't mention its payload. Clarify the meaning of the CREATE_TASK's payload. - - - - - acfd5a4c by Matthew Pickering at 2022-04-01T10:35:53+01:00 ci: Regenerate jobs.yaml It seems I forgot to update this to reflect the current state of gen_ci.hs - - - - - a952dd80 by Matthew Pickering at 2022-04-01T10:35:59+01:00 ci: Attempt to fix windows cache issues It appears that running the script directly does nothing (no info is printed about saving the cache). - - - - - fb65e6e3 by Adrian Ratiu at 2022-04-01T10:49:52+01:00 fp_prog_ar.m4: take AR var into consideration In ChromeOS and Gentoo we want the ability to use LLVM ar instead of GNU ar even though both are installed, thus we pass (for eg) AR=llvm-ar to configure. Unfortunately GNU ar always gets picked regardless of the AR setting because the check does not consider the AR var when setting fp_prog_ar, hence this fix. - - - - - 1daaefdf by Greg Steuck at 2022-04-01T10:50:16+01:00 T13366 requires c++ & c++abi libraries on OpenBSD Fixes this failure: =====> 1 of 1 [0, 0, 0] T13366(normal) 1 of 1 [0, 0, 0] Compile failed (exit code 1) errors were: <no location info>: error: user specified .o/.so/.DLL could not be loaded (File not found) Whilst trying to load: (dynamic) stdc++ Additional directories searched: (none) *** unexpected failure for T13366(normal) - - - - - 18e6c85b by Jakob Bruenker at 2022-04-01T10:54:28+01:00 new datatypes for parsedResultAction Previously, the warnings and errors were given and returned as a tuple (Messages PsWarnings, Messages PsErrors). Now, it's just PsMessages. This, together with the HsParsedModule the parser plugin gets and returns, has been wrapped up as ParsedResult. - - - - - 9727e592 by Morrow at 2022-04-01T10:55:12+01:00 Clarify that runghc interprets the input program - - - - - f589dea3 by sheaf at 2022-04-01T10:59:58+01:00 Unify RuntimeRep arguments in ty_co_match The `ty_co_match` function ignored the implicit RuntimeRep coercions that occur in a `FunCo`. Even though a comment explained that this should be fine, #21205 showed that it could result in discarding a RuntimeRep coercion, and thus discarding an important cast entirely. With this patch, we first match the kinds in `ty_co_match`. Fixes #21205 ------------------------- Metric Increase: T12227 T18223 ------------------------- - - - - - 6f4dc372 by Andreas Klebinger at 2022-04-01T11:01:35+01:00 Export MutableByteArray from Data.Array.Byte This implements CLC proposal #49 - - - - - 5df9f5e7 by ARATA Mizuki at 2022-04-01T11:02:35+01:00 Add test cases for #20640 Closes #20640 - - - - - 8334ff9e by Krzysztof Gogolewski at 2022-04-01T11:03:16+01:00 Minor cleanup - Remove unused functions exprToCoercion_maybe, applyTypeToArg, typeMonoPrimRep_maybe, runtimeRepMonoPrimRep_maybe. - Replace orValid with a simpler check - Use splitAtList in applyTysX - Remove calls to extra_clean in the testsuite; it does not do anything. Metric Decrease: T18223 - - - - - b2785cfc by Eric Lindblad at 2022-04-01T11:04:07+01:00 hadrian typos - - - - - 418e6fab by Eric Lindblad at 2022-04-01T11:04:12+01:00 two typos - - - - - dd7c7c99 by Phil de Joux at 2022-04-01T11:04:56+01:00 Add tests and docs on plugin args and order. - - - - - 3e209a62 by MaxHearnden at 2022-04-01T11:05:19+01:00 Change may not to might not - - - - - b84380d3 by Matthew Pickering at 2022-04-01T11:07:27+01:00 hadrian: Remove linters-common from bindist Zubin observed that the bindists contains the utility library linters-common. There are two options: 1. Make sure only the right files are added into the bindist.. a bit tricky due to the non-trivial structure of the lib directory. 2. Remove the bad files once they get copied in.. a bit easier So I went for option 2 but we perhaps should go for option 1 in the future. Fixes #21203 - - - - - ba9904c1 by Zubin Duggal at 2022-04-01T11:07:31+01:00 hadrian: allow testing linters with out of tree compilers - - - - - 26547759 by Matthew Pickering at 2022-04-01T11:07:35+01:00 hadrian: Introduce CheckProgram datatype to replace a 7-tuple - - - - - df65d732 by Jakob Bruenker at 2022-04-01T11:08:28+01:00 Fix panic when pretty printing HsCmdLam When pretty printing a HsCmdLam with more than one argument, GHC panicked because of a missing case. This fixes that. Closes #21300 - - - - - ad6cd165 by John Ericson at 2022-04-01T11:10:06+01:00 hadrian: Remove vestigial -this-unit-id support check This has been dead code since 400ead81e80f66ad7b1260b11b2a92f25ccc3e5a. - - - - - 8ca7ab81 by Matthew Pickering at 2022-04-01T11:10:23+01:00 hadrian: Fix race involving empty package databases There was a small chance of a race occuring between the small window of 1. The first package (.conf) file get written into the database 2. hadrian calling "ghc-pkg recache" to refresh the package.conf file In this window the package database would contain rts.conf but not a package.cache file, and therefore if ghc was invoked it would error because it was missing. To solve this we call "ghc-pkg recache" at when the database is created by shake by writing the stamp file into the database folder. This also creates the package.cache file and so avoids the possibility of this race. - - - - - cc4ec64b by Matthew Pickering at 2022-04-01T11:11:05+01:00 hadrian: Add assertion that in/out tree args are the same There have been a few instances where this calculation was incorrect, so we add a non-terminal assertion when now checks they the two computations indeed compute the same thing. Fixes #21285 - - - - - 691508d8 by Matthew Pickering at 2022-04-01T11:13:10+01:00 hlint: Ignore suggestions in generated HaddockLex file With the make build system this file ends up in the compiler/ subdirectory so is linted. With hadrian, the file ends up in _build so it's not linted. Fixes #21313 - - - - - f8f152e7 by Krzysztof Gogolewski at 2022-04-01T11:14:08+01:00 Change GHC.Prim to GHC.Exts in docs and tests Users are supposed to import GHC.Exts rather than GHC.Prim. Part of #18749. - - - - - f8fc6d2e by Matthew Pickering at 2022-04-01T11:15:24+01:00 driver: Improve -Wunused-packages error message (and simplify implementation) In the past I improved the part of -Wunused-packages which found which packages were used. Now I improve the part which detects which ones were specified. The key innovation is to use the explicitUnits field from UnitState which has the result of resolving the package flags, so we don't need to mess about with the flag arguments from DynFlags anymore. The output now always includes the package name and version (and the flag which exposed it). ``` The following packages were specified via -package or -package-id flags, but were not needed for compilation: - bytestring-0.11.2.0 (exposed by flag -package bytestring) - ghc-9.3 (exposed by flag -package ghc) - process-1.6.13.2 (exposed by flag -package process) ``` Fixes #21307 - - - - - 5e5a12d9 by Matthew Pickering at 2022-04-01T11:15:32+01:00 driver: In oneshot mode, look for interface files in hidir How things should work: * -i is the search path for source files * -hidir explicitly sets the search path for interface files and the output location for interface files. * -odir sets the search path and output location for object files. Before in one shot mode we would look for the interface file in the search locations given by `-i`, but then set the path to be in the `hidir`, so in unusual situations the finder could find an interface file in the `-i` dir but later fail because it tried to read the interface file from the `-hidir`. A bug identified by #20569 - - - - - 950f58e7 by Matthew Pickering at 2022-04-01T11:15:36+01:00 docs: Update documentation interaction of search path, -hidir and -c mode. As noted in #20569 the documentation for search path was wrong because it seemed to indicate that `-i` dirs were important when looking for interface files in `-c` mode, but they are not important if `-hidir` is set. Fixes #20569 - - - - - d85c7dcb by sheaf at 2022-04-01T11:17:56+01:00 Keep track of promotion ticks in HsOpTy This patch adds a PromotionFlag field to HsOpTy, which is used in pretty-printing and when determining whether to emit warnings with -fwarn-unticked-promoted-constructors. This allows us to correctly report tick-related warnings for things like: type A = Int : '[] type B = [Int, Bool] Updates haddock submodule Fixes #19984 - - - - - 32070e6c by Jakob Bruenker at 2022-04-01T20:31:08+02:00 Implement \cases (Proposal 302) This commit implements proposal 302: \cases - Multi-way lambda expressions. This adds a new expression heralded by \cases, which works exactly like \case, but can match multiple apats instead of a single pat. Updates submodule haddock to support the ITlcases token. Closes #20768 - - - - - c6f77f39 by sheaf at 2022-04-01T20:33:05+02:00 Add a regression test for #21323 This bug was fixed at some point between GHC 9.0 and GHC 9.2; this patch simply adds a regression test. - - - - - 3596684e by Jakob Bruenker at 2022-04-01T20:33:05+02:00 Fix error when using empty case in arrow notation It was previously not possible to use -XEmptyCase in Arrow notation, since GHC would print "Exception: foldb of empty list". This is now fixed. Closes #21301 - - - - - 9a325b59 by Ben Gamari at 2022-04-01T20:33:05+02:00 users-guide: Fix various markup issues - - - - - aefb1e6d by sheaf at 2022-04-01T20:36:01+02:00 Ensure implicit parameters are lifted `tcExpr` typechecked implicit parameters by introducing a metavariable of kind `TYPE kappa`, without enforcing that `kappa ~ LiftedRep`. This patch instead creates a metavariable of kind `Type`. Fixes #21327 - - - - - ed62dc66 by Ben Gamari at 2022-04-05T11:44:51-04:00 gitlab-ci: Disable cabal-install store caching on Windows For reasons that remain a mystery, cabal-install seems to consistently corrupt its cache on Windows. Disable caching for now. Works around #21347. - - - - - 5ece5c5a by Ryan Scott at 2022-04-06T13:00:51-04:00 Add /linters/*/dist-install/ to .gitignore Fixes #21335. [ci skip] - - - - - 410c76ee by Ben Gamari at 2022-04-06T13:01:28-04:00 Use static archives as an alternative to object merging Unfortunately, `lld`'s COFF backend does not currently support object merging. With ld.bfd having broken support for high image-load base addresses, it's necessary to find an alternative. Here I introduce support in the driver for generating static archives, which we use on Windows instead of object merging. Closes #21068. - - - - - 400666c8 by Ben Gamari at 2022-04-06T13:01:28-04:00 rts/linker: Catch archives masquerading as object files Check the file's header to catch static archive bearing the `.o` extension, as may happen on Windows after the Clang refactoring. See #21068 - - - - - 694d39f0 by Ben Gamari at 2022-04-06T13:01:28-04:00 driver: Make object merging optional On Windows we don't have a linker which supports object joining (i.e. the `-r` flag). Consequently, `-pgmlm` is now a `Maybe`. See #21068. - - - - - 41fcb5cd by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Refactor handling of ar flags Previously the setup was quite fragile as it had to assume which arguments were file arguments and which were flags. - - - - - 3ac80a86 by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Produce ar archives with L modifier on Windows Since object files may in fact be archive files, we must ensure that their contents are merged rather than constructing an archive-of-an-archive. See #21068. - - - - - 295c35c5 by Ben Gamari at 2022-04-06T13:01:28-04:00 Add a Note describing lack of object merging on Windows See #21068. - - - - - d2ae0a3a by Ben Gamari at 2022-04-06T13:01:28-04:00 Build ar archives with -L when "joining" objects Since there may be .o files which are in fact archives. - - - - - babb47d2 by Zubin Duggal at 2022-04-06T13:02:04-04:00 Add warnings for file header pragmas that appear in the body of a module (#20385) Once we are done parsing the header of a module to obtain the options, we look through the rest of the tokens in order to determine if they contain any misplaced file header pragmas that would usually be ignored, potentially resulting in bad error messages. The warnings are reported immediately so that later errors don't shadow over potentially helpful warnings. Metric Increase: T13719 - - - - - 3f31825b by Ben Gamari at 2022-04-06T13:02:40-04:00 rts/AdjustorPool: Generalize to allow arbitrary contexts Unfortunately the i386 adjustor logic needs this. - - - - - 9b645ee1 by Ben Gamari at 2022-04-06T13:02:40-04:00 adjustors/i386: Use AdjustorPool In !7511 (closed) I introduced a new allocator for adjustors, AdjustorPool, which eliminates the address space fragmentation issues which adjustors can introduce. In that work I focused on amd64 since that was the platform where I observed issues. However, in #21132 we noted that the size of adjustors is also a cause of CI fragility on i386. In this MR I port i386 to use AdjustorPool. Sadly the complexity of the i386 adjustor code does cause require a bit of generalization which makes the code a bit more opaque but such is the world. Closes #21132. - - - - - c657a616 by Ben Gamari at 2022-04-06T13:03:16-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 9ce273b9 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Drop dead HACKAGE_INDEX_STATE variable - - - - - 01845375 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab/darwin: Factor out bindists This makes it a bit easier to bump them. - - - - - c41c478e by Ben Gamari at 2022-04-06T13:03:16-04:00 Fix a few new warnings when booting with GHC 9.2.2 -Wuni-incomplete-patterns and apparent improvements in the pattern match checker surfaced these. - - - - - 6563cd24 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Bump bootstrap compiler to 9.2.2 This is necessary to build recent `text` commits. Bumps Hackage index state for a hashable which builds with GHC 9.2. - - - - - a62e983e by Ben Gamari at 2022-04-06T13:03:16-04:00 Bump text submodule to current `master` Addresses #21295. - - - - - 88d61031 by Vladislav Zavialov at 2022-04-06T13:03:53-04:00 Refactor OutputableBndrFlag instances The matching on GhcPass introduced by 95275a5f25a is not necessary. This patch reverts it to make the code simpler. - - - - - f601f002 by GHC GitLab CI at 2022-04-06T15:18:26-04:00 rts: Eliminate use of nested functions This is a gcc-specific extension. - - - - - d4c5f29c by Ben Gamari at 2022-04-06T15:18:26-04:00 driver: Drop hacks surrounding windres invocation Drop hack for #1828, among others as they appear to be unnecessary when using `llvm-windres`. - - - - - 6be2c5a7 by Ben Gamari at 2022-04-06T15:18:26-04:00 Windows/Clang: Build system adaptation * Bump win32-tarballs to 0.7 * Move Windows toolchain autoconf logic into separate file * Use clang and LLVM utilities as described in #21019 * Disable object merging as lld doesn't support -r * Drop --oformat=pe-bigobj-x86-64 arguments from ld flags as LLD detects that the output is large on its own. * Drop gcc wrapper since Clang finds its root fine on its own. - - - - - c6fb7aff by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Test that we can build bigobj PE objects - - - - - 79851c07 by Ben Gamari at 2022-04-06T15:18:26-04:00 Drop -static-libgcc This flag is not applicable when Clang is used. - - - - - 1f8a8264 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Port T16514 to C Previously this test was C++ which made it a bit of a portability problem. - - - - - d7e650d1 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark Windows as a libc++ platform - - - - - d7886c46 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark T9405 as fixed on Windows I have not seen it fail since moving to clang. Closes #12714. - - - - - 4c3fbb4e by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark FloatFnInverses as fixed The new toolchain has fixed it. Closes #15670. - - - - - 402c36ba by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Rework T13606 to avoid gcc dependence Previously we used libgcc_s's import library in T13606. However, now that we ship with clang we no longer have this library. Instead we now use gdi32. - - - - - 9934ad54 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Clean up tests depending on C++ std lib - - - - - 12fcdef2 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Split T13366 into two tests Split up the C and C++ uses since the latter is significantly more platform-dependent. - - - - - 3c08a198 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Fix mk-big-obj I'm a bit unclear on how this previously worked as it attempted to build an executable without defining `main`. - - - - - 7e97cc23 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Provide module definitions in T10955dyn Otherwise the linker will export all symbols, including those provided by the RTS, from the produced shared object. Consequently, attempting to link against multiple objects simultaneously will cause the linker to complain that RTS symbols are multiply defined. Avoid this by limiting the DLL exports with a module definition file. - - - - - 9a248afa by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark test-defaulting-plugin as fragile on Windows Currently llvm-ar does not handle long file paths, resulting in occassional failures of these tests and #21293. - - - - - 39371aa4 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite/driver: Treat framework failures of fragile tests as non-fatal Previously we would report framework failures of tests marked as fragile as failures. Now we rather treat them as fragile test failures, which are not fatal to the testsuite run. Noticed while investigating #21293. - - - - - a1e6661d by Ben Gamari at 2022-04-06T15:18:32-04:00 Bump Cabal submodule - Disable support for library-for-ghci on Windows as described in #21068. - Teach Cabal to use `ar -L` when available - - - - - f7b0f63c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump process submodule Fixes missing TEST_CC_OPTS in testsuite tests. - - - - - 109cee19 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Disable ghci libraries when object merging is not available - - - - - c22fba5c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump bytestring submodule - - - - - 6e2744cc by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump text submodule - - - - - 32333747 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Build wrappers using ghc rather than cc - - - - - 59787ba5 by Ben Gamari at 2022-04-06T15:18:37-04:00 linker/PEi386: More descriptive error message - - - - - 5e3c3c4f by Ben Gamari at 2022-04-06T15:18:37-04:00 testsuite: Mark TH_spliceE5_prof as unbroken on Windows It was previously failing due to #18721 and now passes with the new toolchain. Closes #18721. - - - - - 9eb0a9d9 by GHC GitLab CI at 2022-04-06T15:23:48-04:00 rts/PEi386: Move some debugging output to -DL - - - - - ce874595 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen/x86: Use %rip-relative addressing On Windows with high-entropy ASLR we must use %rip-relative addressing to avoid overflowing the signed 32-bit immediate size of x86-64. Since %rip-relative addressing comes essentially for free and can make linking significantly easier, we use it on all platforms. - - - - - 52deee64 by Ben Gamari at 2022-04-06T15:24:01-04:00 Generate LEA for label expressions - - - - - 105a0056 by Ben Gamari at 2022-04-06T15:24:01-04:00 Refactor is32BitLit to take Platform rather than Bool - - - - - ec4526b5 by Ben Gamari at 2022-04-06T15:24:01-04:00 Don't assume that labels are 32-bit on Windows - - - - - ffdbe457 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen: Note signed-extended nature of MOV - - - - - bfb79697 by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 5ad143fd by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - a59a66a8 by Ben Gamari at 2022-04-06T15:30:56-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - 42bf7528 by GHC GitLab CI at 2022-04-06T16:25:04-04:00 rts/PEi386: Fix memory leak Previously we would leak the section information of the `.bss` section. - - - - - d286a55c by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Preserve information about symbol types As noted in #20978, the linker would previously handle overflowed relocations by creating a jump island. While this is fine in the case of code symbols, it's very much not okay in the case of data symbols. To fix this we must keep track of whether each symbol is code or data and relocate them appropriately. This patch takes the first step in this direction, adding a symbol type field to the linker's symbol table. It doesn't yet change relocation behavior to take advantage of this knowledge. Fixes #20978. - - - - - e689e9d5 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Fix relocation overflow behavior This fixes handling of overflowed relocations on PEi386 targets: * Refuse to create jump islands for relocations of data symbols * Correctly handle the `__imp___acrt_iob_func` symbol, which is an new type of symbol: `SYM_TYPE_INDIRECT_DATA` - - - - - 655e7d8f by GHC GitLab CI at 2022-04-06T16:25:25-04:00 rts: Mark anything that might have an info table as data Tables-next-to-code mandates that we treat symbols with info tables like data since we cannot relocate them using a jump island. See #20983. - - - - - 7e8cc293 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Rework linker This is a significant rework of the PEi386 linker, making the linker compatible with high image base addresses. Specifically, we now use the m32 allocator instead of `HeapAllocate`. In addition I found a number of latent bugs in our handling of import libraries and relocations. I've added quite a few comments describing what I've learned about Windows import libraries while fixing these. Thanks to Tamar Christina (@Phyx) for providing the address space search logic, countless hours of help while debugging, and his boundless Windows knowledge. Co-Authored-By: Tamar Christina <tamar at zhox.com> - - - - - ff625218 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Move allocateBytes to MMap.c - - - - - f562b5ca by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Avoid accidentally-quadratic allocation cost We now preserve the address that we last mapped, allowing us to resume our search and avoiding quadratic allocation costs. This fixes the runtime of T10296a, which allocates many adjustors. - - - - - 3247b7db by Ben Gamari at 2022-04-06T16:25:25-04:00 Move msvcrt dep out of base - - - - - fa404335 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: More descriptive debug output - - - - - 140f338f by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PathUtils: Define pathprintf in terms of snwprintf on Windows swprintf deviates from usual `snprintf` semantics in that it does not guarantee reasonable behavior when the buffer is NULL (that is, returning the number of bytes that would have been emitted). - - - - - eb60565b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Report archive member index - - - - - 209fd61b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Split up object resolution and initialization Previously the RTS linker would call initializers during the "resolve" phase of linking. However, this is problematic in the case of cyclic dependencies between objects. In particular, consider the case where we have a situation where a static library contains a set of recursive objects: * object A has depends upon symbols in object B * object B has an initializer that depends upon object A * we try to load object A The linker would previously: 1. start resolving object A 2. encounter the reference to object B, loading it resolve object B 3. run object B's initializer 4. the initializer will attempt to call into object A, which hasn't been fully resolved (and therefore protected) Fix this by moving constructor execution to a new linking phase, which follows resolution. Fix #21253. - - - - - 8e8a1021 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker/LoadArchive: Fix leaking file handle Previously `isArchive` could leak a `FILE` handle if the `fread` returned a short read. - - - - - 429ea5d9 by sheaf at 2022-04-07T07:55:52-04:00 Remove Fun pattern from Typeable COMPLETE set GHC merge request !963 improved warnings in the presence of COMPLETE annotations. This allows the removal of the Fun pattern from the complete set. Doing so expectedly causes some redundant pattern match warnings, in particular in GHC.Utils.Binary.Typeable and Data.Binary.Class from the binary library; this commit addresses that. Updates binary submodule Fixes #20230 - - - - - 54b18824 by Alan Zimmerman at 2022-04-07T07:56:28-04:00 EPA: handling of con_bndrs in mkGadtDecl Get rid of unnnecessary case clause that always matched. Closes #20558 - - - - - 9c838429 by Ben Gamari at 2022-04-07T09:38:53-04:00 testsuite: Mark T10420 as broken on Windows Due to #21322. - - - - - 50739d2b by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Refactor and fix printf attributes on clang Clang on Windows does not understand the `gnu_printf` attribute; use `printf` instead. - - - - - 9eeaeca4 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Add missing newline in error message - - - - - fcef9a17 by Ben Gamari at 2022-04-07T09:42:42-04:00 configure: Make environ decl check more robust Some platforms (e.g. Windows/clang64) declare `environ` in `<stdlib.h>`, not `<unistd.h>` - - - - - 8162b4f3 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Adjust RTS symbol table on Windows for ucrt - - - - - 633280d7 by Ben Gamari at 2022-04-07T09:43:21-04:00 testsuite: Fix exit code of bounds checking tests on Windows `abort` exits with 255, not 134, on Windows. - - - - - cab4dc01 by Ben Gamari at 2022-04-07T09:43:31-04:00 testsuite: Update expected output from T5435 tests on Windows I'll admit, I don't currently see *why* this output is reordered but it is a fairly benign difference and I'm out of time to investigate. - - - - - edf5134e by Ben Gamari at 2022-04-07T09:43:35-04:00 testsuite: Mark T20918 as broken on Windows Our toolchain on Windows doesn't currently have Windows support. - - - - - d0ddeff3 by Ben Gamari at 2022-04-07T09:43:39-04:00 testsuite: Mark linker unloading tests as broken on Windows Due to #20354. We will need to investigate this prior the release. - - - - - 5a86da2b by Ben Gamari at 2022-04-07T09:43:43-04:00 testsuite: Mark T9405 as broken on Windows Due to #21361. - - - - - 4aa86dcf by Ben Gamari at 2022-04-07T09:44:18-04:00 Merge branches 'wip/windows-high-codegen', 'wip/windows-high-linker', 'wip/windows-clang-2' and 'wip/lint-rts-includes' into wip/windows-clang-join - - - - - 7206f055 by Ben Gamari at 2022-04-07T09:45:07-04:00 rts/CloneStack: Ensure that Rts.h is #included first As is necessary on Windows. - - - - - 9cfcb27b by Ben Gamari at 2022-04-07T09:45:07-04:00 rts: Fallback to ucrtbase not msvcrt Since we have switched to Clang the toolchain now links against ucrt rather than msvcrt. - - - - - d6665d85 by Ben Gamari at 2022-04-07T09:46:25-04:00 Accept spurious perf test shifts on Windows Metric Decrease: T16875 Metric Increase: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 83363c8b by Simon Peyton Jones at 2022-04-07T12:57:21-04:00 Use prepareBinding in tryCastWorkerWrapper As #21144 showed, tryCastWorkerWrapper was calling prepareRhs, and then unconditionally floating the bindings, without the checks of doFloatFromRhs. That led to floating an unlifted binding into a Rec group. This patch refactors prepareBinding to make these checks, and do them uniformly across all calls. A nice improvement. Other changes * Instead of passing around a RecFlag and a TopLevelFlag; and sometimes a (Maybe SimplCont) for join points, define a new Simplifier-specific data type BindContext: data BindContext = BC_Let TopLevelFlag RecFlag | BC_Join SimplCont and use it consistently. * Kill off completeNonRecX by inlining it. It was only called in one place. * Add a wrapper simplImpRules for simplRules. Compile time on T9630 drops by 4.7%; little else changes. Metric Decrease: T9630 - - - - - 02279a9c by Vladislav Zavialov at 2022-04-07T12:57:59-04:00 Rename [] to List (#21294) This patch implements a small part of GHC Proposal #475. The key change is in GHC.Types: - data [] a = [] | a : [a] + data List a = [] | a : List a And the rest of the patch makes sure that List is pretty-printed as [] in various contexts. Updates the haddock submodule. - - - - - 08480d2a by Simon Peyton Jones at 2022-04-07T12:58:36-04:00 Fix the free-var test in validDerivPred The free-var test (now documented as (VD3)) was too narrow, affecting only class predicates. #21302 demonstrated that this wasn't enough! Fixes #21302. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - b3d6d23d by Andreas Klebinger at 2022-04-07T12:59:12-04:00 Properly explain where INLINE pragmas can appear. Fixes #20676 - - - - - 23ef62b3 by Ben Gamari at 2022-04-07T14:28:28-04:00 rts: Fix off-by-one in snwprintf usage - - - - - b2dbcc7d by Simon Jakobi at 2022-04-08T03:00:38-04:00 Improve seq[D]VarSet Previously, the use of size[D]VarSet would involve a traversal of the entire underlying IntMap. Since IntMaps are already spine-strict, this is unnecessary. - - - - - 64ac20a7 by sheaf at 2022-04-08T03:01:16-04:00 Add test for #21338 This no-skolem-info bug was fixed by the no-skolem-info patch that will be part of GHC 9.4. This patch adds a regression test for the issue reported in issue #21338. Fixes #21338. - - - - - c32c4db6 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 56f85d62 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - cb1f31f5 by Ben Gamari at 2022-04-08T03:01:53-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - c44432db by Krzysztof Gogolewski at 2022-04-08T03:02:29-04:00 Fixes to 9.4 release notes - Mention -Wforall-identifier - Improve description of withDict - Fix formatting - - - - - 777365f1 by sheaf at 2022-04-08T09:43:35-04:00 Correctly report SrcLoc of redundant constraints We were accidentally dropping the source location information in certain circumstances when reporting redundant constraints. This patch makes sure that we set the TcLclEnv correctly before reporting the warning. Fixes #21315 - - - - - af300a43 by Vladislav Zavialov at 2022-04-08T09:44:11-04:00 Reject illegal quote mark in data con declarations (#17865) * Non-fatal (i.e. recoverable) parse error * Checking infix constructors * Extended the regression test - - - - - 56254e6b by Ben Gamari at 2022-04-08T09:59:46-04:00 Merge remote-tracking branch 'origin/master' - - - - - 6e2c3b7c by Matthew Pickering at 2022-04-08T13:55:15-04:00 driver: Introduce HomeModInfoCache abstraction The HomeModInfoCache is a mutable cache which is updated incrementally as the driver completes, this makes it robust to exceptions including (SIGINT) The interface for the cache is described by the `HomeMOdInfoCache` data type: ``` data HomeModInfoCache = HomeModInfoCache { hmi_clearCache :: IO [HomeModInfo] , hmi_addToCache :: HomeModInfo -> IO () } ``` The first operation clears the cache and returns its contents. This is designed so it's harder to end up in situations where the cache is retained throughout the execution of upsweep. The second operation allows a module to be added to the cache. The one slightly nasty part is in `interpretBuildPlan` where we have to be careful to ensure that the cache writes happen: 1. In parralel 2. Before the executation continues after upsweep. This requires some simple, localised MVar wrangling. Fixes #20780 - - - - - 85f4a3c9 by Andreas Klebinger at 2022-04-08T13:55:50-04:00 Add flag -fprof-manual which controls if GHC should honour manual cost centres. This allows disabling of manual control centres in code a user doesn't control like libraries. Fixes #18867 - - - - - 3415981c by Vladislav Zavialov at 2022-04-08T13:56:27-04:00 HsUniToken for :: in GADT constructors (#19623) One more step towards the new design of EPA. Updates the haddock submodule. - - - - - 23f95735 by sheaf at 2022-04-08T13:57:07-04:00 Docs: datacon eta-expansion, rep-poly checks The existing notes weren't very clear on how the eta-expansion of data constructors that occurs in tcInferDataCon/dsConLike interacts with the representation polymorphism invariants. So we explain with a few more details how we ensure that the representation-polymorphic lambdas introduced by tcInferDataCon/dsConLike don't end up causing problems, by checking they are properly instantiated and then relying on the simple optimiser to perform beta reduction. A few additional changes: - ConLikeTc just take type variables instead of binders, as we never actually used the binders. - Removed the FRRApp constructor of FRROrigin; it was no longer used now that we use ExpectedFunTyOrigin. - Adds a bit of documentation to the constructors of ExpectedFunTyOrigin. - - - - - d4480490 by Matthew Pickering at 2022-04-08T13:57:43-04:00 ci: Replace "always" with "on_success" to stop build jobs running before hadrian-ghci has finished See https://docs.gitlab.com/ee/ci/yaml/#when * always means, always run not matter what * on_success means, run if the dependencies have built successfully - - - - - 0736e949 by Vladislav Zavialov at 2022-04-08T13:58:19-04:00 Disallow (->) as a data constructor name (#16999) The code was misusing isLexCon, which was never meant for validation. In fact, its documentation states the following: Use these functions to figure what kind of name a 'FastString' represents; these functions do /not/ check that the identifier is valid. Ha! This sign can't stop me because I can't read. The fix is to use okConOcc instead. The other checks (isTcOcc or isDataOcc) seem superfluous, so I also removed those. - - - - - e58d5eeb by Simon Peyton Jones at 2022-04-08T13:58:55-04:00 Tiny documentation wibble This commit commit 83363c8b04837ee871a304cf85207cf79b299fb0 Author: Simon Peyton Jones <simon.peytonjones at gmail.com> Date: Fri Mar 11 16:55:38 2022 +0000 Use prepareBinding in tryCastWorkerWrapper refactored completeNonRecX away, but left a Note referring to it. This MR fixes that Note. - - - - - 4bb00839 by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Fix nightly head.hackage pipelines This also needs a corresponding commit to head.hackage, I also made the job explicitly depend on the fedora33 job so that it isn't blocked by a failing windows job, which causes docs-tarball to fail. - - - - - 3c48e12a by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Remove doc-tarball dependency from perf and perf-nofib jobs These don't depend on the contents of the tarball so we can run them straight after the fedora33 job finishes. - - - - - 27362265 by Matthew Pickering at 2022-04-09T07:41:04-04:00 Bump deepseq to 1.4.7.0 Updates deepseq submodule Fixes #20653 - - - - - dcf30da8 by Joachim Breitner at 2022-04-09T13:02:19-04:00 Drop the app invariant previously, GHC had the "let/app-invariant" which said that the RHS of a let or the argument of an application must be of lifted type or ok for speculation. We want this on let to freely float them around, and we wanted that on app to freely convert between the two (e.g. in beta-reduction or inlining). However, the app invariant meant that simple code didn't stay simple and this got in the way of rules matching. By removing the app invariant, this thus fixes #20554. The new invariant is now called "let-can-float invariant", which is hopefully easier to guess its meaning correctly. Dropping the app invariant means that everywhere where we effectively do beta-reduction (in the two simplifiers, but also in `exprIsConApp_maybe` and other innocent looking places) we now have to check if the argument must be evaluated (unlifted and side-effecting), and analyses have to be adjusted to the new semantics of `App`. Also, `LetFloats` in the simplifier can now also carry such non-floating bindings. The fix for DmdAnal, refine by Sebastian, makes functions with unlifted arguments strict in these arguments, which changes some signatures. This causes some extra calls to `exprType` and `exprOkForSpeculation`, so some perf benchmarks regress a bit (while others improve). Metric Decrease: T9020 Metric Increase: LargeRecord T12545 T15164 T16577 T18223 T5642 T9961 Co-authored-by: Sebastian Graf <sebastian.graf at kit.edu> - - - - - 6c6c5379 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add functions traceWith, traceShowWith, traceEventWith. As discussed at https://github.com/haskell/core-libraries-committee/issues/36 - - - - - 8fafacf7 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add tests for several trace functions. - - - - - 20bbf3ac by Philip Hazelden at 2022-04-09T13:02:59-04:00 Update changelog. - - - - - 47d18b0b by Andreas Klebinger at 2022-04-09T13:03:35-04:00 Add regression test for #19569 - - - - - 5f8d6e65 by sheaf at 2022-04-09T13:04:14-04:00 Fix missing SymCo in pushCoercionIntoLambda There was a missing SymCo in pushCoercionIntoLambda. Currently this codepath is only used with rewrite rules, so this bug managed to slip by, but trying to use pushCoercionIntoLambda in other contexts revealed the bug. - - - - - 20eca489 by Vladislav Zavialov at 2022-04-09T13:04:50-04:00 Refactor: simplify lexing of the dot Before this patch, the lexer did a truly roundabout thing with the dot: 1. look up the varsym in reservedSymsFM and turn it into ITdot 2. under OverloadedRecordDot, turn it into ITvarsym 3. in varsym_(prefix|suffix|...) turn it into ITvarsym, ITdot, or ITproj, depending on extensions and whitespace Turns out, the last step is sufficient to handle the dot correctly. This patch removes the first two steps. - - - - - 5440f63e by Hécate Moonlight at 2022-04-12T11:11:06-04:00 Document that DuplicateRecordFields doesn't tolerates ambiguous fields Fix #19891 - - - - - 0090ad7b by Sebastian Graf at 2022-04-12T11:11:42-04:00 Eta reduction based on evaluation context (#21261) I completely rewrote our Notes surrounding eta-reduction. The new entry point is `Note [Eta reduction makes sense]`. Then I went on to extend the Simplifier to maintain an evaluation context in the form of a `SubDemand` inside a `SimplCont`. That `SubDemand` is useful for doing eta reduction according to `Note [Eta reduction based on evaluation context]`, which describes how Demand analysis, Simplifier and `tryEtaReduce` interact to facilitate eta reduction in more scenarios. Thus we fix #21261. ghc/alloc perf marginally improves (-0.0%). A medium-sized win is when compiling T3064 (-3%). It seems that haddock improves by 0.6% to 1.0%, too. Metric Decrease: T3064 - - - - - 4d2ee313 by Sebastian Graf at 2022-04-12T17:54:57+02:00 Specialising through specialised method calls (#19644) In #19644, we discovered that the ClassOp/DFun rules from Note [ClassOp/DFun selection] inhibit transitive specialisation in a scenario like ``` class C a where m :: Show b => a -> b -> ...; n :: ... instance C Int where m = ... -- $cm :: Show b => Int -> b -> ... f :: forall a b. (C a, Show b) => ... f $dC $dShow = ... m @a $dC @b $dShow ... main = ... f @Int @Bool ... ``` After we specialise `f` for `Int`, we'll see `m @a $dC @b $dShow` in the body of `$sf`. But before this patch, Specialise doesn't apply the ClassOp/DFun rule to rewrite to a call of the instance method for `C Int`, e.g., `$cm @Bool $dShow`. As a result, Specialise couldn't further specialise `$cm` for `Bool`. There's a better example in `Note [Specialisation modulo dictionary selectors]`. This patch enables proper Specialisation, as follows: 1. In the App case of `specExpr`, try to apply the CalssOp/DictSel rule on the head of the application 2. Attach an unfolding to freshly-bound dictionary ids such as `$dC` and `$dShow` in `bindAuxiliaryDict` NB: Without (2), (1) would be pointless, because `lookupRule` wouldn't be able to look into the RHS of `$dC` to see the DFun. (2) triggered #21332, because the Specialiser floats around dictionaries without accounting for them in the `SpecEnv`'s `InScopeSet`, triggering a panic when rewriting dictionary unfoldings. Fixes #19644 and #21332. - - - - - b06f4f47 by Sebastian Graf at 2022-04-12T17:54:58+02:00 Specialise: Check `typeDeterminesValue` before specialising on an interesting dictionary I extracted the checks from `Note [Type determines value]` into its own function, so that we share the logic properly. Then I made sure that we actually call `typeDeterminesValue` everywhere we check for `interestingDict`. - - - - - a42dbc55 by Matthew Pickering at 2022-04-13T06:24:52-04:00 Refine warning about defining rules in SAFE modules This change makes it clear that it's the definition rather than any usage which is a problem, and that rules defined in other modules will still be used to do rewrites. Fixes #20923 - - - - - df893f66 by Andreas Klebinger at 2022-04-14T08:18:37-04:00 StgLint: Lint constructor applications and strict workers for arity. This will mean T9208 when run with lint will return a lint error instead of resulting in a panic. Fixes #21117 - - - - - 426ec446 by sheaf at 2022-04-14T08:19:16-04:00 Hadrian: use a set to keep track of ways The order in which ways are provided doesn't matter, so we use a data structure with the appropriate semantics to represent ways. Fixes #21378 - - - - - 7c639b9a by Dylan Yudaken at 2022-04-15T13:55:59-04:00 Only enable PROF_SPIN in DEBUG - - - - - 96b9e5ea by Ben Gamari at 2022-04-15T13:56:34-04:00 testsuite: Add test for #21390 - - - - - d8392f6a by Ben Gamari at 2022-04-15T13:56:34-04:00 rts: Ensure that the interpreter doesn't disregard tags Previously the interpreter's handling of `RET_BCO` stack frames would throw away the tag of the returned closure. This resulted in #21390. - - - - - 83c67f76 by Alan Zimmerman at 2022-04-20T11:49:28-04:00 Add -dkeep-comments flag to keep comments in the parser This provides a way to set the Opt_KeepRawTokenStream from the command line, allowing exact print annotation users to see exactly what is produced for a given parsed file, when used in conjunction with -ddump-parsed-ast Discussed in #19706, but this commit does not close the issue. - - - - - a5ea65c9 by Krzysztof Gogolewski at 2022-04-20T11:50:04-04:00 Remove LevityInfo Every Id was storing a boolean whether it could be levity-polymorphic. This information is no longer needed since representation-checking has been moved to the typechecker. - - - - - 49bd7584 by Andreas Klebinger at 2022-04-20T11:50:39-04:00 Fix a shadowing issue in StgUnarise. For I assume performance reasons we don't record no-op replacements during unarise. This lead to problems with code like this: f = \(Eta_B0 :: VoidType) x1 x2 -> ... let foo = \(Eta_B0 :: LiftedType) -> g x y Eta_B0 in ... Here we would record the outer Eta_B0 as void rep, but would not shadow Eta_B0 inside `foo` because this arg is single-rep and so doesn't need to replaced. But this means when looking at occurence sites we would check the env and assume it's void rep based on the entry we made for the (no longer in scope) outer `Eta_B0`. Fixes #21396 and the ticket has a few more details. - - - - - 0c02c919 by Simon Peyton Jones at 2022-04-20T11:51:15-04:00 Fix substitution in bindAuxiliaryDict In GHC.Core.Opt.Specialise.bindAuxiliaryDict we were unnecessarily calling `extendInScope` to bring into scope variables that were /already/ in scope. Worse, GHC.Core.Subst.extendInScope strangely deleted the newly-in-scope variables from the substitution -- and that was fatal in #21391. I removed the redundant calls to extendInScope. More ambitiously, I changed GHC.Core.Subst.extendInScope (and cousins) to stop deleting variables from the substitution. I even changed the names of the function to extendSubstInScope (and cousins) and audited all the calls to check that deleting from the substitution was wrong. In fact there are very few such calls, and they are all about introducing a fresh non-in-scope variable. These are "OutIds"; it is utterly wrong to mess with the "InId" substitution. I have not added a Note, because I'm deleting wrong code, and it'd be distracting to document a bug. - - - - - 0481a6af by Cheng Shao at 2022-04-21T11:06:06+00:00 [ci skip] Drop outdated TODO in RtsAPI.c - - - - - 1e062a8a by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Introduce ip_STACK_FRAME While debugging it is very useful to be able to determine whether a given info table is a stack frame or not. We have spare bits in the closure flags array anyways, use one for this information. - - - - - 08a6a2ee by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Mark closureFlags array as const - - - - - 8f9b8282 by Krzysztof Gogolewski at 2022-04-22T02:13:35-04:00 Check for zero-bit types in sizeExpr Fixes #20940 Metric Decrease: T18698a - - - - - fcf22883 by Andreas Klebinger at 2022-04-22T02:14:10-04:00 Include the way string in the file name for dump files. This can be disabled by `-fno-dump-with-ways` if not desired. Finally we will be able to look at both profiled and non-profiled dumps when compiling with dump flags and we compile in both ways. - - - - - 252394ce by Bodigrim at 2022-04-22T02:14:48-04:00 Improve error messages from GHC.IO.Encoding.Failure - - - - - 250f57c1 by Bodigrim at 2022-04-22T02:14:48-04:00 Update test baselines to match new error messages from GHC.IO.Encoding.Failure - - - - - 5ac9b321 by Ben Gamari at 2022-04-22T02:15:25-04:00 get-win32-tarballs: Drop i686 architecture As of #18487 we no longer support 32-bit Windows. Fixes #21372. - - - - - dd5fecb0 by Ben Gamari at 2022-04-22T02:16:00-04:00 hadrian: Don't rely on xxx not being present in installation path Previously Hadrian's installation makefile would assume that the string `xxx` did not appear in the installation path. This would of course break for some users. Fixes #21402. - - - - - 09e98859 by Ben Gamari at 2022-04-22T02:16:35-04:00 testsuite: Ensure that GHC doesn't pick up environment files Here we set GHC_ENVIRONMENT="-" to ensure that GHC invocations of tests don't pick up a user's local package environment. Fixes #21365. Metric Decrease: T10421 T12234 T12425 T13035 T16875 T9198 - - - - - 76bb8cb3 by Ben Gamari at 2022-04-22T02:17:11-04:00 hadrian: Enable -dlint in devel2 flavour Previously only -dcore-lint was enabled. - - - - - f435d55f by Krzysztof Gogolewski at 2022-04-22T08:00:18-04:00 Fixes to rubbish literals * In CoreToStg, the application 'RUBBISH[rep] x' was simplified to 'RUBBISH[rep]'. But it is possible that the result of the function is represented differently than the function. * In Unarise, 'LitRubbish (primRepToType prep)' is incorrect: LitRubbish takes a RuntimeRep such as IntRep, while primRepToType returns a type such as Any @(TYPE IntRep). Use primRepToRuntimeRep instead. This code is never run in the testsuite. * In StgToByteCode, all rubbish literals were assumed to be boxed. This code predates representation-polymorphic RubbishLit and I think it was not updated. I don't have a testcase for any of those issues, but the code looks wrong. - - - - - 93c16b94 by sheaf at 2022-04-22T08:00:57-04:00 Relax "suppressing errors" assert in reportWanteds The assertion in reportWanteds that we aren't suppressing all the Wanted constraints was too strong: it might be the case that we are inside an implication, and have already reported an unsolved Wanted from outside the implication. It is possible that all Wanteds inside the implication have been rewritten by the outer Wanted, so we shouldn't throw an assertion failure in that case. Fixes #21405 - - - - - 78ec692d by Andreas Klebinger at 2022-04-22T08:01:33-04:00 Mention new MutableByteArray# wrapper in base changelog. - - - - - 56d7cb53 by Eric Lindblad at 2022-04-22T14:13:32-04:00 unlist announce - - - - - 1e4dcf23 by sheaf at 2022-04-22T14:14:12-04:00 decideMonoTyVars: account for CoVars in candidates The "candidates" passed to decideMonoTyVars can contain coercion holes. This is because we might well decide to quantify over some unsolved equality constraints, as long as they are not definitely insoluble. In that situation, decideMonoTyVars was passing a set of type variables that was not closed over kinds to closeWrtFunDeps, which was tripping up an assertion failure. Fixes #21404 - - - - - 2c541f99 by Simon Peyton Jones at 2022-04-22T14:14:47-04:00 Improve floated dicts in Specialise Second fix to #21391. It turned out that we missed calling bringFloatedDictsIntoScope when specialising imports, which led to the same bug as before. I refactored to move that call to a single place, in specCalls, so we can't forget it. This meant making `FloatedDictBinds` into its own type, pairing the dictionary bindings themselves with the set of their binders. Nicer this way. - - - - - 0950e2c4 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Ensure that --extra-lib-dirs are used Previously we only took `extraLibDirs` and friends from the package description, ignoring any contribution from the `LocalBuildInfo`. Fix this. Fixes #20566. - - - - - 53cc93ae by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Drop redundant include directories The package-specific include directories in Settings.Builders.Common.cIncludeDirs are now redundant since they now come from Cabal. Closes #20566. - - - - - b2721819 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Clean up handling of libffi dependencies - - - - - 18e5103f by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: More robust library way detection Previously `test.mk` would try to determine whether the dynamic, profiling, and vanilla library ways are available by searching for `PrimOpWrappers.{,dyn_,p_}hi` in directory reported by `ghc-pkg field ghc-prim library-dirs`. However, this is extremely fragile as there is no guarantee that there is only one library directory. To handle the case of multiple `library-dirs` correct we would have to carry out the delicate task of tokenising the directory list (in shell, no less). Since this isn't a task that I am eager to solve, I have rather moved the detection logic into the testsuite driver and instead perform a test compilation in each of the ways. This should be more robust than the previous approach. I stumbled upon this while fixing #20579. - - - - - 6c7a4913 by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: Cabalify ghc-config To ensure that the build benefits from Hadrian's usual logic for building packages, avoiding #21409. Closes #21409. - - - - - 9af091f7 by Ben Gamari at 2022-04-25T10:18:53-04:00 rts: Factor out built-in GC roots - - - - - e7c4719d by Ben Gamari at 2022-04-25T10:18:54-04:00 Ensure that wired-in exception closures aren't GC'd As described in Note [Wired-in exceptions are not CAFfy], a small set of built-in exception closures get special treatment in the code generator, being declared as non-CAFfy despite potentially containing CAF references. The original intent of this treatment for the RTS to then add StablePtrs for each of the closures, ensuring that they are not GC'd. However, this logic was not applied consistently and eventually removed entirely in 951c1fb0. This lead to #21141. Here we fix this bug by reintroducing the StablePtrs and document the status quo. Closes #21141. - - - - - 9587726f by Ben Gamari at 2022-04-25T10:18:54-04:00 testsuite: Add testcase for #21141 - - - - - cb71226f by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop dead code in GHC.Linker.Static.linkBinary' Previously we supported building statically-linked executables using libtool. However, this was dropped in 91262e75dd1d80f8f28a3922934ec7e59290e28c in favor of using ar/ranlib directly. Consequently we can drop this logic. Fixes #18826. - - - - - 9420d26b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop libtool path from settings file GHC no longers uses libtool for linking and therefore this is no longer necessary. - - - - - 41cf758b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop remaining vestiges of libtool Drop libtool logic from gen-dll, allowing us to drop the remaining logic from the `configure` script. Strangely, this appears to reliably reduce compiler allocations of T16875 on Windows. Closes #18826. Metric Decrease: T16875 - - - - - e09afbf2 by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - e76705cf by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Improve documentation of closure types Also drops the unused TREC_COMMITTED transaction state. - - - - - f2c08124 by Bodigrim at 2022-04-25T10:20:44-04:00 Document behaviour of RULES with KnownNat - - - - - 360dc2bc by Li-yao Xia at 2022-04-25T19:13:06+00:00 Fix rendering of liftA haddock - - - - - 16df6058 by Ben Gamari at 2022-04-27T10:02:25-04:00 testsuite: Report minimum and maximum stat changes As suggested in #20733. - - - - - e39cab62 by Fabian Thorand at 2022-04-27T10:03:03-04:00 Defer freeing of mega block groups Solves the quadratic worst case performance of freeing megablocks that was described in issue #19897. During GC runs, we now keep a secondary free list for megablocks that is neither sorted, nor coalesced. That way, free becomes an O(1) operation at the expense of not being able to reuse memory for larger allocations. At the end of a GC run, the secondary free list is sorted and then merged into the actual free list in a single pass. That way, our worst case performance is O(n log(n)) rather than O(n^2). We postulate that temporarily losing coalescense during a single GC run won't have any adverse effects in practice because: - We would need to release enough memory during the GC, and then after that (but within the same GC run) allocate a megablock group of more than one megablock. This seems unlikely, as large objects are not copied during GC, and so we shouldn't need such large allocations during a GC run. - Allocations of megablock groups of more than one megablock are rare. They only happen when a single heap object is large enough to require that amount of space. Any allocation areas that are supposed to hold more than one heap object cannot use megablock groups, because only the first megablock of a megablock group has valid `bdescr`s. Thus, heap object can only start in the first megablock of a group, not in later ones. - - - - - 5de6be0c by Fabian Thorand at 2022-04-27T10:03:03-04:00 Add note about inefficiency in returnMemoryToOS - - - - - 8bef471a by sheaf at 2022-04-27T10:03:43-04:00 Ensure that Any is Boxed in FFI imports/exports We should only accept the type `Any` in foreign import/export declarations when it has type `Type` or `UnliftedType`. This patch adds a kind check, and a special error message triggered by occurrences of `Any` in foreign import/export declarations at other kinds. Fixes #21305 - - - - - ba3d4e1c by Ben Gamari at 2022-04-27T10:04:19-04:00 Basic response file support Here we introduce support into our command-line parsing infrastructure and driver for handling gnu-style response file arguments, typically used to work around platform command-line length limitations. Fixes #16476. - - - - - 3b6061be by Ben Gamari at 2022-04-27T10:04:19-04:00 testsuite: Add test for #16476 - - - - - 75bf1337 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix cabal-reinstall job It's quite nice we can do this by mostly deleting code Fixes #21373 - - - - - 2c00d904 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add test to check that release jobs have profiled libs - - - - - 50d78d3b by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Explicitly handle failures in test_hadrian We also disable the stage1 testing which is broken. Related to #21072 - - - - - 2dcdf091 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix shell command - - - - - 55c84123 by Matthew Pickering at 2022-04-27T10:04:55-04:00 bootstrap: Add bootstrapping files for ghc-9_2_2 Fixes #21373 - - - - - c7ee0be6 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add linting job which checks authors are not GHC CI - - - - - 23aad124 by Adam Sandberg Ericsson at 2022-04-27T10:05:31-04:00 rts: state explicitly what evacuate and scavange mean in the copying gc - - - - - 318e0005 by Ben Gamari at 2022-04-27T10:06:07-04:00 rts/eventlog: Don't attempt to flush if there is no writer If the user has not configured a writer then there is nothing to flush. - - - - - ee11d043 by Ben Gamari at 2022-04-27T10:06:07-04:00 Enable eventlog support in all ways by default Here we deprecate the eventlogging RTS ways and instead enable eventlog support in the remaining ways. This simplifies packaging and reduces GHC compilation times (as we can eliminate two whole compilations of the RTS) while simplifying the end-user story. The trade-off is a small increase in binary sizes in the case that the user does not want eventlogging support, but we think that this is a fine trade-off. This also revealed a latent RTS bug: some files which included `Cmm.h` also assumed that it defined various macros which were in fact defined by `Config.h`, which `Cmm.h` did not include. Fixing this in turn revealed that `StgMiscClosures.cmm` failed to import various spinlock statistics counters, as evidenced by the failed unregisterised build. Closes #18948. - - - - - a2e5ab70 by Andreas Klebinger at 2022-04-27T10:06:43-04:00 Change `-dsuppress-ticks` to only suppress non-code ticks. This means cost centres and coverage ticks will still be present in output. Makes using -dsuppress-all more convenient when looking at profiled builds. - - - - - ec9d7e04 by Ben Gamari at 2022-04-27T10:07:21-04:00 Bump text submodule. This should fix #21352 - - - - - c3105be4 by Bodigrim at 2022-04-27T10:08:01-04:00 Documentation for setLocaleEncoding - - - - - 7f618fd3 by sheaf at 2022-04-27T10:08:40-04:00 Update docs for change to type-checking plugins There was no mention of the changes to type-checking plugins in the 9.4.1 notes, and the extending_ghc documentation contained a reference to an outdated type. - - - - - 4419dd3a by Adam Sandberg Ericsson at 2022-04-27T10:09:18-04:00 rts: add some more documentation to StgWeak closure type - - - - - 5a7f0dee by Matthew Pickering at 2022-04-27T10:09:54-04:00 Give Cmm files fake ModuleNames which include full filepath This fixes the initialisation functions when using -prof or -finfo-table-map. Fixes #21370 - - - - - 81cf52bb by sheaf at 2022-04-27T10:10:33-04:00 Mark GHC.Prim.PtrEq as Unsafe This module exports unsafe pointer equality operations, so we accordingly mark it as Unsafe. Fixes #21433 - - - - - f6a8185d by Ben Gamari at 2022-04-28T09:10:31+00:00 testsuite: Add performance test for #14766 This distills the essence of the Sigs.hs program found in the ticket. - - - - - c7a3dc29 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Add Monoid instance to Way - - - - - 654bafea by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Enrich flavours to build profiled/debugged/threaded ghcs per stage - - - - - 4ad559c8 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: add debug_ghc and debug_stage1_ghc flavour transformers - - - - - f9728fdb by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Don't pass -rtsopts when building libraries - - - - - 769279e6 by Matthew Pickering at 2022-04-28T18:54:44-04:00 testsuite: Fix calculation about whether to pass -dynamic to compiler - - - - - da8ae7f2 by Ben Gamari at 2022-04-28T18:55:20-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 61305184 by Ben Gamari at 2022-04-28T18:55:56-04:00 Bump process submodule - - - - - a8c99391 by sheaf at 2022-04-28T18:56:37-04:00 Fix unification of ConcreteTvs, removing IsRefl# This patch fixes the unification of concrete type variables. The subtlety was that unifying concrete metavariables is more subtle than other metavariables, as decomposition is possible. See the Note [Unifying concrete metavariables], which explains how we unify a concrete type variable with a type 'ty' by concretising 'ty', using the function 'GHC.Tc.Utils.Concrete.concretise'. This can be used to perform an eager syntactic check for concreteness, allowing us to remove the IsRefl# special predicate. Instead of emitting two constraints `rr ~# concrete_tv` and `IsRefl# rr concrete_tv`, we instead concretise 'rr'. If this succeeds we can fill 'concrete_tv', and otherwise we directly emit an error message to the typechecker environment instead of deferring. We still need the error message to be passed on (instead of directly thrown), as we might benefit from further unification in which case we will need to zonk the stored types. To achieve this, we change the 'wc_holes' field of 'WantedConstraints' to 'wc_errors', which stores general delayed errors. For the moement, a delayed error is either a hole, or a syntactic equality error. hasFixedRuntimeRep_MustBeRefl is now hasFixedRuntimeRep_syntactic, and hasFixedRuntimeRep has been refactored to directly return the most useful coercion for PHASE 2 of FixedRuntimeRep. This patch also adds a field ir_frr to the InferResult datatype, holding a value of type Maybe FRROrigin. When this value is not Nothing, this means that we must fill the ir_ref field with a type which has a fixed RuntimeRep. When it comes time to fill such an ExpType, we ensure that the type has a fixed RuntimeRep by performing a representation-polymorphism check with the given FRROrigin This is similar to what we already do to ensure we fill an Infer ExpType with a type of the correct TcLevel. This allows us to properly perform representation-polymorphism checks on 'Infer' 'ExpTypes'. The fillInferResult function had to be moved to GHC.Tc.Utils.Unify to avoid a cyclic import now that it calls hasFixedRuntimeRep. This patch also changes the code in matchExpectedFunTys to make use of the coercions, which is now possible thanks to the previous change. This implements PHASE 2 of FixedRuntimeRep in some situations. For example, the test cases T13105 and T17536b are now both accepted. Fixes #21239 and #21325 ------------------------- Metric Decrease: T18223 T5631 ------------------------- - - - - - 43bd897d by Simon Peyton Jones at 2022-04-28T18:57:13-04:00 Add INLINE pragmas for Enum helper methods As #21343 showed, we need to be super-certain that the "helper methods" for Enum instances are actually inlined or specialised. I also tripped over this when I discovered that numericEnumFromTo and friends had no pragmas at all, so their performance was very fragile. If they weren't inlined, all bets were off. So I've added INLINE pragmas for them too. See new Note [Inline Enum method helpers] in GHC.Enum. I also expanded Note [Checking for INLINE loop breakers] in GHC.Core.Lint to explain why an INLINE function might temporarily be a loop breaker -- this was the initial bug report in #21343. Strangely we get a 16% runtime allocation decrease in perf/should_run/T15185, but only on i386. Since it moves in the right direction I'm disinclined to investigate, so I'll accept it. Metric Decrease: T15185 - - - - - ca1434e3 by Ben Gamari at 2022-04-28T18:57:49-04:00 configure: Bump GHC version to 9.5 Bumps haddock submodule. - - - - - 292e3971 by Teo Camarasu at 2022-04-28T18:58:28-04:00 add since annotation for GHC.Stack.CCS.whereFrom - - - - - 905206d6 by Tamar Christina at 2022-04-28T22:19:34-04:00 winio: add support to iserv. - - - - - d182897e by Tamar Christina at 2022-04-28T22:19:34-04:00 Remove unused line - - - - - 22cf4698 by Matthew Pickering at 2022-04-28T22:20:10-04:00 Revert "rts: Refactor handling of dead threads' stacks" This reverts commit e09afbf2a998beea7783e3de5dce5dd3c6ff23db. - - - - - 8ed57135 by Matthew Pickering at 2022-04-29T04:11:29-04:00 Provide efficient unionMG function for combining two module graphs. This function is used by API clients (hls). This supercedes !6922 - - - - - 0235ff02 by Ben Gamari at 2022-04-29T04:12:05-04:00 Bump bytestring submodule Update to current `master`. - - - - - 01988418 by Matthew Pickering at 2022-04-29T04:12:05-04:00 testsuite: Normalise package versions in UnusedPackages test - - - - - 724d0dc0 by Matthew Pickering at 2022-04-29T08:59:42+00:00 testsuite: Deduplicate ways correctly This was leading to a bug where we would run a profasm test twice which led to invalid junit.xml which meant the test results database was not being populated for the fedora33-perf job. - - - - - 5630dde6 by Ben Gamari at 2022-04-29T13:06:20-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - 0cdef807 by parsonsmatt at 2022-04-30T16:51:12-04:00 Add a note about instance visibility across component boundaries In principle, the *visible* instances are * all instances defined in a prior top-level declaration group (see docs on `newDeclarationGroup`), or * all instances defined in any module transitively imported by the module being compiled However, actually searching all modules transitively below the one being compiled is unreasonably expensive, so `reifyInstances` will report only the instance for modules that GHC has had some cause to visit during this compilation. This is a shortcoming: `reifyInstances` might fail to report instances for a type that is otherwise unusued, or instances defined in a different component. You can work around this shortcoming by explicitly importing the modules whose instances you want to be visible. GHC issue #20529 has some discussion around this. Fixes #20529 - - - - - e2dd884a by Ryan Scott at 2022-04-30T16:51:47-04:00 Make mkFunCo take AnonArgFlags into account Previously, whenever `mkFunCo` would produce reflexive coercions, it would use `mkVisFunTy` to produce the kind of the coercion. However, `mkFunCo` is also used to produce coercions between types of the form `ty1 => ty2` in certain places. This has the unfortunate side effect of causing the type of the coercion to appear as `ty1 -> ty2` in certain error messages, as spotted in #21328. This patch address this by changing replacing the use of `mkVisFunTy` with `mkFunctionType` in `mkFunCo`. `mkFunctionType` checks the kind of `ty1` and makes the function arrow `=>` instead of `->` if `ty1` has kind `Constraint`, so this should always produce the correct `AnonArgFlag`. As a result, this patch fixes part (2) of #21328. This is not the only possible way to fix #21328, as the discussion on that issue lists some possible alternatives. Ultimately, it was concluded that the alternatives would be difficult to maintain, and since we already use `mkFunctionType` in `coercionLKind` and `coercionRKind`, using `mkFunctionType` in `mkFunCo` is consistent with this choice. Moreover, using `mkFunctionType` does not regress the performance of any test case we have in GHC's test suite. - - - - - 170da54f by Ben Gamari at 2022-04-30T16:52:27-04:00 Convert More Diagnostics (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors. - - - - - 39edc7b4 by Marius Ghita at 2022-04-30T16:53:06-04:00 Update user guide example rewrite rules formatting Change the rewrite rule examples to include a space between the composition of `f` and `g` in the map rewrite rule examples. Without this change, if the user has locally enabled the extension OverloadedRecordDot the copied example will result in a compile time error that `g` is not a field of `f`. ``` • Could not deduce (GHC.Records.HasField "g" (a -> b) (a1 -> b)) arising from selecting the field ‘g’ ``` - - - - - 2e951e48 by Adam Sandberg Ericsson at 2022-04-30T16:53:42-04:00 ghc-boot: export typesynonyms from GHC.Utils.Encoding This makes the Haddocks easier to understand. - - - - - d8cbc77e by Adam Sandberg Ericsson at 2022-04-30T16:54:18-04:00 users guide: add categories to some flags - - - - - d0f14fad by Chris Martin at 2022-04-30T16:54:57-04:00 hacking guide: mention the core libraries committee - - - - - 34b28200 by Matthew Pickering at 2022-04-30T16:55:32-04:00 Revert "Make the specialiser handle polymorphic specialisation" This reverts commit ef0135934fe32da5b5bb730dbce74262e23e72e8. See ticket #21229 ------------------------- Metric Decrease: T15164 Metric Increase: T13056 ------------------------- - - - - - ee891c1e by Matthew Pickering at 2022-04-30T16:55:32-04:00 Add test for T21229 - - - - - ab677cc8 by Matthew Pickering at 2022-04-30T16:56:08-04:00 Hadrian: Update README about the flavour/testsuite contract There have been a number of tickets about non-tested flavours not passing the testsuite.. this is expected and now noted in the documentation. You use other flavours to run the testsuite at your own risk. Fixes #21418 - - - - - b57b5b92 by Ben Gamari at 2022-04-30T16:56:44-04:00 rts/m32: Fix assertion failure This fixes an assertion failure in the m32 allocator due to the imprecisely specified preconditions of `m32_allocator_push_filled_list`. Specifically, the caller must ensure that the page type is set to filled prior to calling `m32_allocator_push_filled_list`. While this issue did result in an assertion failure in the debug RTS, the issue is in fact benign. - - - - - a7053a6c by sheaf at 2022-04-30T16:57:23-04:00 Testsuite driver: don't crash on empty metrics The testsuite driver crashed when trying to display minimum/maximum performance changes when there are no metrics (i.e. there is no baseline available). This patch fixes that. - - - - - 636f7c62 by Andreas Klebinger at 2022-05-01T22:21:17-04:00 StgLint: Check that functions are applied to compatible runtime reps We use compatibleRep to compare reps, and avoid checking functions with levity polymorphic types because of #21399. - - - - - 60071076 by Hécate Moonlight at 2022-05-01T22:21:55-04:00 Add documentation to the ByteArray# primetype. close #21417 - - - - - 2b2e3020 by Andreas Klebinger at 2022-05-01T22:22:31-04:00 exprIsDeadEnd: Use isDeadEndAppSig to check if a function appliction is bottoming. We used to check the divergence and that the number of arguments > arity. But arity zero represents unknown arity so this was subtly broken for a long time! We would check if the saturated function diverges, and if we applied >=arity arguments. But for unknown arity functions any number of arguments is >=idArity. This fixes #21440. - - - - - 4eaf0f33 by Eric Lindblad at 2022-05-01T22:23:11-04:00 typos - - - - - fc58df90 by Niklas Hambüchen at 2022-05-02T08:59:27+00:00 libraries/base: docs: Explain relationshipt between `finalizeForeignPtr` and `*Conc*` creation Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/21420 - - - - - 3e400f20 by Krzysztof Gogolewski at 2022-05-02T18:29:23-04:00 Remove obsolete code in CoreToStg Note [Nullary unboxed tuple] was removed in e9e61f18a548b70693f4. This codepath is tested by T15696_3. - - - - - 4a780928 by Krzysztof Gogolewski at 2022-05-02T18:29:24-04:00 Fix several note references - - - - - 15ffe2b0 by Sebastian Graf at 2022-05-03T20:11:51+02:00 Assume at least one evaluation for nested SubDemands (#21081, #21133) See the new `Note [SubDemand denotes at least one evaluation]`. A demand `n :* sd` on a let binder `x=e` now means > "`x` was evaluated `n` times and in any program trace it is evaluated, `e` is > evaluated deeply in sub-demand `sd`." The "any time it is evaluated" premise is what this patch adds. As a result, we get better nested strictness. For example (T21081) ```hs f :: (Bool, Bool) -> (Bool, Bool) f pr = (case pr of (a,b) -> a /= b, True) -- before: <MP(L,L)> -- after: <MP(SL,SL)> g :: Int -> (Bool, Bool) g x = let y = let z = odd x in (z,z) in f y ``` The change in demand signature "before" to "after" allows us to case-bind `z` here. Similarly good things happen for the `sd` in call sub-demands `Cn(sd)`, which allows for more eta-reduction (which is only sound with `-fno-pedantic-bottoms`, albeit). We also fix #21085, a surprising inconsistency with `Poly` to `Call` sub-demand expansion. In an attempt to fix a regression caused by less inlining due to eta-reduction in T15426, I eta-expanded the definition of `elemIndex` and `elemIndices`, thus fixing #21345 on the go. The main point of this patch is that it fixes #21081 and #21133. Annoyingly, I discovered that more precise demand signatures for join points can transform a program into a lazier program if that join point gets floated to the top-level, see #21392. There is no simple fix at the moment, but !5349 might. Thus, we accept a ~5% regression in `MultiLayerModulesTH_OneShot`, where #21392 bites us in `addListToUniqDSet`. T21392 reliably reproduces the issue. Surprisingly, ghc/alloc perf on Windows improves much more than on other jobs, by 0.4% in the geometric mean and by 2% in T16875. Metric Increase: MultiLayerModulesTH_OneShot Metric Decrease: T16875 - - - - - 948c7e40 by Andreas Klebinger at 2022-05-04T09:57:34-04:00 CoreLint - When checking for levity polymorphism look through more ticks. For expressions like `(scc<cc_name> primOp#) arg1` we should also look at arg1 to determine if we call primOp# at a fixed runtime rep. This is what corePrep already does but CoreLint didn't yet. This patch will bring them in sync in this regard. It also uses tickishFloatable in CorePrep instead of CorePrep having it's own slightly differing definition of when a tick is floatable. - - - - - 85bc73bd by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Support Unicode properly - - - - - 063d485e by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Replace LaTeX documentation syntax with Haddock The LaTeX documentation generator does not seem to have been used for quite some time, so the LaTeX-to-Haddock preprocessing step has become a pointless complication that makes documenting the contents of GHC.Prim needlessly difficult. This commit replaces the LaTeX syntax with the Haddock it would have been converted into, anyway, though with an additional distinction: it uses single quotes in places to instruct Haddock to generate hyperlinks to bindings. This improves the quality of the generated output. - - - - - d61f7428 by Ben Gamari at 2022-05-04T09:58:50-04:00 rts/ghc.mk: Only build StgCRunAsm.S when it is needed Previously the make build system unconditionally included StgCRunAsm.S in the link, meaning that the RTS would require an execstack unnecessarily. Fixes #21478. - - - - - 934a90dd by Simon Peyton Jones at 2022-05-04T16:15:34-04:00 Improve error reporting in generated code Our error reporting in generated code (via desugaring before typechecking) only worked when the generated code was just a simple call. This commit makes it work in nested cases. - - - - - 445d3657 by sheaf at 2022-05-04T16:16:12-04:00 Ensure Any is not levity-polymorphic in FFI The previous patch forgot to account for a type such as Any @(TYPE (BoxedRep l)) for a quantified levity variable l. - - - - - ddd2591c by Ben Gamari at 2022-05-04T16:16:48-04:00 Update supported LLVM versions Pull forward minimum version to match 9.2. (cherry picked from commit c26faa54c5fbe902ccb74e79d87e3fa705e270d1) - - - - - f9698d79 by Ben Gamari at 2022-05-04T16:16:48-04:00 testsuite/T7275: Use sed -r Darwin requires the `-r` flag to be compatible with GNU sed. (cherry picked from commit 512338c8feec96c38ef0cf799f3a01b77c967c56) - - - - - 8635323b by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Use ld.lld on ARMv7/Linux Due to #16177. Also cleanup some code style issues. (cherry picked from commit cc1c3861e2372f464bf9e3c9c4d4bd83f275a1a6) - - - - - 4f6370c7 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Always preserve artifacts, even in failed jobs (cherry picked from commit fd08b0c91ea3cab39184f1b1b1aafcd63ce6973f) - - - - - 6f662754 by Ben Gamari at 2022-05-04T16:16:48-04:00 configure: Make sphinx version check more robust It appears that the version of sphinx shipped on CentOS 7 reports a version string of `Sphinx v1...`. Accept the `v`. (cherry picked from commit a9197a292fd4b13308dc6664c01351c7239357ed) - - - - - 0032dc38 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Don't run make job in release pipelines (cherry picked from commit 16d6a8ff011f2194485387dcca1c00f8ddcdbdeb) - - - - - 27f9aab3 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab/ci: Fix name of bootstrap compiler directory Windows binary distributions built with Hadrian have a target platform suffix in the name of their root directory. Teach `ci.sh` about this fact. (cherry picked from commit df5752f39671f6d04d8cd743003469ae5eb67235) - - - - - b528f0f6 by Krzysztof Gogolewski at 2022-05-05T09:05:43-04:00 Fix several note references, part 2 - - - - - 691aacf6 by Adam Sandberg Ericsson at 2022-05-05T09:06:19-04:00 adjustors: align comment about number of integer like arguments with implementation for Amd4+MinGW implementation - - - - - f050557e by Simon Jakobi at 2022-05-05T12:47:32-04:00 Remove two uses of IntMap.size IntMap.size is O(n). The new code should be slightly more efficient. The transformation of GHC.CmmToAsm.CFG.calcFreqs.nodeCount can be described formally as the transformation: (\sum_{0}^{n-1} \sum_{0}^{k-1} i_nk) + n ==> (\sum_{0}^{n-1} 1 + \sum_{0}^{k-1} i_nk) - - - - - 7da90ae3 by Tom Ellis at 2022-05-05T12:48:09-04:00 Explain that 'fail s' should run in the monad itself - - - - - 610d0283 by Matthew Craven at 2022-05-05T12:48:47-04:00 Add a test for the bracketing in rules for (^) - - - - - 016f9ca6 by Matthew Craven at 2022-05-05T12:48:47-04:00 Fix broken rules for (^) with known small powers - - - - - 9372aaab by Matthew Craven at 2022-05-05T12:48:47-04:00 Give the two T19569 tests different names - - - - - 61901b32 by Andreas Klebinger at 2022-05-05T12:49:23-04:00 SpecConstr: Properly create rules for call patterns representing partial applications The main fix is that in addVoidWorkerArg we now add the argument to the front. This fixes #21448. ------------------------- Metric Decrease: T16875 ------------------------- - - - - - 71278dc7 by Teo Camarasu at 2022-05-05T12:50:03-04:00 add since annotations for instances of ByteArray - - - - - 962ff90b by sheaf at 2022-05-05T12:50:42-04:00 Start 9.6.1-notes Updates the documentation notes to start tracking changes for the 9.6.1 release (instead of 9.4). - - - - - aacb15a3 by Matthew Pickering at 2022-05-05T20:24:01-04:00 ci: Add job to check that jobs.yaml is up-to-date There have been quite a few situations where jobs.yaml has been out of date. It's better to add a CI job which checks that it's right. We don't want to use a staged pipeline because it obfuscates the structure of the pipeline. - - - - - be7102e5 by Ben Gamari at 2022-05-05T20:24:37-04:00 rts: Ensure that XMM registers are preserved on Win64 Previously we only preserved the bottom 64-bits of the callee-saved 128-bit XMM registers, in violation of the Win64 calling convention. Fix this. Fixes #21465. - - - - - 73b22ff1 by Ben Gamari at 2022-05-05T20:24:37-04:00 testsuite: Add test for #21465 - - - - - e2ae9518 by Ziyang Liu at 2022-05-06T19:22:22-04:00 Allow `let` just before pure/return in ApplicativeDo The following is currently rejected: ```haskell -- F is an Applicative but not a Monad x :: F (Int, Int) x = do a <- pure 0 let b = 1 pure (a, b) ``` This has bitten me multiple times. This MR contains a simple fix: only allow a "let only" segment to be merged with the next (and not the previous) segment. As a result, when the last one or more statements before pure/return are `LetStmt`s, there will be one more segment containing only those `LetStmt`s. Note that if the `let` statement mentions a name bound previously, then the program is still rejected, for example ```haskell x = do a <- pure 0 let b = a + 1 pure (a, b) ``` or the example in #18559. To support this would require a more complex approach, but this is IME much less common than the previous case. - - - - - 0415449a by Matthew Pickering at 2022-05-06T19:22:58-04:00 template-haskell: Fix representation of OPAQUE pragmas There is a mis-match between the TH representation of OPAQUE pragmas and GHC's internal representation due to how OPAQUE pragmas disallow phase annotations. It seemed most in keeping to just fix the wired in name issue by adding a special case to the desugaring of INLINE pragmas rather than making TH/GHC agree with how the representation should look. Fixes #21463 - - - - - 4de887e2 by Simon Peyton Jones at 2022-05-06T19:23:34-04:00 Comments only: Note [AppCtxt] - - - - - 6e69964d by Matthew Pickering at 2022-05-06T19:24:10-04:00 Fix name of windows release bindist in doc-tarball job - - - - - ced4689e by Matthew Pickering at 2022-05-06T19:24:46-04:00 ci: Generate source-tarball in release jobs We need to distribute the source tarball so we should generate it in the CI pipeline. - - - - - 3c91de21 by Rob at 2022-05-08T13:40:53+02:00 Change Specialise to use OrdList. Fixes #21362 Metric Decrease: T16875 - - - - - 67072c31 by Simon Jakobi at 2022-05-08T12:23:43-04:00 Tweak GHC.CmmToAsm.CFG.delEdge mapAdjust is more efficient than mapAlter. - - - - - 374554bb by Teo Camarasu at 2022-05-09T16:24:37-04:00 Respect -po when heap profiling (#21446) - - - - - 1ea414b6 by Teo Camarasu at 2022-05-09T16:24:37-04:00 add test case for #21446 - - - - - c7902078 by Jens Petersen at 2022-05-09T16:25:17-04:00 avoid hadrian/bindist/Makefile install_docs error when --docs=none When docs are disabled the bindist does not have docs/ and hence docs-utils/ is not generated. Here we just test that docs-utils exists before attempting to install prologue.txt and gen_contents_index to avoid the error: /usr/bin/install: cannot stat 'docs-utils/prologue.txt': No such file or directory make: *** [Makefile:195: install_docs] Error 1 - - - - - 158bd659 by Hécate Moonlight at 2022-05-09T16:25:56-04:00 Correct base's changelog for 4.16.1.0 This commit reaffects the new Ix instances of the foreign integral types from base 4.17 to 4.16.1.0 closes #21529 - - - - - a4fbb589 by Sylvain Henry at 2022-05-09T16:26:36-04:00 STG: only print cost-center if asked to - - - - - 50347ded by Gergo ERDI at 2022-05-10T11:43:33+00:00 Improve "Glomming" note Add a paragraph that clarifies that `occurAnalysePgm` finding out-of-order references, and thus needing to glom, is not a cause for concern when its root cause is rewrite rules. - - - - - df2e3373 by Eric Lindblad at 2022-05-10T20:45:41-04:00 update INSTALL - - - - - dcac3833 by Matthew Pickering at 2022-05-10T20:46:16-04:00 driver: Make -no-keep-o-files -no-keep-hi-files work in --make mode It seems like it was just an oversight to use the incorrect DynFlags (global rather than local) when implementing these two options. Using the local flags allows users to request these intermediate files get cleaned up, which works fine in --make mode because 1. Interface files are stored in memory 2. Object files are only cleaned at the end of session (after link) Fixes #21349 - - - - - 35da81f8 by Ben Gamari at 2022-05-10T20:46:52-04:00 configure: Check for ffi.h As noted in #21485, we checked for ffi.h yet then failed to throw an error if it is missing. Fixes #21485. - - - - - bdc99cc2 by Simon Peyton Jones at 2022-05-10T20:47:28-04:00 Check for uninferrable variables in tcInferPatSynDecl This fixes #21479 See Note [Unquantified tyvars in a pattern synonym] While doing this, I found that some error messages pointed at the pattern synonym /name/, rather than the /declaration/ so I widened the SrcSpan to encompass the declaration. - - - - - 142a73d9 by Matthew Pickering at 2022-05-10T20:48:04-04:00 hadrian: Fix split-sections transformer The splitSections transformer has been broken since -dynamic-too support was implemented in hadrian. This is because we actually build the dynamic way when building the dynamic way, so the predicate would always fail. The fix is to just always pass `split-sections` even if it doesn't do anything for a particular way. Fixes #21138 - - - - - 699f5935 by Matthew Pickering at 2022-05-10T20:48:04-04:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. Closes #21135 - - - - - 21feece2 by Simon Peyton Jones at 2022-05-10T20:48:39-04:00 Use the wrapper for an unlifted binding We assumed the wrapper for an unlifted binding is the identity, but as #21516 showed, that is no always true. Solution is simple: use it. - - - - - 68d1ea5f by Matthew Pickering at 2022-05-10T20:49:15-04:00 docs: Fix path to GHC API docs in index.html In the make bindists we generate documentation in docs/ghc-<VER> but the hadrian bindists generate docs/ghc/ so the path to the GHC API docs was wrong in the index.html file. Rather than make the hadrian and make bindists the same it was easier to assume that if you're using the mkDocs script that you're using hadrian bindists. Fixes #21509 - - - - - 9d8f44a9 by Matthew Pickering at 2022-05-10T20:49:51-04:00 hadrian: Don't pass -j to haddock This has high potential for oversubcribing as many haddock jobs can be spawned in parralel which will each request the given number of capabilities. Once -jsem is implemented (#19416, !5176) we can expose that haddock via haddock and use that to pass a semaphore. Ticket #21136 - - - - - fec3e7aa by Matthew Pickering at 2022-05-10T20:50:27-04:00 hadrian: Only copy and install libffi headers when using in-tree libffi When passed `--use-system-libffi` then we shouldn't copy and install the headers from the system package. Instead the headers are expected to be available as a runtime dependency on the users system. Fixes #21485 #21487 - - - - - 5b791ed3 by mikael at 2022-05-11T08:22:13-04:00 FIND_LLVM_PROG: Recognize llvm suffix used by FreeBSD, ie llc10. - - - - - 8500206e by ARATA Mizuki at 2022-05-11T08:22:57-04:00 Make floating-point abs IEEE 754 compliant The old code used by via-C backend didn't handle the sign bit of NaN. See #21043. - - - - - 4a4c77ed by Alan Zimmerman at 2022-05-11T08:23:33-04:00 EPA: do statement with leading semicolon has wrong anchor The code do; a <- doAsync; b Generated an incorrect Anchor for the statement list that starts after the first semicolon. This commit fixes it. Closes #20256 - - - - - e3ca8dac by Simon Peyton Jones at 2022-05-11T08:24:08-04:00 Specialiser: saturate DFuns correctly Ticket #21489 showed that the saturation mechanism for DFuns (see Note Specialising DFuns) should use both UnspecType and UnspecArg. We weren't doing that; but this MR fixes that problem. No test case because it's hard to tickle, but it showed up in Gergo's work with GHC-as-a-library. - - - - - fcc7dc4c by Ben Gamari at 2022-05-11T20:05:41-04:00 gitlab-ci: Check for dynamic msys2 dependencies Both #20878 and #21196 were caused by unwanted dynamic dependencies being introduced by boot libraries. Ensure that we catch this in CI by attempting to run GHC in an environment with a minimal PATH. - - - - - 3c998f0d by Matthew Pickering at 2022-05-11T20:06:16-04:00 Add back Debian9 CI jobs We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19 not being at EOL until April 2023 and they still need tinfo5. Fixes #21469 - - - - - dea9a3d9 by Ben Gamari at 2022-05-11T20:06:51-04:00 rts: Drop setExecutable Since f6e366c058b136f0789a42222b8189510a3693d1 setExecutable has been dead code. Drop it. - - - - - 32cdf62d by Simon Peyton Jones at 2022-05-11T20:07:27-04:00 Add a missing guard in GHC.HsToCore.Utils.is_flat_prod_pat This missing guard gave rise to #21519. - - - - - 2c00a8d0 by Matthew Pickering at 2022-05-11T20:08:02-04:00 Add mention of -hi to RTS --help Fixes #21546 - - - - - a2dcad4e by Andre Marianiello at 2022-05-12T02:15:48+00:00 Decouple dynflags in Cmm parser (related to #17957) - - - - - 3a022baa by Andre Marianiello at 2022-05-12T02:15:48+00:00 Remove Module argument from initCmmParserConfig - - - - - 2fc8d76b by Andre Marianiello at 2022-05-12T02:15:48+00:00 Move CmmParserConfig and PDConfig into GHC.Cmm.Parser.Config - - - - - b8c5ffab by Andre Marianiello at 2022-05-12T18:13:55-04:00 Decouple dynflags in GHC.Core.Opt.Arity (related to #17957) Metric Decrease: T16875 - - - - - 3bf938b6 by sheaf at 2022-05-12T18:14:34-04:00 Update extending_ghc for TcPlugin changes The documentation still mentioned Derived constraints and an outdated datatype TcPluginResult. - - - - - 668a9ef4 by jackohughes at 2022-05-13T12:10:34-04:00 Fix printing of brackets in multiplicities (#20315) Change mulArrow to allow for printing of correct application precedence where necessary and update callers of mulArrow to reflect this. As part of this, move mulArrow from GHC/Utils/Outputtable to GHC/Iface/Type. Fixes #20315 - - - - - 30b8b7f1 by Ben Gamari at 2022-05-13T12:11:09-04:00 rts: Add debug output on ocResolve failure This makes it easier to see how resolution failures nest. - - - - - 53b3fa1c by Ben Gamari at 2022-05-13T12:11:09-04:00 rts/PEi386: Fix handling of weak symbols Previously we would flag the symbol as weak but failed to set its address, which must be computed from an "auxiliary" symbol entry the follows the weak symbol. Fixes #21556. - - - - - 5678f017 by Ben Gamari at 2022-05-13T12:11:09-04:00 testsuite: Add tests for #21556 - - - - - 49af0e52 by Ben Gamari at 2022-05-13T22:23:26-04:00 Re-export augment and build from GHC.List Resolves https://gitlab.haskell.org/ghc/ghc/-/issues/19127 - - - - - aed356e1 by Simon Peyton Jones at 2022-05-13T22:24:02-04:00 Comments only around HsWrapper - - - - - 27b90409 by Ben Gamari at 2022-05-16T08:30:44-04:00 hadrian: Introduce linting flavour transformer (+lint) The linting flavour enables -dlint uniformly across anything build by the stage1 compiler. -dcmm-lint is not currently enabled because it fails on i386 (see #21563) - - - - - 3f316776 by Matthew Pickering at 2022-05-16T08:30:44-04:00 hadrian: Uniformly enable -dlint with enableLinting transformer This fixes some bugs where * -dcore-lint was being passed when building stage1 libraries with the boot compiler * -dcore-lint was not being passed when building executables. Fixes #20135 - - - - - 3d74cfca by Andreas Klebinger at 2022-05-16T08:31:20-04:00 Make closure macros EXTERN_INLINE to make debugging easier Implements #21424. The RTS macros get_itbl and friends are extremely helpful during debugging. However only a select few of those were available in the compiled RTS as actual symbols as the rest were INLINE macros. This commit marks all of them as EXTERN_INLINE. This will still inline them at use sites but allow us to use their compiled counterparts during debugging. This allows us to use things like `p get_fun_itbl(ptr)` in the gdb shell since `get_fun_itbl` will now be available as symbol! - - - - - 93153aab by Matthew Pickering at 2022-05-16T08:31:55-04:00 packaging: Introduce CI job for generating hackage documentation This adds a CI job (hackage-doc-tarball) which generates the necessary tarballs for uploading libraries and documentation to hackage. The release script knows to download this folder and the upload script will also upload the release to hackage as part of the release. The `ghc_upload_libs` script is moved from ghc-utils into .gitlab/ghc_upload_libs There are two modes, preparation and upload. * The `prepare` mode takes a link to a bindist and creates a folder containing the source and doc tarballs ready to upload to hackage. * The `upload` mode takes the folder created by prepare and performs the upload to hackage. Fixes #21493 Related to #21512 - - - - - 65d31d05 by Simon Peyton Jones at 2022-05-16T15:32:50-04:00 Add arity to the INLINE pragmas for pattern synonyms The lack of INLNE arity was exposed by #21531. The fix is simple enough, if a bit clumsy. - - - - - 43c018aa by Krzysztof Gogolewski at 2022-05-16T15:33:25-04:00 Misc cleanup - Remove groupWithName (unused) - Use the RuntimeRepType synonym where possible - Replace getUniqueM + mkSysLocalOrCoVar with mkSysLocalOrCoVarM No functional changes. - - - - - 8dfea078 by Pavol Vargovcik at 2022-05-16T15:34:04-04:00 TcPlugin: access to irreducible givens + fix passed ev_binds_var - - - - - fb579e15 by Ben Gamari at 2022-05-17T00:25:02-04:00 driver: Introduce pgmcxx Here we introduce proper support for compilation of C++ objects. This includes: * logic in `configure` to detect the C++ toolchain and propagating this information into the `settings` file * logic in the driver to use the C++ toolchain when compiling C++ sources - - - - - 43628ed4 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Build T20918 with HC, not CXX - - - - - 0ef249aa by Ben Gamari at 2022-05-17T00:25:02-04:00 Introduce package to capture dependency on C++ stdlib Here we introduce a new "virtual" package into the initial package database, `system-cxx-std-lib`. This gives users a convenient, platform agnostic way to link against C++ libraries, addressing #20010. Fixes #20010. - - - - - 03efe283 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Add tests for system-cxx-std-lib package Test that we can successfully link against C++ code both in GHCi and batch compilation. See #20010 - - - - - 5f6527e0 by nineonine at 2022-05-17T00:25:38-04:00 OverloadedRecordFields: mention parent name in 'ambiguous occurrence' error for better disambiguation (#17420) - - - - - eccdb208 by Simon Peyton Jones at 2022-05-17T07:16:39-04:00 Adjust flags for pprTrace We were using defaultSDocContext for pprTrace, which suppresses lots of useful infomation. This small MR adds GHC.Utils.Outputable.traceSDocContext and uses it for pprTrace and pprTraceUserWarning. traceSDocContext is a global, and hence not influenced by flags, but that seems unavoidable. But I made the sdocPprDebug bit controlled by unsafeHasPprDebug, since we have the latter for exactly this purpose. Fixes #21569 - - - - - d2284c4c by Simon Peyton Jones at 2022-05-17T07:17:15-04:00 Fix bad interaction between withDict and the Specialiser This MR fixes a bad bug, where the withDict was inlined too vigorously, which in turn made the type-class Specialiser generate a bogus specialisation, because it saw the same overloaded function applied to two /different/ dictionaries. Solution: inline `withDict` later. See (WD8) of Note [withDict] in GHC.HsToCore.Expr See #21575, which is fixed by this change. - - - - - 70f52443 by Matthew Pickering at 2022-05-17T07:17:50-04:00 Bump time submodule to 1.12.2 This bumps the time submodule to the 1.12.2 release. Fixes #21571 - - - - - 2343457d by Vladislav Zavialov at 2022-05-17T07:18:26-04:00 Remove unused test files (#21582) Those files were moved to the perf/ subtree in 11c9a469, and then accidentally reintroduced in 680ef2c8. - - - - - cb52b4ae by Ben Gamari at 2022-05-17T16:00:14-04:00 CafAnal: Improve code clarity Here we implement a few measures to improve the clarity of the CAF analysis implementation. Specifically: * Use CafInfo instead of Bool since the former is more descriptive * Rename CAFLabel to CAFfyLabel, since not all CAFfyLabels are in fact CAFs * Add numerous comments - - - - - b048a9f4 by Ben Gamari at 2022-05-17T16:00:14-04:00 codeGen: Ensure that static datacon apps are included in SRTs When generating an SRT for a recursive group, GHC.Cmm.Info.Build.oneSRT filters out recursive references, as described in Note [recursive SRTs]. However, doing so for static functions would be unsound, for the reason described in Note [Invalid optimisation: shortcutting]. However, the same argument applies to static data constructor applications, as we discovered in #20959. Fix this by ensuring that static data constructor applications are included in recursive SRTs. The approach here is not entirely satisfactory, but it is a starting point. Fixes #20959. - - - - - 0e2d16eb by Matthew Pickering at 2022-05-17T16:00:50-04:00 Add test for #21558 This is now fixed on master and 9.2 branch. Closes #21558 - - - - - ef3c8d9e by Sylvain Henry at 2022-05-17T20:22:02-04:00 Don't store LlvmConfig into DynFlags LlvmConfig contains information read from llvm-passes and llvm-targets files in GHC's top directory. Reading these files is done only when needed (i.e. when the LLVM backend is used) and cached for the whole compiler session. This patch changes the way this is done: - Split LlvmConfig into LlvmConfig and LlvmConfigCache - Store LlvmConfigCache in HscEnv instead of DynFlags: there is no good reason to store it in DynFlags. As it is fixed per session, we store it in the session state instead (HscEnv). - Initializing LlvmConfigCache required some changes to driver functions such as newHscEnv. I've used the opportunity to untangle initHscEnv from initGhcMonad (in top-level GHC module) and to move it to GHC.Driver.Main, close to newHscEnv. - I've also made `cmmPipeline` independent of HscEnv in order to remove the call to newHscEnv in regalloc_unit_tests. - - - - - 828fbd8a by Andreas Klebinger at 2022-05-17T20:22:38-04:00 Give all EXTERN_INLINE closure macros prototypes - - - - - cfc8e2e2 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Introduce [sg]etFinalizerExceptionHandler This introduces a global hook which is called when an exception is thrown during finalization. - - - - - 372cf730 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Throw exceptions raised while closing finalized Handles Fixes #21336. - - - - - 3dd2f944 by Ben Gamari at 2022-05-19T04:57:51-04:00 testsuite: Add tests for #21336 - - - - - 297156e0 by Matthew Pickering at 2022-05-19T04:58:27-04:00 Add release flavour and use it for the release jobs The release flavour is essentially the same as the perf flavour currently but also enables `-haddock`. I have hopefully updated all the relevant places where the `-perf` flavour was hardcoded. Fixes #21486 - - - - - a05b6293 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Don't build sphinx documentation on centos The centos docker image lacks the sphinx builder so we disable building sphinx docs for these jobs. Fixes #21580 - - - - - 209d7c69 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Use correct syntax when args list is empty This seems to fail on the ancient version of bash present on CentOS - - - - - 02d16334 by Matthew Pickering at 2022-05-19T04:59:03-04:00 hadrian: Don't attempt to build dynamic profiling libraries We only support building static profiling libraries, the transformer was requesting things like a dynamic, threaded, debug, profiling RTS, which we have never produced nor distributed. Fixes #21567 - - - - - 35bdab1c by Ben Gamari at 2022-05-19T04:59:39-04:00 configure: Check CC_STAGE0 for --target support We previously only checked the stage 1/2 compiler for --target support. We got away with this for quite a while but it eventually caught up with us in #21579, where `bytestring`'s new NEON implementation was unbuildable on Darwin due to Rosetta's seemingly random logic for determining which executable image to execute. This lead to a confusing failure to build `bytestring`'s cbits, when `clang` tried to compile NEON builtins while targetting x86-64. Fix this by checking CC_STAGE0 for --target support. Fixes #21579. - - - - - 0ccca94b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator analysis of `CmmGraph` This commit adds module `GHC.Cmm.Dominators`, which provides a wrapper around two existing algorithms in GHC: the Lengauer-Tarjan dominator analysis from the X86 back end and the reverse postorder ordering from the Cmm Dataflow framework. Issue #20726 proposes that we evaluate some alternatives for dominator analysis, but for the time being, the best path forward is simply to use the existing analysis on `CmmGraph`s. This commit addresses a bullet in #21200. - - - - - 54f0b578 by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator-tree function - - - - - 05ed917b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add HasDebugCallStack; remove unneeded extensions - - - - - 0b848136 by Andreas Klebinger at 2022-05-20T05:32:32-04:00 document fields of `DominatorSet` - - - - - 8a26e8d6 by Ben Gamari at 2022-05-20T05:33:08-04:00 nonmoving: Fix documentation of GC statistics fields These were previously incorrect. Fixes #21553. - - - - - c1e24e61 by Matthew Pickering at 2022-05-20T05:33:44-04:00 Remove pprTrace from pushCoercionIntoLambda (#21555) This firstly caused spurious output to be emitted (as evidenced by #21555) but even worse caused a massive coercion to be attempted to be printed (> 200k terms) which would invariably eats up all the memory of your computer. The good news is that removing this trace allows the program to compile to completion, the bad news is that the program exhibits a core lint error (on 9.0.2) but not any other releases it seems. Fixes #21577 and #21555 - - - - - a36d12ee by Zubin Duggal at 2022-05-20T10:44:35-04:00 docs: Fix LlvmVersion in manpage (#21280) - - - - - 36b8a57c by Matthew Pickering at 2022-05-20T10:45:10-04:00 validate: Use $make rather than make In the validate script we are careful to use the $make variable as this stores whether we are using gmake, make, quiet mode etc. There was just this one place where we failed to use it. Fixes #21598 - - - - - 4aa3c5bd by Norman Ramsey at 2022-05-21T03:11:04+00:00 Change `Backend` type and remove direct dependencies With this change, `Backend` becomes an abstract type (there are no more exposed value constructors). Decisions that were formerly made by asking "is the current back end equal to (or different from) this named value constructor?" are now made by interrogating the back end about its properties, which are functions exported by `GHC.Driver.Backend`. There is a description of how to migrate code using `Backend` in the user guide. Clients using the GHC API can find a backdoor to access the Backend datatype in GHC.Driver.Backend.Internal. Bumps haddock submodule. Fixes #20927 - - - - - ecf5f363 by Julian Ospald at 2022-05-21T12:51:16-04:00 Respect DESTDIR in hadrian bindist Makefile, fixes #19646 - - - - - 7edd991e by Julian Ospald at 2022-05-21T12:51:16-04:00 Test DESTDIR in test_hadrian() - - - - - ea895b94 by Matthew Pickering at 2022-05-22T21:57:47-04:00 Consider the stage of typeable evidence when checking stage restriction We were considering all Typeable evidence to be "BuiltinInstance"s which meant the stage restriction was going unchecked. In-fact, typeable has evidence and so we need to apply the stage restriction. This is complicated by the fact we don't generate typeable evidence and the corresponding DFunIds until after typechecking is concluded so we introcue a new `InstanceWhat` constructor, BuiltinTypeableInstance which records whether the evidence is going to be local or not. Fixes #21547 - - - - - ffbe28e5 by Dominik Peteler at 2022-05-22T21:58:23-04:00 Modularize GHC.Core.Opt.LiberateCase Progress towards #17957 - - - - - bc723ac2 by Simon Peyton Jones at 2022-05-23T17:09:34+01:00 Improve FloatOut and SpecConstr This patch addresses a relatively obscure situation that arose when chasing perf regressions in !7847, which itself is fixing It does two things: * SpecConstr can specialise on ($df d1 d2) dictionary arguments * FloatOut no longer checks argument strictness See Note [Specialising on dictionaries] in GHC.Core.Opt.SpecConstr. A test case is difficult to construct, but it makes a big difference in nofib/real/eff/VSM, at least when we have the patch for #21286 installed. (The latter stops worker/wrapper for dictionary arguments). There is a spectacular, but slightly illusory, improvement in runtime perf on T15426. I have documented the specifics in T15426 itself. Metric Decrease: T15426 - - - - - 1a4195b0 by John Ericson at 2022-05-23T17:33:59-04:00 Make debug a `Bool` not an `Int` in `StgToCmmConfig` We don't need any more resolution than this. Rename the field to `stgToCmmEmitDebugInfo` to indicate it is no longer conveying any "level" information. - - - - - e9fff12b by Alan Zimmerman at 2022-05-23T21:04:49-04:00 EPA : Remove duplicate comments in DataFamInstD The code data instance Method PGMigration = MigrationQuery Query -- ^ Run a query against the database | MigrationCode (Connection -> IO (Either String ())) -- ^ Run any arbitrary IO code Resulted in two instances of the "-- ^ Run a query against the database" comment appearing in the Exact Print Annotations when it was parsed. Ensure only one is kept. Closes #20239 - - - - - e2520df3 by Alan Zimmerman at 2022-05-23T21:05:27-04:00 EPA: Comment Order Reversed Make sure comments captured in the exact print annotations are in order of increasing location Closes #20718 - - - - - 4b45fd72 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Add test for T21455 - - - - - e2cd1d43 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Allow passing -po outside profiling way Resolves #21455 - - - - - 3b8c413a by Greg Steuck at 2022-05-24T10:49:52-04:00 Fix haddock_*_perf tests on non-GNU-grep systems Using regexp pattern requires `egrep` and straight up `+`. The haddock_parser_perf and haddock_renamer_perf tests now pass on OpenBSD. They previously incorrectly parsed the files and awk complained about invalid syntax. - - - - - 1db877a3 by Ben Gamari at 2022-05-24T10:50:28-04:00 hadrian/bindist: Drop redundant include of install.mk `install.mk` is already included by `config.mk`. Moreover, `install.mk` depends upon `config.mk` to set `RelocatableBuild`, making this first include incorrect. - - - - - f485d267 by Greg Steuck at 2022-05-24T10:51:08-04:00 Remove -z wxneeded for OpenBSD With all the recent W^X fixes in the loader this workaround is not necessary any longer. I verified that the only tests failing for me on OpenBSD 7.1-current are the same (libc++ related) before and after this commit (with --fast). - - - - - 7c51177d by Andreas Klebinger at 2022-05-24T22:13:19-04:00 Use UnionListsOrd instead of UnionLists in most places. This should get rid of most, if not all "Overlong lists" errors and fix #20016 - - - - - 81b3741f by Andreas Klebinger at 2022-05-24T22:13:55-04:00 Fix #21563 by using Word64 for 64bit shift code. We use the 64bit shifts only on 64bit platforms. But we compile the code always so compiling it on 32bit caused a lint error. So use Word64 instead. - - - - - 2c25fff6 by Zubin Duggal at 2022-05-24T22:14:30-04:00 Fix compilation with -haddock on GHC <= 8.10 -haddock on GHC < 9.0 is quite fragile and can result in obtuse parse errors when it encounters invalid haddock syntax. This has started to affect users since 297156e0b8053a28a860e7a18e1816207a59547b enabled -haddock by default on many flavours. Furthermore, since we don't test bootstrapping with 8.10 on CI, this problem managed to slip throught the cracks. - - - - - cfb9faff by sheaf at 2022-05-24T22:15:12-04:00 Hadrian: don't add "lib" for relocatable builds The conditional in hadrian/bindist/Makefile depended on the target OS, but it makes more sense to use whether we are using a relocatable build. (Currently this only gets set to true on Windows, but this ensures that the logic stays correctly coupled.) - - - - - 9973c016 by Andre Marianiello at 2022-05-25T01:36:09-04:00 Remove HscEnv from GHC.HsToCore.Usage (related to #17957) Metric Decrease: T16875 - - - - - 2ff18e39 by sheaf at 2022-05-25T01:36:48-04:00 SimpleOpt: beta-reduce through casts The simple optimiser would sometimes fail to beta-reduce a lambda when there were casts in between the lambda and its arguments. This can cause problems because we rely on representation-polymorphic lambdas getting beta-reduced away (for example, those that arise from newtype constructors with representation-polymorphic arguments, with UnliftedNewtypes). - - - - - e74fc066 by CarrieMY at 2022-05-25T16:43:03+02:00 Desugar RecordUpd in `tcExpr` This patch typechecks record updates by desugaring them inside the typechecker using the HsExpansion mechanism, and then typechecking this desugared result. Example: data T p q = T1 { x :: Int, y :: Bool, z :: Char } | T2 { v :: Char } | T3 { x :: Int } | T4 { p :: Float, y :: Bool, x :: Int } | T5 The record update `e { x=e1, y=e2 }` desugars as follows e { x=e1, y=e2 } ===> let { x' = e1; y' = e2 } in case e of T1 _ _ z -> T1 x' y' z T4 p _ _ -> T4 p y' x' The desugared expression is put into an HsExpansion, and we typecheck that. The full details are given in Note [Record Updates] in GHC.Tc.Gen.Expr. Fixes #2595 #3632 #10808 #10856 #16501 #18311 #18802 #21158 #21289 Updates haddock submodule - - - - - 2b8bdab8 by Eric Lindblad at 2022-05-26T03:21:58-04:00 update README - - - - - 3d7e7e84 by BinderDavid at 2022-05-26T03:22:38-04:00 Replace dead link in Haddock documentation of Control.Monad.Fail (fixes #21602) - - - - - ee61c7f9 by John Ericson at 2022-05-26T03:23:13-04:00 Add Haddocks for `WwOpts` - - - - - da5ccf0e by Dominik Peteler at 2022-05-26T03:23:13-04:00 Avoid global compiler state for `GHC.Core.Opt.WorkWrap` Progress towards #17957 - - - - - 3bd975b4 by sheaf at 2022-05-26T03:23:52-04:00 Optimiser: avoid introducing bad rep-poly The functions `pushCoValArg` and `pushCoercionIntoLambda` could introduce bad representation-polymorphism. Example: type RR :: RuntimeRep type family RR where { RR = IntRep } type F :: TYPE RR type family F where { F = Int# } co = GRefl F (TYPE RR[0]) :: (F :: TYPE RR) ~# (F |> TYPE RR[0] :: TYPE IntRep) f :: F -> () `pushCoValArg` would transform the unproblematic application (f |> (co -> <()>)) (arg :: F |> TYPE RR[0]) into an application in which the argument does not have a fixed `RuntimeRep`: f ((arg |> sym co) :: (F :: TYPE RR)) - - - - - b22979fb by Fraser Tweedale at 2022-05-26T06:14:51-04:00 executablePath test: fix file extension treatment The executablePath test strips the file extension (if any) when comparing the query result with the expected value. This is to handle platforms where GHC adds a file extension to the output program file (e.g. .exe on Windows). After the initial check, the file gets deleted (if supported). However, it tries to delete the *stripped* filename, which is incorrect. The test currently passes only because Windows does not allow deleting the program while any process created from it is alive. Make the test program correct in general by deleting the *non-stripped* executable filename. - - - - - afde4276 by Fraser Tweedale at 2022-05-26T06:14:51-04:00 fix executablePath test for NetBSD executablePath support for NetBSD was added in a172be07e3dce758a2325104a3a37fc8b1d20c9c, but the test was not updated. Update the test so that it works for NetBSD. This requires handling some quirks: - The result of getExecutablePath could include "./" segments. Therefore use System.FilePath.equalFilePath to compare paths. - The sysctl(2) call returns the original executable name even after it was deleted. Add `canQueryAfterDelete :: [FilePath]` and adjust expectations for the post-delete query accordingly. Also add a note to the `executablePath` haddock to advise that NetBSD behaves differently from other OSes when the file has been deleted. Also accept a decrease in memory usage for T16875. On Windows, the metric is -2.2% of baseline, just outside the allowed ±2%. I don't see how this commit could have influenced this metric, so I suppose it's something in the CI environment. Metric Decrease: T16875 - - - - - d0e4355a by John Ericson at 2022-05-26T06:15:30-04:00 Factor out `initArityOps` to `GHC.Driver.Config.*` module We want `DynFlags` only mentioned in `GHC.Driver`. - - - - - 44bb7111 by romes at 2022-05-26T16:27:57+00:00 TTG: Move MatchGroup Origin field and MatchGroupTc to GHC.Hs - - - - - 88e58600 by sheaf at 2022-05-26T17:38:43-04:00 Add tests for eta-expansion of data constructors This patch adds several tests relating to the eta-expansion of data constructors, including UnliftedNewtypes and DataTypeContexts. - - - - - d87530bb by Richard Eisenberg at 2022-05-26T23:20:14-04:00 Generalize breakTyVarCycle to work with TyFamLHS The function breakTyVarCycle_maybe has been installed in a dark corner of GHC to catch some gremlins (a.k.a. occurs-check failures) who lurk there. But it previously only caught gremlins of the form (a ~ ... F a ...), where some of our intrepid users have spawned gremlins of the form (G a ~ ... F (G a) ...). This commit improves breakTyVarCycle_maybe (and renames it to breakTyEqCycle_maybe) to catch the new gremlins. Happily, the change is remarkably small. The gory details are in Note [Type equality cycles]. Test cases: typecheck/should_compile/{T21515,T21473}. - - - - - ed37027f by Hécate Moonlight at 2022-05-26T23:20:52-04:00 [base] Fix the links in the Data.Data module fix #21658 fix #21657 fix #21657 - - - - - 3bd7d5d6 by Krzysztof Gogolewski at 2022-05-27T16:44:48+02:00 Use a class to check validity of withDict This moves handling of the magic 'withDict' function from the desugarer to the typechecker. Details in Note [withDict]. I've extracted a part of T16646Fail to a separate file T16646Fail2, because the new error in 'reify' hides the errors from 'f' and 'g'. WithDict now works with casts, this fixes #21328. Part of #19915 - - - - - b54f6c4f by sheaf at 2022-05-28T21:00:09-04:00 Fix FreeVars computation for mdo Commit acb188e0 introduced a regression in the computation of free variables in mdo statements, as the logic in GHC.Rename.Expr.segmentRecStmts was slightly different depending on whether the recursive do block corresponded to an mdo statement or a rec statment. This patch restores the previous computation for mdo blocks. Fixes #21654 - - - - - 0704295c by Matthew Pickering at 2022-05-28T21:00:45-04:00 T16875: Stabilise (temporarily) by increasing acceptance threshold The theory is that on windows there is some difference in the environment between pipelines on master and merge requests which affects all tests equally but because T16875 barely allocates anything it is the test which is affected the most. See #21557 - - - - - 6341c8ed by Matthew Pickering at 2022-05-28T21:01:20-04:00 make: Fix make maintainer-clean deleting a file tracked by source control Fixes #21659 - - - - - fbf2f254 by Bodigrim at 2022-05-28T21:01:58-04:00 Expand documentation of hIsTerminalDevice - - - - - 0092c67c by Teo Camarasu at 2022-05-29T12:25:39+00:00 export IsList from GHC.IsList it is still re-exported from GHC.Exts - - - - - 91396327 by Sylvain Henry at 2022-05-30T09:40:55-04:00 MachO linker: fix handling of ARM64_RELOC_SUBTRACTOR ARM64_RELOC_SUBTRACTOR relocations are paired with an AMR64_RELOC_UNSIGNED relocation to implement: addend + sym1 - sym2 The linker was doing it in two steps, basically: *addend <- *addend - sym2 *addend <- *addend + sym1 The first operation was likely to overflow. For example when the relocation target was 32-bit and both sym1/sym2 were 64-bit addresses. With the small memory model, (sym1-sym2) would fit in 32 bits but (*addend-sym2) may not. Now the linker does it in one step: *addend <- *addend + sym1 - sym2 - - - - - acc26806 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Some fixes to SRT documentation - reordered the 3 SRT implementation cases from the most general to the most specific one: USE_SRT_POINTER -> USE_SRT_OFFSET -> USE_INLINE_SRT_FIELD - added requirements for each - found and documented a confusion about "SRT inlining" not supported with MachO. (It is fixed in the following commit) - - - - - 5878f439 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Enable USE_INLINE_SRT_FIELD on ARM64 It was previously disabled because of: - a confusion about "SRT inlining" (see removed comment in this commit) - a linker bug (overflow) in the handling of ARM64_RELOC_SUBTRACTOR relocation: fixed by a previous commit. - - - - - 59bd6159 by Matthew Pickering at 2022-05-30T09:41:39-04:00 ci: Make sure to exit promptly if `make install` fails. Due to the vageries of bash, you have to explicitly handle the failure and exit when in a function. This failed to exit promptly when !8247 was failing. See #21358 for the general issue - - - - - 5a5a28da by Sylvain Henry at 2022-05-30T09:42:23-04:00 Split GHC.HsToCore.Foreign.Decl This is preliminary work for JavaScript support. It's better to put the code handling the desugaring of Prim, C and JavaScript declarations into separate modules. - - - - - 6f5ff4fa by Sylvain Henry at 2022-05-30T09:43:05-04:00 Bump hadrian to LTS-19.8 (GHC 9.0.2) - - - - - f2e70707 by Sylvain Henry at 2022-05-30T09:43:05-04:00 Hadrian: remove unused code - - - - - 2f215b9f by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Eta reduction with casted function We want to be able to eta-reduce \x y. ((f x) |> co) y by pushing 'co' inwards. A very small change accommodates this See Note [Eta reduction with casted function] - - - - - f4f6a87a by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Do arity trimming at bindings, rather than in exprArity Sometimes there are very large casts, and coercionRKind can be slow. - - - - - 610a2b83 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make findRhsArity take RecFlag This avoids a fixpoint iteration for the common case of non-recursive bindings. - - - - - 80ba50c7 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Comments and white space - - - - - 0079171b by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make PrimOpId record levity This patch concerns #20155, part (1) The general idea is that since primops have curried bindings (currently in PrimOpWrappers.hs) we don't need to eta-expand them. But we /do/ need to eta-expand the levity-polymorphic ones, because they /don't/ have bindings. This patch makes a start in that direction, by identifying the levity-polymophic primops in the PrimOpId IdDetails constructor. For the moment, I'm still eta-expanding all primops (by saying that hasNoBinding returns True for all primops), because of the bug reported in #20155. But I hope that before long we can tidy that up too, and remove the TEMPORARILY stuff in hasNoBinding. - - - - - 6656f016 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: * Move state-hack stuff from GHC.Types.Id (where it never belonged) to GHC.Core.Opt.Arity (which seems much more appropriate). * Add a crucial mkCast in the Cast case of GHC.Core.Opt.Arity.eta_expand; helps with T18223 * Add clarifying notes about eta-reducing to PAPs. See Note [Do not eta reduce PAPs] * I moved tryEtaReduce from GHC.Core.Utils to GHC.Core.Opt.Arity, where it properly belongs. See Note [Eta reduce PAPs] * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, pull out the code for when eta-expansion is wanted, to make wantEtaExpansion, and all that same function in GHC.Core.Opt.Simplify.simplStableUnfolding. It was previously inconsistent, but it's doing the same thing. * I did a substantial refactor of ArityType; see Note [ArityType]. This allowed me to do away with the somewhat mysterious takeOneShots; more generally it allows arityType to describe the function, leaving its clients to decide how to use that information. I made ArityType abstract, so that clients have to use functions to access it. * Make GHC.Core.Opt.Simplify.Utils.rebuildLam (was stupidly called mkLam before) aware of the floats that the simplifier builds up, so that it can still do eta-reduction even if there are some floats. (Previously that would not happen.) That means passing the floats to rebuildLam, and an extra check when eta-reducting (etaFloatOk). * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, make use of call-info in the idDemandInfo of the binder, as well as the CallArity info. The occurrence analyser did this but we were failing to take advantage here. In the end I moved the heavy lifting to GHC.Core.Opt.Arity.findRhsArity; see Note [Combining arityType with demand info], and functions idDemandOneShots and combineWithDemandOneShots. (These changes partly drove my refactoring of ArityType.) * In GHC.Core.Opt.Arity.findRhsArity * I'm now taking account of the demand on the binder to give extra one-shot info. E.g. if the fn is always called with two args, we can give better one-shot info on the binders than if we just look at the RHS. * Don't do any fixpointing in the non-recursive case -- simple short cut. * Trim arity inside the loop. See Note [Trim arity inside the loop] * Make SimpleOpt respect the eta-reduction flag (Some associated refactoring here.) * I made the CallCtxt which the Simplifier uses distinguish between recursive and non-recursive right-hand sides. data CallCtxt = ... | RhsCtxt RecFlag | ... It affects only one thing: - We call an RHS context interesting only if it is non-recursive see Note [RHS of lets] in GHC.Core.Unfold * Remove eta-reduction in GHC.CoreToStg.Prep, a welcome simplification. See Note [No eta reduction needed in rhsToBody] in GHC.CoreToStg.Prep. Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. * Delete dead function GHC.Core.Opt.Simplify.Utils.contIsRhsOrArg Metrics: compile_time/bytes allocated Test Metric Baseline New value Change --------------------------------------------------------------------------------------- MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,743,297,692 2,619,762,992 -4.5% GOOD T18223(normal) ghc/alloc 1,103,161,360 972,415,992 -11.9% GOOD T3064(normal) ghc/alloc 201,222,500 184,085,360 -8.5% GOOD T8095(normal) ghc/alloc 3,216,292,528 3,254,416,960 +1.2% T9630(normal) ghc/alloc 1,514,131,032 1,557,719,312 +2.9% BAD parsing001(normal) ghc/alloc 530,409,812 525,077,696 -1.0% geo. mean -0.1% Nofib: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- banner +0.0% +0.4% -8.9% -8.7% 0.0% exact-reals +0.0% -7.4% -36.3% -37.4% 0.0% fannkuch-redux +0.0% -0.1% -1.0% -1.0% 0.0% fft2 -0.1% -0.2% -17.8% -19.2% 0.0% fluid +0.0% -1.3% -2.1% -2.1% 0.0% gg -0.0% +2.2% -0.2% -0.1% 0.0% spectral-norm +0.1% -0.2% 0.0% 0.0% 0.0% tak +0.0% -0.3% -9.8% -9.8% 0.0% x2n1 +0.0% -0.2% -3.2% -3.2% 0.0% -------------------------------------------------------------------------------- Min -3.5% -7.4% -58.7% -59.9% 0.0% Max +0.1% +2.2% +32.9% +32.9% 0.0% Geometric Mean -0.0% -0.1% -14.2% -14.8% -0.0% Metric Decrease: MultiLayerModulesTH_OneShot T18223 T3064 T15185 T14766 Metric Increase: T9630 - - - - - cac8c7bb by Matthew Pickering at 2022-05-30T13:44:50-04:00 hadrian: Fix building from source-dist without alex/happy This fixes two bugs which were adding dependencies on alex/happy when building from a source dist. * When we try to pass `--with-alex` and `--with-happy` to cabal when configuring but the builders are not set. This is fixed by making them optional. * When we configure, cabal requires alex/happy because of the build-tool-depends fields. These are now made optional with a cabal flag (build-tool-depends) for compiler/hpc-bin/genprimopcode. Fixes #21627 - - - - - a96dccfe by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test the bootstrap without ALEX/HAPPY on path - - - - - 0e5bb3a8 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test bootstrapping in release jobs - - - - - d8901469 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Allow testing bootstrapping on MRs using the "test-bootstrap" label - - - - - 18326ad2 by Matthew Pickering at 2022-05-30T13:45:25-04:00 rts: Remove explicit timescale for deprecating -h flag We originally planned to remove the flag in 9.4 but there's actually no great rush to do so and it's probably less confusing (forever) to keep the message around suggesting an explicit profiling option. Fixes #21545 - - - - - eaaa1389 by Matthew Pickering at 2022-05-30T13:46:01-04:00 Enable -dlint in hadrian lint transformer Now #21563 is fixed we can properly enable `-dlint` in CI rather than a subset of the flags. - - - - - 0544f114 by Ben Gamari at 2022-05-30T19:16:55-04:00 upload-ghc-libs: Allow candidate-only upload - - - - - 83467435 by Sylvain Henry at 2022-05-30T19:17:35-04:00 Avoid using DynFlags in GHC.Linker.Unit (#17957) - - - - - 5c4421b1 by Matthew Pickering at 2022-05-31T08:35:17-04:00 hadrian: Introduce new package database for executables needed to build stage0 These executables (such as hsc2hs) are built using the boot compiler and crucially, most libraries from the global package database. We also move other build-time executables to be built in this stage such as linters which also cleans up which libraries end up in the global package database. This allows us to remove hacks where linters-common is removed from the package database when a bindist is created. This fixes issues caused by infinite recursion due to bytestring adding a dependency on template-haskell. Fixes #21634 - - - - - 0dafd3e7 by Matthew Pickering at 2022-05-31T08:35:17-04:00 Build stage1 with -V as well This helps tracing errors which happen when building stage1 - - - - - 15d42a7a by Matthew Pickering at 2022-05-31T08:35:52-04:00 Revert "packaging: Build perf builds with -split-sections" This reverts commit 699f593532a3cd5ca1c2fab6e6e4ce9d53be2c1f. Split sections causes segfaults in profiling way with old toolchains (deb9) and on windows (#21670) Fixes #21670 - - - - - d4c71f09 by John Ericson at 2022-05-31T16:26:28+00:00 Purge `DynFlags` and `HscEnv` from some `GHC.Core` modules where it's not too hard Progress towards #17957 Because of `CoreM`, I did not move the `DynFlags` and `HscEnv` to other modules as thoroughly as I usually do. This does mean that risk of `DynFlags` "creeping back in" is higher than it usually is. After we do the same process to the other Core passes, and then figure out what we want to do about `CoreM`, we can finish the job started here. That is a good deal more work, however, so it certainly makes sense to land this now. - - - - - a720322f by romes at 2022-06-01T07:44:44-04:00 Restore Note [Quasi-quote overview] - - - - - 392ce3fc by romes at 2022-06-01T07:44:44-04:00 Move UntypedSpliceFlavour from L.H.S to GHC.Hs UntypedSpliceFlavour was only used in the client-specific `GHC.Hs.Expr` but was defined in the client-independent L.H.S.Expr. - - - - - 7975202b by romes at 2022-06-01T07:44:44-04:00 TTG: Rework and improve splices This commit redefines the structure of Splices in the AST. We get rid of `HsSplice` which used to represent typed and untyped splices, quasi quotes, and the result of splicing either an expression, a type or a pattern. Instead we have `HsUntypedSplice` which models an untyped splice or a quasi quoter, which works in practice just like untyped splices. The `HsExpr` constructor `HsSpliceE` which used to be constructed with an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The former is directly constructed with an `HsExpr` and the latter now takes an `HsUntypedSplice`. Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now take an `HsUntypedSplice` instead of a `HsSplice` (remember only /untyped splices/ can be spliced as types or patterns). The result of splicing an expression, type, or pattern is now comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`, `XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult (HsExpr GhcRn)` Overall the TTG extension points are now better used to make invalid states unrepresentable and model the progression between stages better. See Note [Lifecycle of an untyped splice, and PendingRnSplice] and Note [Lifecycle of an typed splice, and PendingTcSplice] for more details. Updates haddock submodule Fixes #21263 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - 320270c2 by Matthew Pickering at 2022-06-01T07:44:44-04:00 Add test for #21619 Fixes #21619 - - - - - ef7ddd73 by Pierre Le Marre at 2022-06-01T07:44:47-04:00 Pure Haskell implementation of GHC.Unicode Switch to a pure Haskell implementation of base:GHC.Unicode, based on the implementation of the package unicode-data (https://github.com/composewell/unicode-data/). Approved by CLC as per https://github.com/haskell/core-libraries-committee/issues/59#issuecomment-1132106691. - Remove current Unicode cbits. - Add generator for Unicode property files from Unicode Character Database. - Generate internal modules. - Update GHC.Unicode. - Add unicode003 test for general categories and case mappings. - Add Python scripts to check 'base' Unicode tests outputs and characters properties. Fixes #21375 ------------------------- Metric Decrease: T16875 Metric Increase: T4029 T18304 haddock.base ------------------------- - - - - - 514a6a28 by Eric Lindblad at 2022-06-01T07:44:51-04:00 typos - - - - - 9004be3c by Matthew Pickering at 2022-06-01T07:44:52-04:00 source-dist: Copy in files created by ./boot Since we started producing source dists with hadrian we stopped copying in the files created by ./boot which adds a dependency on python3 and autoreconf. This adds back in the files which were created by running configure. Fixes #21673 #21672 and #21626 - - - - - a12a3cab by Matthew Pickering at 2022-06-01T07:44:52-04:00 ci: Don't try to run ./boot when testing bootstrap of source dist - - - - - e07f9059 by Shlomo Shuck at 2022-06-01T07:44:55-04:00 Language.Haskell.Syntax: Fix docs for PromotedConsT etc. Fixes ghc/ghc#21675. - - - - - 87295e6d by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump bytestring, process, and text submodules Metric Decrease: T5631 Metric Increase: T18223 (cherry picked from commit 55fcee30cb3281a66f792e8673967d64619643af) - - - - - 24b5bb61 by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump Cabal submodule To current `master`. (cherry picked from commit fbb59c212415188486aafd970eafef170516356a) - - - - - 5433a35e by Matthew Pickering at 2022-06-01T22:26:30-04:00 hadrian/tool-args: Write output to intermediate file rather than via stdout This allows us to see the output of hadrian while it is doing the setup. - - - - - 468f919b by Matthew Pickering at 2022-06-01T22:27:10-04:00 Make -fcompact-unwind the default This is a follow-up to !7247 (closed) making the inclusion of compact unwinding sections the default. Also a slight refactoring/simplification of the flag handling to add -fno-compact-unwind. - - - - - 819fdc61 by Zubin Duggal at 2022-06-01T22:27:47-04:00 hadrian bootstrap: add plans for 9.0.2 and 9.2.3 - - - - - 9fa790b4 by Zubin Duggal at 2022-06-01T22:27:47-04:00 ci: Add matrix for bootstrap sources - - - - - ce9f986b by John Ericson at 2022-06-02T15:42:59+00:00 HsToCore.Coverage: Improve haddocks - - - - - f065804e by John Ericson at 2022-06-02T15:42:59+00:00 Hoist auto `mkModBreaks` and `writeMixEntries` conditions to caller No need to inline traversing a maybe for `mkModBreaks`. And better to make each function do one thing and let the caller deside when than scatter the decision making and make the caller seem more imperative. - - - - - d550d907 by John Ericson at 2022-06-02T15:42:59+00:00 Rename `HsToCore.{Coverage -> Ticks}` The old name made it confusing why disabling HPC didn't disable the entire pass. The name makes it clear --- there are other reasons to add ticks in addition. - - - - - 6520da95 by John Ericson at 2022-06-02T15:42:59+00:00 Split out `GHC.HsToCore.{Breakpoints,Coverage}` and use `SizedSeq` As proposed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_432877 and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_434676, `GHC.HsToCore.Ticks` is about ticks, breakpoints are separate and backend-specific (only for the bytecode interpreter), and mix entry writing is just for HPC. With this split we separate out those interpreter- and HPC-specific its, and keep the main `GHC.HsToCore.Ticks` agnostic. Also, instead of passing the reversed list and count around, we use `SizedSeq` which abstracts over the algorithm. This is much nicer to avoid noise and prevents bugs. (The bugs are not just hypothetical! I missed up the reverses on an earlier draft of this commit.) - - - - - 1838c3d8 by Sylvain Henry at 2022-06-02T15:43:14+00:00 GHC.HsToCore.Breakpoints: Slightly improve perf We have the length already, so we might as well use that rather than O(n) recomputing it. - - - - - 5a3fdcfd by John Ericson at 2022-06-02T15:43:59+00:00 HsToCore.Coverage: Purge DynFlags Finishes what !7467 (closed) started. Progress towards #17957 - - - - - 9ce9ea50 by HaskellMouse at 2022-06-06T09:50:00-04:00 Deprecate TypeInType extension This commit fixes #20312 It deprecates "TypeInType" extension according to the following proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0083-no-type-in-type.rst It has been already implemented. The migration strategy: 1. Disable TypeInType 2. Enable both DataKinds and PolyKinds extensions Metric Decrease: T16875 - - - - - f2e037fd by Aaron Allen at 2022-06-06T09:50:39-04:00 Diagnostics conversions, part 6 (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and `GHC.Tc.Gen.Sig`. - - - - - 04209f2a by Simon Peyton Jones at 2022-06-06T09:51:15-04:00 Ensure floated dictionaries are in scope (again) In the Specialiser, we missed one more call to bringFloatedDictsIntoScope (see #21391). This omission led to #21689. The problem is that the call to `rewriteClassOps` needs to have in scope any dictionaries floated out of the arguments we have just specialised. Easy fix. - - - - - a7fece19 by John Ericson at 2022-06-07T05:04:22+00:00 Don't print the number of deps in count-deps tests It is redundant information and a source of needless version control conflicts when multiple MRs are changing the deps list. Just printing the list and not also its length is fine. - - - - - a1651a3a by John Ericson at 2022-06-07T05:06:38+00:00 Core.Lint: Reduce `DynFlags` and `HscEnv` Co-Authored-By: Andre Marianiello <andremarianiello at users.noreply.github.com> - - - - - 56ebf9a5 by Andreas Klebinger at 2022-06-09T09:11:43-04:00 Fix a CSE shadowing bug. We used to process the rhs of non-recursive bindings and their body using the same env. If we had something like let x = ... x ... this caused trouble because the two xs refer to different binders but we would substitute both for a new binder x2 causing out of scope errors. We now simply use two different envs for the rhs and body in cse_bind. It's all explained in the Note [Separate envs for let rhs and body] Fixes #21685 - - - - - 28880828 by sheaf at 2022-06-09T09:12:19-04:00 Typecheck remaining ValArgs in rebuildHsApps This patch refactors hasFixedRuntimeRep_remainingValArgs, renaming it to tcRemainingValArgs. The logic is moved to rebuildHsApps, which ensures consistent behaviour across tcApp and quickLookArg1/tcEValArg. This patch also refactors the treatment of stupid theta for data constructors, changing the place we drop stupid theta arguments from dsConLike to mkDataConRep (now the datacon wrapper drops these arguments). We decided not to implement PHASE 2 of the FixedRuntimeRep plan for these remaining ValArgs. Future directions are outlined on the wiki: https://gitlab.haskell.org/ghc/ghc/-/wikis/Remaining-ValArgs Fixes #21544 and #21650 - - - - - 1fbba97b by Matthew Pickering at 2022-06-09T09:12:54-04:00 Add test for T21682 Fixes #21682 - - - - - 8727be73 by Andreas Klebinger at 2022-06-09T09:13:29-04:00 Document dataToTag# primop - - - - - 7eab75bb by uhbif19 at 2022-06-09T20:22:47+03:00 Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115 - - - - - 46d2fc65 by uhbif19 at 2022-06-09T20:24:40+03:00 Fix TcRnPragmaWarning meaning - - - - - 69e72ecd by Matthew Pickering at 2022-06-09T19:07:01-04:00 getProcessCPUTime: Fix the getrusage fallback to account for system CPU time clock_gettime reports the combined total or user AND system time so in order to replicate it with getrusage we need to add both system and user time together. See https://stackoverflow.com/questions/7622371/getrusage-vs-clock-gettime Some sample measurements when building Cabal with this patch t1: rusage t2: clock_gettime t1: 62347518000; t2: 62347520873 t1: 62395687000; t2: 62395690171 t1: 62432435000; t2: 62432437313 t1: 62478489000; t2: 62478492465 t1: 62514990000; t2: 62514992534 t1: 62515479000; t2: 62515480327 t1: 62515485000; t2: 62515486344 Fixes #21656 - - - - - 722814ba by Yiyun Liu at 2022-06-10T21:23:03-04:00 Use <br> instead of newline character - - - - - dc202080 by Matthew Craven at 2022-06-13T14:07:12-04:00 Use (fixed_lev = True) in mkDataTyConRhs - - - - - ad70c621 by Matthew Pickering at 2022-06-14T08:40:53-04:00 hadrian: Fix testing stage1 compiler There were various issues with testing the stage1 compiler.. 1. The wrapper was not being built 2. The wrapper was picking up the stage0 package database and trying to load prelude from that. 3. The wrappers never worked on windows so just don't support that for now. Fixes #21072 - - - - - ac83899d by Ben Gamari at 2022-06-14T08:41:30-04:00 validate: Ensure that $make variable is set Currently the `$make` variable is used without being set in `validate`'s Hadrian path, which uses make to install the binary distribution. Fix this. Fixes #21687. - - - - - 59bc6008 by John Ericson at 2022-06-15T18:05:35+00:00 CoreToStg.Prep: Get rid of `DynFlags` and `HscEnv` The call sites in `Driver.Main` are duplicative, but this is good, because the next step is to remove `InteractiveContext` from `Core.Lint` into `Core.Lint.Interactive`. Also further clean up `Core.Lint` to use a better configuration record than the one we initially added. - - - - - aa9d9381 by Ben Gamari at 2022-06-15T20:33:04-04:00 hadrian: Run xattr -rc . on bindist tarball Fixes #21506. - - - - - cdc75a1f by Ben Gamari at 2022-06-15T20:33:04-04:00 configure: Hide spurious warning from ld Previously the check_for_gold_t22266 configure check could result in spurious warnings coming from the linker being blurted to stderr. Suppress these by piping stderr to /dev/null. - - - - - e128b7b8 by Ben Gamari at 2022-06-15T20:33:40-04:00 cmm: Add surface syntax for MO_MulMayOflo - - - - - bde65ea9 by Ben Gamari at 2022-06-15T20:34:16-04:00 configure: Don't attempt to override linker on Darwin Configure's --enable-ld-override functionality is intended to ensure that we don't rely on ld.bfd, which tends to be slow and buggy, on Linux and Windows. However, on Darwin the lack of sensible package management makes it extremely easy for users to have awkward mixtures of toolchain components from, e.g., XCode, the Apple Command-Line Tools package, and homebrew. This leads to extremely confusing problems like #21712. Here we avoid this by simply giving up on linker selection on Darwin altogether. This isn't so bad since the Apple ld64 linker has decent performance and AFAICT fairly reliable. Closes #21712. - - - - - 25b510c3 by Torsten Schmits at 2022-06-16T12:37:45-04:00 replace quadratic nub to fight byte code gen perf explosion Despite this code having been present in the core-to-bytecode implementation, I have observed it in the wild starting with 9.2, causing enormous slowdown in certain situations. My test case produces the following profiles: Before: ``` total time = 559.77 secs (559766 ticks @ 1000 us, 1 processor) total alloc = 513,985,665,640 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes elem_by Data.OldList libraries/base/Data/OldList.hs:429:1-7 67.6 92.9 378282 477447404296 eqInt GHC.Classes libraries/ghc-prim/GHC/Classes.hs:275:8-14 12.4 0.0 69333 32 $c>>= GHC.Data.IOEnv <no location info> 6.9 0.6 38475 3020371232 ``` After: ``` total time = 89.83 secs (89833 ticks @ 1000 us, 1 processor) total alloc = 39,365,306,360 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes $c>>= GHC.Data.IOEnv <no location info> 43.6 7.7 39156 3020403424 doCase GHC.StgToByteCode compiler/GHC/StgToByteCode.hs:(805,1)-(1054,53) 2.5 7.4 2246 2920777088 ``` - - - - - aa7e1f20 by Matthew Pickering at 2022-06-16T12:38:21-04:00 hadrian: Don't install `include/` directory in bindist. The install_includes for the RTS package used to be put in the top-level ./include folder but this would lead to confusing things happening if you installed multiple GHC versions side-by-side. We don't need this folder anymore because install-includes is honoured properly by cabal and the relevant header files already copied in by the cabal installation process. If you want to depend on the header files for the RTS in a Haskell project then you just have to depend on the `rts` package and the correct include directories will be provided for you. If you want to depend on the header files in a standard C project then you should query ghc-pkg to get the right paths. ``` ghc-pkg field rts include-dirs --simple-output ``` Fixes #21609 - - - - - 03172116 by Bryan Richter at 2022-06-16T12:38:57-04:00 Enable eventlogs on nightly perf job - - - - - ecbf8685 by Hécate Moonlight at 2022-06-16T16:30:00-04:00 Repair dead link in TH haddocks Closes #21724 - - - - - 99ff3818 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian: allow configuring Hsc2Hs This patch adds the ability to pass options to Hsc2Hs as Hadrian key/value settings, in the same way as cabal configure options, using the syntax: *.*.hsc2hs.run.opts += ... - - - - - 9c575f24 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian bootstrap: look up hsc2hs Hadrian bootstrapping looks up where to find ghc_pkg, but the same logic was not in place for hsc2hs which meant we could fail to find the appropriate hsc2hs executabe when bootstrapping Hadrian. This patch adds that missing logic. - - - - - 229d741f by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Add (broken) test for #21622 - - - - - cadd7753 by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Don't Box NULL pointers Previously we could construct a `Box` of a NULL pointer from the `link` field of `StgWeak`. Now we take care to avoid ever introducing such pointers in `collect_pointers` and ensure that the `link` field is represented as a `Maybe` in the `Closure` type. Fixes #21622 - - - - - 31c214cc by Tamar Christina at 2022-06-18T10:43:34-04:00 winio: Add support to console handles to handleToHANDLE - - - - - 711cb417 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Add SMUL[LH] instructions These will be needed to fix #21624. - - - - - d05d90d2 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Fix syntax of OpRegShift operands Previously this produced invalid assembly containing a redundant comma. - - - - - a1e1d8ee by Ben Gamari at 2022-06-18T10:44:11-04:00 ncg/aarch64: Fix implementation of IntMulMayOflo The code generated for IntMulMayOflo was previously wrong as it depended upon the overflow flag, which the AArch64 MUL instruction does not set. Fix this. Fixes #21624. - - - - - 26745006 by Ben Gamari at 2022-06-18T10:44:11-04:00 testsuite: Add test for #21624 Ensuring that mulIntMayOflo# behaves as expected. - - - - - 94f2e92a by Sebastian Graf at 2022-06-20T09:40:58+02:00 CprAnal: Set signatures of DFuns to top The recursive DFun in the reproducer for #20836 also triggered a bug in CprAnal that is observable in a debug build. The CPR signature of a recursive DFunId was never updated and hence the optimistic arity 0 bottom signature triggered a mismatch with the arity 1 of the binding in WorkWrap. We never miscompiled any code because WW doesn't exploit bottom CPR signatures. - - - - - b570da84 by Sebastian Graf at 2022-06-20T09:43:29+02:00 CorePrep: Don't speculatively evaluate recursive calls (#20836) In #20836 we have optimised a terminating program into an endless loop, because we speculated the self-recursive call of a recursive DFun. Now we track the set of enclosing recursive binders in CorePrep to prevent speculation of such self-recursive calls. See the updates to Note [Speculative evaluation] for details. Fixes #20836. - - - - - 49fb2f9b by Sebastian Graf at 2022-06-20T09:43:32+02:00 Simplify: Take care with eta reduction in recursive RHSs (#21652) Similar to the fix to #20836 in CorePrep, we now track the set of enclosing recursive binders in the SimplEnv and SimpleOptEnv. See Note [Eta reduction in recursive RHSs] for details. I also updated Note [Arity robustness] with the insights Simon and I had in a call discussing the issue. Fixes #21652. Unfortunately, we get a 5% ghc/alloc regression in T16577. That is due to additional eta reduction in GHC.Read.choose1 and the resulting ANF-isation of a large list literal at the top-level that didn't happen before (presumably because it was too interesting to float to the top-level). There's not much we can do about that. Metric Increase: T16577 - - - - - 2563b95c by Sebastian Graf at 2022-06-20T09:45:09+02:00 Ignore .hie-bios - - - - - e4e44d8d by Simon Peyton Jones at 2022-06-20T12:31:45-04:00 Instantiate top level foralls in partial type signatures The main fix for #21667 is the new call to tcInstTypeBnders in tcHsPartialSigType. It was really a simple omission before. I also moved the decision about whether we need to apply the Monomorphism Restriction, from `decideGeneralisationPlan` to `tcPolyInfer`. That removes a flag from the InferGen constructor, which is good. But more importantly, it allows the new function, checkMonomorphismRestriction called from `tcPolyInfer`, to "see" the `Types` involved rather than the `HsTypes`. And that in turn matters because we invoke the MR for partial signatures if none of the partial signatures in the group have any overloading context; and we can't answer that question for HsTypes. See Note [Partial type signatures and the monomorphism restriction] in GHC.Tc.Gen.Bind. This latter is really a pre-existing bug. - - - - - 262a9f93 by Winston Hartnett at 2022-06-20T12:32:23-04:00 Make Outputable instance for InlineSig print the InlineSpec Fix ghc/ghc#21739 Squash fix ghc/ghc#21739 - - - - - b5590fff by Matthew Pickering at 2022-06-20T12:32:59-04:00 Add NO_BOOT to hackage_doc_tarball job We were attempting to boot a src-tarball which doesn't work as ./boot is not included in the source tarball. This slipped through as the job is only run on nightly. - - - - - d24afd9d by Vladislav Zavialov at 2022-06-20T17:34:44-04:00 HsToken for @-patterns and TypeApplications (#19623) One more step towards the new design of EPA. - - - - - 159b7628 by Tamar Christina at 2022-06-20T17:35:23-04:00 linker: only keep rtl exception tables if they have been relocated - - - - - da5ff105 by Andreas Klebinger at 2022-06-21T17:04:12+02:00 Ticky:Make json info a separate field. - - - - - 1a4ce4b2 by Matthew Pickering at 2022-06-22T09:49:22+01:00 Revert "Ticky:Make json info a separate field." This reverts commit da5ff10503e683e2148c62e36f8fe2f819328862. This was pushed directly without review. - - - - - f89bf85f by Vanessa McHale at 2022-06-22T08:21:32-04:00 Flags to disable local let-floating; -flocal-float-out, -flocal-float-out-top-level CLI flags These flags affect the behaviour of local let floating. If `-flocal-float-out` is disabled (the default) then we disable all local floating. ``` …(let x = let y = e in (a,b) in body)... ===> …(let y = e; x = (a,b) in body)... ``` Further to this, top-level local floating can be disabled on it's own by passing -fno-local-float-out-top-level. ``` x = let y = e in (a,b) ===> y = e; x = (a,b) ``` Note that this is only about local floating, ie, floating two adjacent lets past each other and doesn't say anything about the global floating pass which is controlled by `-fno-float`. Fixes #13663 - - - - - 4ccefc6e by Matthew Craven at 2022-06-22T08:22:12-04:00 Check for Int overflows in Data.Array.Byte - - - - - 2004e3c8 by Matthew Craven at 2022-06-22T08:22:12-04:00 Add a basic test for ByteArray's Monoid instance - - - - - fb36770c by Matthew Craven at 2022-06-22T08:22:12-04:00 Rename `copyByteArray` to `unsafeCopyByteArray` - - - - - ecc9aedc by Ben Gamari at 2022-06-22T08:22:48-04:00 testsuite: Add test for #21719 Happily, this has been fixed since 9.2. - - - - - 19606c42 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Use lookupNameCache instead of lookupOrigIO - - - - - 4c9dfd69 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Break out thNameToGhcNameIO (ref. #21730) - - - - - eb4fb849 by Michael Peyton Jones at 2022-06-22T08:24:07-04:00 Add laws for 'toInteger' and 'toRational' CLC discussion here: https://github.com/haskell/core-libraries-committee/issues/58 - - - - - c1a950c1 by Alexander Esgen at 2022-06-22T12:36:13+00:00 Correct documentation of defaults of the `-V` RTS option - - - - - b7b7d90d by Matthew Pickering at 2022-06-22T21:58:12-04:00 Transcribe discussion from #21483 into a Note In #21483 I had a discussion with Simon Marlow about the memory retention behaviour of -Fd. I have just transcribed that conversation here as it elucidates the potentially subtle assumptions which led to the design of the memory retention behaviours of -Fd. Fixes #21483 - - - - - 980d1954 by Ben Gamari at 2022-06-22T21:58:48-04:00 eventlog: Don't leave dangling pointers hanging around Previously we failed to reset pointers to various eventlog buffers to NULL after freeing them. In principle we shouldn't look at them after they are freed but nevertheless it is good practice to set them to a well-defined value. - - - - - 575ec846 by Eric Lindblad at 2022-06-22T21:59:28-04:00 runhaskell - - - - - e6a69337 by Artem Pelenitsyn at 2022-06-22T22:00:07-04:00 re-export GHC.Natural.minusNaturalMaybe from Numeric.Natural CLC proposal: https://github.com/haskell/core-libraries-committee/issues/45 - - - - - 5d45aa97 by Gergo ERDI at 2022-06-22T22:00:46-04:00 When specialising, look through floatable ticks. Fixes #21697. - - - - - 531205ac by Andreas Klebinger at 2022-06-22T22:01:22-04:00 TagCheck.hs: Properly check if arguments are boxed types. For one by mistake I had been checking against the kind of runtime rep instead of the boxity. This uncovered another bug, namely that we tried to generate the checking code before we had associated the function arguments with a register, so this could never have worked to begin with. This fixes #21729 and both of the above issues. - - - - - c7f9f6b5 by Gleb Popov at 2022-06-22T22:02:00-04:00 Use correct arch for the FreeBSD triple in gen-data-layout.sh Downstream bug for reference: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=261798 Relevant upstream issue: #15718 - - - - - 75f0091b by Andreas Klebinger at 2022-06-22T22:02:35-04:00 Bump nofib submodule. Allows the shake runner to build with 9.2.3 among other things. Fixes #21772 - - - - - 0aa0ce69 by Ben Gamari at 2022-06-27T08:01:03-04:00 Bump ghc-prim and base versions To 0.9.0 and 4.17.0 respectively. Bumps array, deepseq, directory, filepath, haskeline, hpc, parsec, stm, terminfo, text, unix, haddock, and hsc2hs submodules. (cherry picked from commit ba47b95122b7b336ce1cc00896a47b584ad24095) - - - - - 4713abc2 by Ben Gamari at 2022-06-27T08:01:03-04:00 testsuite: Use normalise_version more consistently Previously several tests' output were unnecessarily dependent on version numbers, particularly of `base`. Fix this. - - - - - d7b0642b by Matthew Pickering at 2022-06-27T08:01:03-04:00 linters: Fix lint-submodule-refs when crashing trying to find plausible branches - - - - - 38378be3 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 hadrian: Improve haddocks for ghcDebugAssertions - - - - - ac7a7fc8 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 Don't mark lambda binders as OtherCon We used to put OtherCon unfoldings on lambda binders of workers and sometimes also join points/specializations with with the assumption that since the wrapper would force these arguments once we execute the RHS they would indeed be in WHNF. This was wrong for reasons detailed in #21472. So now we purge evaluated unfoldings from *all* lambda binders. This fixes #21472, but at the cost of sometimes not using as efficient a calling convention. It can also change inlining behaviour as some occurances will no longer look like value arguments when they did before. As consequence we also change how we compute CBV information for arguments slightly. We now *always* determine the CBV convention for arguments during tidy. Earlier in the pipeline we merely mark functions as candidates for having their arguments treated as CBV. As before the process is described in the relevant notes: Note [CBV Function Ids] Note [Attaching CBV Marks to ids] Note [Never put `OtherCon` unfoldigns on lambda binders] ------------------------- Metric Decrease: T12425 T13035 T18223 T18223 T18923 MultiLayerModulesTH_OneShot Metric Increase: WWRec ------------------------- - - - - - 06cf6f4a by Tony Zorman at 2022-06-27T08:02:18-04:00 Add suggestions for unrecognised pragmas (#21589) In case of a misspelled pragma, offer possible corrections as to what the user could have meant. Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/21589 - - - - - 3fbab757 by Greg Steuck at 2022-06-27T08:02:56-04:00 Remove the traces of i386-*-openbsd, long live amd64 OpenBSD will not ship any ghc packages on i386 starting with 7.2 release. This means there will not be a bootstrap compiler easily available. The last available binaries are ghc-8.10.6 which is already not supported as bootstrap for HEAD. See here for more information: https://marc.info/?l=openbsd-ports&m=165060700222580&w=2 - - - - - 58530271 by Bodigrim at 2022-06-27T08:03:34-04:00 Add Foldable1 and Bifoldable1 type classes Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/9 Instances roughly follow https://hackage.haskell.org/package/semigroupoids-5.3.7/docs/Data-Semigroup-Foldable-Class.html#t:Foldable1 but the API of `Foldable1` was expanded in comparison to `semigroupoids`. Compatibility shim is available from https://github.com/phadej/foldable1 (to be released). Closes #13573. - - - - - a51f4ecc by Naomi Liu at 2022-06-27T08:04:13-04:00 add levity polymorphism to addrToAny# - - - - - f4edcdc4 by Naomi Liu at 2022-06-27T08:04:13-04:00 add tests for addrToAny# levity - - - - - 07016fc9 by Matthew Pickering at 2022-06-27T08:04:49-04:00 hadrian: Update main README page This README had some quite out-of-date content about the build system so I did a complete pass deleting old material. I also made the section about flavours more prominent and mentioned flavour transformers. - - - - - 79ae2d89 by Ben Gamari at 2022-06-27T08:05:24-04:00 testsuite: Hide output from test compilations with verbosity==2 Previously the output from test compilations used to determine whether, e.g., profiling libraries are available was shown with verbosity levels >= 2. However, the default level is 2, meaning that most users were often spammed with confusing errors. Fix this by bumping the verbosity threshold for this output to >=3. Fixes #21760. - - - - - 995ea44d by Ben Gamari at 2022-06-27T08:06:00-04:00 configure: Only probe for LD in FIND_LD Since 6be2c5a7e9187fc14d51e1ec32ca235143bb0d8b we would probe for LD rather early in `configure`. However, it turns out that this breaks `configure`'s `ld`-override logic, which assumes that `LD` was set by the user and aborts. Fixes #21778. - - - - - b43d140b by Sergei Trofimovich at 2022-06-27T08:06:39-04:00 `.hs-boot` make rules: add missing order-only dependency on target directory Noticed missing target directory dependency as a build failure in `make --shuffle` mode (added in https://savannah.gnu.org/bugs/index.php?62100): "cp" libraries/base/./GHC/Stack/CCS.hs-boot libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot cp: cannot create regular file 'libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot': No such file or directory libraries/haskeline/ghc.mk:4: libraries/haskeline/dist-install/build/.depend-v-p-dyn.haskell: No such file or directory make[1]: *** [libraries/base/ghc.mk:4: libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot] Error 1 shuffle=1656129254 make: *** [Makefile:128: all] Error 2 shuffle=1656129254 Note that `cp` complains about inability to create target file. The change adds order-only dependency on a target directory (similar to the rest of rules in that file). The bug is lurking there since 2009 commit 34cc75e1a (`GHC new build system megapatch`.) where upfront directory creation was never added to `.hs-boot` files. - - - - - 57a5f88c by Ben Gamari at 2022-06-28T03:24:24-04:00 Mark AArch64/Darwin as requiring sign-extension Apple's AArch64 ABI requires that the caller sign-extend small integer arguments. Set platformCConvNeedsExtension to reflect this fact. Fixes #21773. - - - - - df762ae9 by Ben Gamari at 2022-06-28T03:24:24-04:00 -ddump-llvm shouldn't imply -fllvm Previously -ddump-llvm would change the backend used, which contrasts with all other dump flags. This is quite surprising and cost me quite a bit of time. Dump flags should not change compiler behavior. Fixes #21776. - - - - - 70f0c1f8 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Re-format argument handling logic Previously there were very long, hard to parse lines. Fix this. - - - - - 696d64c3 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Sign-extend narrow C arguments The AArch64/Darwin ABI requires that function arguments narrower than 32-bits must be sign-extended by the caller. We neglected to do this, resulting in #20735. Fixes #20735. - - - - - c006ac0d by Ben Gamari at 2022-06-28T03:24:24-04:00 testsuite: Add test for #20735 - - - - - 16b9100c by Ben Gamari at 2022-06-28T03:24:59-04:00 integer-gmp: Fix cabal file Evidently fields may not come after sections in a cabal file. - - - - - 03cc5d02 by Sergei Trofimovich at 2022-06-28T15:20:45-04:00 ghc.mk: fix 'make install' (`mk/system-cxx-std-lib-1.0.conf.install` does not exist) before the change `make install` was failing as: ``` "mv" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc-stage2" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc" make[1]: *** No rule to make target 'mk/system-cxx-std-lib-1.0.conf.install', needed by 'install_packages'. Stop. ``` I think it's a recent regression caused by 0ef249aa where `system-cxx-std-lib-1.0.conf` is created (somewhat manually), but not the .install varianlt of it. The fix is to consistently use `mk/system-cxx-std-lib-1.0.conf` everywhere. Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/21784 - - - - - eecab8f9 by Simon Peyton Jones at 2022-06-28T15:21:21-04:00 Comments only, about join points This MR just adds some documentation about why casts destroy join points, following #21716. - - - - - 251471e7 by Matthew Pickering at 2022-06-28T19:02:41-04:00 Cleanup BuiltInSyntax vs UserSyntax There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302 - - - - - 0e22f16c by Ben Gamari at 2022-06-28T19:03:16-04:00 template-haskell: Bump version to 2.19.0.0 Bumps text and exceptions submodules due to bounds. - - - - - bbe6f10e by Emily Bourke at 2022-06-29T08:23:13+00:00 Tiny tweak to `IOPort#` documentation The exclamation mark and bracket don’t seem to make sense here. I’ve looked through the history, and I don’t think they’re deliberate – possibly a copy-and-paste error. - - - - - 70e47489 by Dominik Peteler at 2022-06-29T19:26:31-04:00 Remove `CoreOccurAnal` constructor of the `CoreToDo` type It was dead code since the last occurence in an expression context got removed in 71916e1c018dded2e68d6769a2dbb8777da12664. - - - - - d0722170 by nineonine at 2022-07-01T08:15:56-04:00 Fix panic with UnliftedFFITypes+CApiFFI (#14624) When declaring foreign import using CAPI calling convention, using unlifted unboxed types would result in compiler panic. There was an attempt to fix the situation in #9274, however it only addressed some of the ByteArray cases. This patch fixes other missed cases for all prims that may be used as basic foreign types. - - - - - eb043148 by Douglas Wilson at 2022-07-01T08:16:32-04:00 rts: gc stats: account properly for copied bytes in sequential collections We were not updating the [copied,any_work,scav_find_work, max_n_todo_overflow] counters during sequential collections. As well, we were double counting for parallel collections. To fix this we add an `else` clause to the `if (is_par_gc())`. The par_* counters do not need to be updated in the sequential case because they must be 0. - - - - - f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow Enabling `-fhpc` or `-finfo-table-map` would case a tick to end up between the appliation of `neg` to its argument. This defeated the special logic which looks for `NegApp ... (HsOverLit` to warn about possible overflow if a user writes a negative literal (without out NegativeLiterals) in their code. Fixes #21701 - - - - - f25c8d03 by Matthew Pickering at 2022-07-01T19:22:31-04:00 ci: Fix definition of slow-validate flavour (so that -dlint) is passed In this embarassing sequence of events we were running slow-validate without -dlint. - - - - - bf7991b0 by Mike Pilgrem at 2022-07-02T10:12:04-04:00 Identify the extistence of the `runhaskell` command and that it is equivalent to the `runghc` command. Add an entry to the index for `runhaskell`. See https://gitlab.haskell.org/ghc/ghc/-/issues/21411 - - - - - 9e79f6d0 by Simon Jakobi at 2022-07-02T10:12:39-04:00 Data.Foldable1: Remove references to Foldable-specific note ...as discussed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8495#note_439455. - - - - - 3a8970ac by romes at 2022-07-03T14:11:31-04:00 TTG: Move HsModule to L.H.S Move the definition of HsModule defined in GHC.Hs to Language.Haskell.Syntax with an added TTG parameter and corresponding extension fields. This is progress towards having the haskell-syntax package, as described in #21592 - - - - - f9f80995 by romes at 2022-07-03T14:11:31-04:00 TTG: Move ImpExp client-independent bits to L.H.S.ImpExp Move the GHC-independent definitions from GHC.Hs.ImpExp to Language.Haskell.Syntax.ImpExp with the required TTG extension fields such as to keep the AST independent from GHC. This is progress towards having the haskell-syntax package, as described in #21592 Bumps haddock submodule - - - - - c43dbac0 by romes at 2022-07-03T14:11:31-04:00 Refactor ModuleName to L.H.S.Module.Name ModuleName used to live in GHC.Unit.Module.Name. In this commit, the definition of ModuleName and its associated functions are moved to Language.Haskell.Syntax.Module.Name according to the current plan towards making the AST GHC-independent. The instances for ModuleName for Outputable, Uniquable and Binary were moved to the module in which the class is defined because these instances depend on GHC. The instance of Eq for ModuleName is slightly changed to no longer depend on unique explicitly and instead uses FastString's instance of Eq. - - - - - 2635c6f2 by konsumlamm at 2022-07-03T14:12:11-04:00 Expand `Ord` instance for `Down` Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/23#issuecomment-1172932610 - - - - - 36fba0df by Anselm Schüler at 2022-07-04T05:06:42+00:00 Add applyWhen to Data.Function per CLC prop Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/71#issuecomment-1165830233 - - - - - 3b13aab1 by Matthew Pickering at 2022-07-04T15:15:00-04:00 hadrian: Don't read package environments in ghc-stage1 wrapper The stage1 compiler may be on the brink of existence and not have even a working base library. You may have installed packages globally with a similar stage2 compiler which will then lead to arguments such as --show-iface not even working because you are passing too many package flags. The solution is simple, don't read these implicit files. Fixes #21803 - - - - - aba482ea by Andreas Klebinger at 2022-07-04T17:55:55-04:00 Ticky:Make json info a separate field. Fixes #21233 - - - - - 74f3867d by Matthew Pickering at 2022-07-04T17:56:30-04:00 Add docs:<pkg> command to hadrian to build docs for just one package - - - - - 418afaf1 by Matthew Pickering at 2022-07-04T17:56:30-04:00 upload-docs: propagate publish correctly in upload_sdist - - - - - ed793d7a by Matthew Pickering at 2022-07-04T17:56:30-04:00 docs-upload: Fix upload script when no packages are listed - - - - - d002c6e0 by Matthew Pickering at 2022-07-04T17:56:30-04:00 hadrian: Add --haddock-base-url option for specifying base-url when generating docs The motiviation for this flag is to be able to produce documentation which is suitable for uploading for hackage, ie, the cross-package links work correctly. There are basically three values you want to set this to: * off - default, base_url = ../%pkg% which works for local browsing * on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload * on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation. The `%pkg%` string is a template variable which is replaced with the package identifier for the relevant package. This is one step towards fixing #21749 - - - - - 41eb749a by Matthew Pickering at 2022-07-04T17:56:31-04:00 Add nightly job for generating docs suitable for hackage upload - - - - - 620ee7ed by Matthew Pickering at 2022-07-04T17:57:05-04:00 ghci: Support :set prompt in multi repl This adds supports for various :set commands apart from `:set <FLAG>` in multi repl, this includes `:set prompt` and so-on. Fixes #21796 - - - - - b151b65e by Matthew Pickering at 2022-07-05T16:32:31-04:00 Vendor filepath inside template-haskell Adding filepath as a dependency of template-haskell means that it can't be reinstalled if any build-plan depends on template-haskell. This is a temporary solution for the 9.4 release. A longer term solution is to split-up the template-haskell package into the wired-in part and a non-wired-in part which can be reinstalled. This was deemed quite risky on the 9.4 release timescale. Fixes #21738 - - - - - c9347ecf by John Ericson at 2022-07-05T16:33:07-04:00 Factor fields of `CoreDoSimplify` into separate data type This avoids some partiality. The work @mmhat is doing cleaning up and modularizing `Core.Opt` will build on this nicely. - - - - - d0e74992 by Eric Lindblad at 2022-07-06T01:35:48-04:00 https urls - - - - - 803e965c by Eric Lindblad at 2022-07-06T01:35:48-04:00 options and typos - - - - - 5519baa5 by Eric Lindblad at 2022-07-06T01:35:48-04:00 grammar - - - - - 4ddc1d3e by Eric Lindblad at 2022-07-06T01:35:48-04:00 sources - - - - - c95c2026 by Matthew Pickering at 2022-07-06T01:35:48-04:00 Fix lint warnings in bootstrap.py - - - - - 86ced2ad by romes at 2022-07-06T01:36:23-04:00 Restore Eq instance of ImportDeclQualifiedStyle Fixes #21819 - - - - - 3547e264 by romes at 2022-07-06T13:50:27-04:00 Prune L.H.S modules of GHC dependencies Move around datatypes, functions and instances that are GHC-specific out of the `Language.Haskell.Syntax.*` modules to reduce the GHC dependencies in them -- progressing towards #21592 Creates a module `Language.Haskell.Syntax.Basic` to hold basic definitions required by the other L.H.S modules (and don't belong in any of them) - - - - - e4eea07b by romes at 2022-07-06T13:50:27-04:00 TTG: Move CoreTickish out of LHS.Binds Remove the `[CoreTickish]` fields from datatype `HsBindLR idL idR` and move them to the extension point instance, according to the plan outlined in #21592 to separate the base AST from the GHC specific bits. - - - - - acc1816b by romes at 2022-07-06T13:50:27-04:00 TTG for ForeignImport/Export Add a TTG parameter to both `ForeignImport` and `ForeignExport` and, according to #21592, move the GHC-specific bits in them and in the other AST data types related to foreign imports and exports to the TTG extension point. - - - - - 371c5ecf by romes at 2022-07-06T13:50:27-04:00 TTG for HsTyLit Add TTG parameter to `HsTyLit` to move the GHC-specific `SourceText` fields to the extension point and out of the base AST. Progress towards #21592 - - - - - fd379d1b by romes at 2022-07-06T13:50:27-04:00 Remove many GHC dependencies from L.H.S Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC imports according to the plan in the linked issue. Moves more GHC-specific declarations to `GHC.*` and brings more required GHC-independent declarations to `Language.Haskell.Syntax.*` (extending e.g. `Language.Haskell.Syntax.Basic`). Progress towards #21592 Bump haddock submodule for !8308 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - c5415bc5 by Alan Zimmerman at 2022-07-06T13:50:27-04:00 Fix exact printing of the HsRule name Prior to this branch, the HsRule name was XRec pass (SourceText,RuleName) and there is an ExactPrint instance for (SourceText, RuleName). The SourceText has moved to a different location, so synthesise the original to trigger the correct instance when printing. We need both the SourceText and RuleName when exact printing, as it is possible to have a NoSourceText variant, in which case we fall back to the FastString. - - - - - 665fa5a7 by Matthew Pickering at 2022-07-06T13:51:03-04:00 driver: Fix issue with module loops and multiple home units We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 - - - - - bbcaba6a by Andreas Klebinger at 2022-07-06T13:51:39-04:00 Remove a bogus #define from ClosureMacros.h - - - - - fa59223b by Tamar Christina at 2022-07-07T23:23:57-04:00 winio: make consoleReadNonBlocking not wait for any events at all. - - - - - 42c917df by Adam Sandberg Ericsson at 2022-07-07T23:24:34-04:00 rts: allow NULL to be used as an invalid StgStablePtr - - - - - 3739e565 by Andreas Schwab at 2022-07-07T23:25:10-04:00 RTS: Add stack marker to StgCRunAsm.S Every object file must be properly marked for non-executable stack, even if it contains no code. - - - - - a889bc05 by Ben Gamari at 2022-07-07T23:25:45-04:00 Bump unix submodule Adds `config.sub` to unix's `.gitignore`, fixing #19574. - - - - - 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode The most egrarious thing this fixes is the report about the total number of loaded modules after starting a session. Ticket #20889 - - - - - fc183c90 by Matthew Pickering at 2022-07-09T11:11:58-04:00 Enable :edit command in ghci multi-mode. This works after the last change to isLoaded. Ticket #20888 - - - - - 46050534 by Simon Peyton Jones at 2022-07-09T11:12:34-04:00 Fix a scoping bug in the Specialiser In the call to `specLookupRule` in `already_covered`, in `specCalls`, we need an in-scope set that includes the free vars of the arguments. But we simply were not guaranteeing that: did not include the `rule_bndrs`. Easily fixed. I'm not sure how how this bug has lain for quite so long without biting us. Fixes #21828. - - - - - 6e8d9056 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Edit Note [idArity varies independently of dmdTypeDepth] ...and refer to it in GHC.Core.Lint.lintLetBind. Fixes #21452 - - - - - 89ba4655 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Tiny documentation wibbles (comments only) - - - - - 61a46c6d by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix readme - - - - - 61babb5e by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix bootstrap - - - - - 8b417ad5 by Eric Lindblad at 2022-07-13T08:28:29-04:00 tarball - - - - - e9d9f078 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Fix scopes for deriving clauses and instance signatures (#18425) - - - - - c4989131 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Record location of filled in default method bindings This is useful for hie files to reconstruct the evidence that default methods depend on. - - - - - 9c52e7fc by Zubin Duggal at 2022-07-13T14:00:18-04:00 testsuite: Factor out common parts from hiefile tests - - - - - 6a9e4493 by sheaf at 2022-07-13T14:00:56-04:00 Hadrian: update documentation of settings The documentation for key-value settings was a bit out of date. This patch updates it to account for `cabal.configure.opts` and `hsc2hs.run.opts`. The user-settings document was also re-arranged, to make the key-value settings more prominent (as it doesn't involve changing the Hadrian source code, and thus doesn't require any recompilation of Hadrian). - - - - - a2f142f8 by Zubin Duggal at 2022-07-13T20:43:32-04:00 Fix potential space leak that arise from ModuleGraphs retaining references to previous ModuleGraphs, in particular the lazy `mg_non_boot` field. This manifests in `extendMG`. Solution: Delete `mg_non_boot` as it is only used for `mgLookupModule`, which is only called in two places in the compiler, and should only be called at most once for every home unit: GHC.Driver.Make: mainModuleSrcPath :: Maybe String mainModuleSrcPath = do ms <- mgLookupModule mod_graph (mainModIs hue) ml_hs_file (ms_location ms) GHCI.UI: listModuleLine modl line = do graph <- GHC.getModuleGraph let this = GHC.mgLookupModule graph modl Instead `mgLookupModule` can be a linear function that looks through the entire list of `ModuleGraphNodes` Fixes #21816 - - - - - dcf8b30a by Ben Gamari at 2022-07-13T20:44:08-04:00 rts: Fix AdjustorPool bitmap manipulation Previously the implementation of bitmap_first_unset assumed that `__builtin_clz` would accept `uint8_t` however it apparently rather extends its argument to `unsigned int`. To fix this we simply revert to a naive implementation since handling the various corner cases with `clz` is quite tricky. This should be fine given that AdjustorPool isn't particularly hot. Ideally we would have a single, optimised bitmap implementation in the RTS but I'll leave this for future work. Fixes #21838. - - - - - ad8f3e15 by Luite Stegeman at 2022-07-16T07:20:36-04:00 Change GHCi bytecode return convention for unlifted datatypes. This changes the bytecode return convention for unlifted algebraic datatypes to be the same as for lifted types, i.e. ENTER/PUSH_ALTS instead of RETURN_UNLIFTED/PUSH_ALTS_UNLIFTED Fixes #20849 - - - - - 5434d1a3 by Colten Webb at 2022-07-16T07:21:15-04:00 Compute record-dot-syntax types Ensures type information for record-dot-syntax is included in HieASTs. See #21797 - - - - - 89d169ec by Colten Webb at 2022-07-16T07:21:15-04:00 Add record-dot-syntax test - - - - - 4beb9f3c by Ben Gamari at 2022-07-16T07:21:51-04:00 Document RuntimeRep polymorphism limitations of catch#, et al As noted in #21868, several primops accepting continuations producing RuntimeRep-polymorphic results aren't nearly as polymorphic as their types suggest. Document this limitation and adapt the `UnliftedWeakPtr` test to avoid breaking this limitation in `keepAlive#`. - - - - - 4ef1c65d by Ben Gamari at 2022-07-16T07:21:51-04:00 Make keepAlive# out-of-line This is a naive approach to fixing the unsoundness noticed in #21708. Specifically, we remove the lowering of `keepAlive#` via CorePrep and instead turn it into an out-of-line primop. This is simple, inefficient (since the continuation must now be heap allocated), but good enough for 9.4.1. We will revisit this (particiularly via #16098) in a future release. Metric Increase: T4978 T7257 T9203 - - - - - 1bbff35d by Greg Steuck at 2022-07-16T07:22:29-04:00 Suppress extra output from configure check for c++ libraries - - - - - 3acbd7ad by Ben Gamari at 2022-07-16T07:23:04-04:00 rel-notes: Drop mention of #21745 fix Since we have backported the fix to 9.4.1. - - - - - b27c2774 by Dominik Peteler at 2022-07-16T07:23:43-04:00 Align the behaviour of `dopt` and `log_dopt` Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861 - - - - - 28347d71 by Douglas Wilson at 2022-07-16T13:25:06-04:00 rts: forkOn context switches the target capability Fixes #21824 - - - - - f1c44991 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Eliminate orphan Outputable instances Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and `OutputableP` instances for the Cmm AST. This makes it significantly easier to use the Cmm pretty-printers in tracing output without incurring module import cycles. - - - - - f2e5e763 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Move toBlockList to GHC.Cmm - - - - - fa092745 by Ben Gamari at 2022-07-16T13:25:41-04:00 compiler: Add haddock sections to GHC.Utils.Panic - - - - - 097759f9 by Ben Gamari at 2022-07-16T13:26:17-04:00 configure: Don't override Windows CXXFLAGS At some point we used the clang distribution from msys2's `MINGW64` environment for our Windows toolchain. This defaulted to using libgcc and libstdc++ for its runtime library. However, we found for a variety of reasons that compiler-rt, libunwind, and libc++ were more reliable, consequently we explicitly overrode the CXXFLAGS to use these. However, since then we have switched to use the `CLANG64` packaging, which default to these already. Consequently we can drop these arguments, silencing some redundant argument warnings from clang. Fixes #21669. - - - - - e38a2684 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Check that there are no NULL ctors - - - - - 616365b0 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Introduce support for invoking finalizers on unload Addresses #20494. - - - - - cdd3be20 by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add T20494 - - - - - 03c69d8d by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Rename finit field to fini fini is short for "finalizer", which does not contain a "t". - - - - - 033580bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Refactor handling of oc->info Previously we would free oc->info after running initializers. However, we can't do this is we want to also run finalizers. Moreover, freeing oc->info so early was wrong for another reason: we will need it in order to unregister the exception tables (see the call to `RtlDeleteFunctionTable`). In service of #20494. - - - - - f17912e4 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Add finalization support This implements #20494 for the PEi386 linker. Happily, this also appears to fix `T9405`, resolving #21361. - - - - - 2cd75550 by Ben Gamari at 2022-07-16T23:50:36-04:00 Loader: Implement gnu-style -l:$path syntax Gnu ld allows `-l` to be passed an absolute file path, signalled by a `:` prefix. Implement this in the GHC's loader search logic. - - - - - 5781a360 by Ben Gamari at 2022-07-16T23:50:36-04:00 Statically-link against libc++ on Windows Unfortunately on Windows we have no RPATH-like facility, making dynamic linking extremely fragile. Since we cannot assume that the user will add their GHC installation to `$PATH` (and therefore their DLL search path) we cannot assume that the loader will be able to locate our `libc++.dll`. To avoid this, we instead statically link against `libc++.a` on Windows. Fixes #21435. - - - - - 8e2e883b by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Ensure that all .ctors/.dtors sections are run It turns out that PE objects may have multiple `.ctors`/`.dtors` sections but the RTS linker had assumed that there was only one. Fix this. Fixes #21618. - - - - - fba04387 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Respect dtor/ctor priority Previously we would run constructors and destructors in arbitrary order despite explicit priorities. Fixes #21847. - - - - - 1001952f by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add test for #21618 and #21847 - - - - - 6f3816af by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Fix exception unwind unregistration RtlDeleteFunctionTable expects a pointer to the .pdata section yet we passed it the .xdata section. Happily, this fixes #21354. - - - - - d9bff44c by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Drop dead code - - - - - d161e6bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Use section flags to identify initializers - - - - - fbb17110 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Introduce finalizer support - - - - - 5b0ed8a8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Use system-cxx-std-lib instead of config.stdcxx_impl - - - - - 6c476e1a by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker/Elf: Work around GCC 6 init/fini behavior It appears that GCC 6t (at least on i386) fails to give init_array/fini_array sections the correct SHT_INIT_ARRAY/SHT_FINI_ARRAY section types, instead marking them as SHT_PROGBITS. This caused T20494 to fail on Debian. - - - - - 5f8203b8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Mark T13366Cxx as unbroken on Darwin - - - - - 1fd2f851 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Fix resolution of __dso_handle on Darwin Darwin expects a leading underscore. - - - - - a2dc00f3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Clean up section kinds - - - - - aeb1a7c3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Ensure that __cxa_finalize is called on code unload - - - - - 028f081e by Ben Gamari at 2022-07-16T23:51:12-04:00 testsuite: Fix T11829 on Centos 7 It appears that Centos 7 has a more strict C++ compiler than most distributions since std::runtime_error is defined in <stdexcept> rather than <exception>. In T11829 we mistakenly imported the latter. - - - - - a10584e8 by Ben Gamari at 2022-07-17T22:30:32-04:00 hadrian: Rename documentation directories for consistency with make * Rename `docs` to `doc` * Place pdf documentation in `doc/` instead of `doc/pdfs/` Fixes #21164. - - - - - b27c5947 by Anselm Schüler at 2022-07-17T22:31:11-04:00 Fix incorrect proof of applyWhen’s properties - - - - - eb031a5b by Matthew Pickering at 2022-07-18T08:04:47-04:00 hadrian: Add multi:<pkg> and multi targets for starting a multi-repl This patch adds support to hadrian for starting a multi-repl containing all the packages which stage0 can build. In particular, there is the new user-facing command: ``` ./hadrian/ghci-multi ``` which when executed will start a multi-repl containing the `ghc` package and all it's dependencies. This is implemented by two new hadrian targets: ``` ./hadrian/build multi:<pkg> ``` Construct the arguments for a multi-repl session where the top-level package is <pkg>. For example, `./hadrian/ghci-multi` is implemented using `multi:ghc` target. There is also the `multi` command which constructs a repl for everything in stage0 which we can build. - - - - - 19e7cac9 by Eric Lindblad at 2022-07-18T08:05:27-04:00 changelog typo - - - - - af6731a4 by Eric Lindblad at 2022-07-18T08:05:27-04:00 typos - - - - - 415468fe by Simon Peyton Jones at 2022-07-18T16:36:54-04:00 Refactor SpecConstr to use treat bindings uniformly This patch, provoked by #21457, simplifies SpecConstr by treating top-level and nested bindings uniformly (see the new scBind). * Eliminates the mysterious scTopBindEnv * Refactors scBind to handle top-level and nested definitions uniformly. * But, for now at least, continues the status quo of not doing SpecConstr for top-level non-recursive bindings. (In contrast we do specialise nested non-recursive bindings, although the original paper did not; see Note [Local let bindings].) I tried the effect of specialising top-level non-recursive bindings (which is now dead easy to switch on, unlike before) but found some regressions, so I backed off. See !8135. It's a pure refactoring. I think it'll do a better job in a few cases, but there is no regression test. - - - - - d4d3fe6e by Andreas Klebinger at 2022-07-18T16:37:29-04:00 Rule matching: Don't compute the FVs if we don't look at them. - - - - - 5f907371 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 White space only in FamInstEnv - - - - - ae3b3b62 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make transferPolyIdInfo work for CPR I don't know why this hasn't bitten us before, but it was plain wrong. - - - - - 9bdfdd98 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Inline mapAccumLM This function is called in inner loops in the compiler, and it's overloaded and higher order. Best just to inline it. This popped up when I was looking at something else. I think perhaps GHC is delicately balanced on the cusp of inlining this automatically. - - - - - d0b806ff by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make SetLevels honour floatConsts This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though. - - - - - d1c25a48 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Refactor wantToUnboxArg a bit * Rename GHC.Core.Opt.WorkWrap.Utils.wantToUnboxArg to canUnboxArg and similarly wantToUnboxResult to canUnboxResult. * Add GHC.Core.Opt.DmdAnal.wantToUnboxArg as a wrapper for the (new) GHC.Core.Opt.WorkWrap.Utils.canUnboxArg, avoiding some yukky duplication. I decided it was clearer to give it a new data type for its return type, because I nedeed the FD_RecBox case which was not otherwise readiliy expressible. * Add dcpc_args to WorkWrap.Utils.DataConPatContext for the payload * Get rid of the Unlift constructor of UnboxingDecision, eliminate two panics, and two arguments to canUnboxArg (new name). Much nicer now. - - - - - 6d8a715e by Teo Camarasu at 2022-07-18T16:38:44-04:00 Allow running memInventory when the concurrent nonmoving gc is enabled If the nonmoving gc is enabled and we are using a threaded RTS, we now try to grab the collector mutex to avoid memInventory and the collection racing. Before memInventory was disabled. - - - - - aa75bbde by Ben Gamari at 2022-07-18T16:39:20-04:00 gitignore: don't ignore all aclocal.m4 files While GHC's own aclocal.m4 is generated by the aclocal tool, other packages' aclocal.m4 are committed in the repository. Previously `.gitignore` included an entry which covered *any* file named `aclocal.m4`, which lead to quite some confusion (e.g. see #21740). Fix this by modifying GHC's `.gitignore` to only cover GHC's own `aclocal.m4`. - - - - - 4b98c5ce by Boris Lykah at 2022-07-19T02:34:12-04:00 Add mapAccumM, forAccumM to Data.Traversable Approved by Core Libraries Committee in https://github.com/haskell/core-libraries-committee/issues/65#issuecomment-1186275433 - - - - - bd92182c by Ben Gamari at 2022-07-19T02:34:47-04:00 configure: Use AC_PATH_TOOL to detect tools Previously we used AC_PATH_PROG which, as noted by #21601, does not look for tools with a target prefix, breaking cross-compilation. Fixes #21601. - - - - - e8c07aa9 by Matthew Pickering at 2022-07-19T10:07:53-04:00 driver: Fix implementation of -S We were failing to stop before running the assembler so the object file was also created. Fixes #21869 - - - - - e2f0094c by Ben Gamari at 2022-07-19T10:08:28-04:00 rts/ProfHeap: Ensure new Censuses are zeroed When growing the Census array ProfHeap previously neglected to zero the new part of the array. Consequently `freeEra` would attempt to free random words that often looked suspiciously like pointers. Fixes #21880. - - - - - 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 51ffd009 by Swann Moreau at 2022-08-19T18:29:21-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-04:00 hadrian: Don't duplicate binaries on installation Previously we used `install` on symbolic links, which ended up copying the target file rather than installing a symbolic link. Fixes #22062. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. * And finally, it was the strange treatment of join-point Ids in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 15111af6 by Zubin Duggal at 2022-09-01T01:18:50-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 7d3a055d by Krzysztof Gogolewski at 2022-09-01T01:19:26-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 31a8989a by Tommy Bidne at 2022-09-01T12:01:20-04:00 Change Ord defaults per CLC proposal Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/24#issuecomment-1233331267 - - - - - 7f527f01 by Matthew Pickering at 2022-09-01T12:01:56-04:00 Fix bootstrap with ghc-9.0 It turns out Solo is a very recent addition to base, so for older GHC versions we just defined it inline here the one place we use it in the compiler. - - - - - d2be80fd by Sebastian Graf at 2022-09-05T23:12:14-04:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 25f68ace by Ben Gamari at 2022-09-05T23:12:50-04:00 gitlab-ci: Ensure that ghc derivation is in scope Previously the lint-ci job attempted to use cabal-install (specifically `cabal update`) without a GHC in PATH. However, cabal-install-3.8 appears to want GHC, even for `cabal update`. - - - - - f37b621f by sheaf at 2022-09-06T11:51:53+00:00 Update instances.rst, clarifying InstanceSigs Fixes #22103 - - - - - d4f908f7 by Jan Hrček at 2022-09-06T15:36:58-04:00 Fix :add docs in user guide - - - - - 808bb793 by Cheng Shao at 2022-09-06T15:37:35-04:00 ci: remove unused build_make/test_make in ci script - - - - - d0a2efb2 by Eric Lindblad at 2022-09-07T16:42:45-04:00 typo - - - - - fac0098b by Eric Lindblad at 2022-09-07T16:42:45-04:00 typos - - - - - a581186f by Eric Lindblad at 2022-09-07T16:42:45-04:00 whitespace - - - - - 04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00 CmmToAsm: remove unused ModLocation from NatM_State - - - - - ee1cfaa9 by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Minor SDoc cleanup Change calls to renderWithContext with showSDocOneLine; it's more efficient and explanatory. Remove polyPatSig (unused) - - - - - 7918265d by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Remove Outputable Char instance Use 'text' instead of 'ppr'. Using 'ppr' on the list "hello" rendered as "h,e,l,l,o". - - - - - 77209ab3 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Export liftA2 from Prelude Changes: In order to be warning free and compatible, we hide Applicative(..) from Prelude in a few places and instead import it directly from Control.Applicative. Please see the migration guide at https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md for more details. This means that Applicative is now exported in its entirety from Prelude. Motivation: This change is motivated by a few things: * liftA2 is an often used function, even more so than (<*>) for some people. * When implementing Applicative, the compiler will prompt you for either an implementation of (<*>) or of liftA2, but trying to use the latter ends with an error, without further imports. This could be confusing for newbies. * For teaching, it is often times easier to introduce liftA2 first, as it is a natural generalisation of fmap. * This change seems to have been unanimously and enthusiastically accepted by the CLC members, possibly indicating a lot of love for it. * This change causes very limited breakage, see the linked issue below for an investigation on this. See https://github.com/haskell/core-libraries-committee/issues/50 for the surrounding discussion and more details. - - - - - 442a94e8 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Add changelog entry for liftA2 export from Prelude - - - - - fb968680 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule containers to one with liftA2 warnings fixed - - - - - f54ff818 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule Cabal to one with liftA2 warnings fixed - - - - - a4b34808 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Isolate some Applicative hidings to GHC.Prelude By reexporting the entirety of Applicative from GHC.Prelude, we can save ourselves some `hiding` and importing of `Applicative` in consumers of GHC.Prelude. This also has the benefit of isolating this type of change to GHC.Prelude, so that people in the future don't have to think about it. - - - - - 9c4ea90c by Cheng Shao at 2022-09-08T17:49:47-04:00 CmmToC: enable 64-bit CallishMachOp on 32-bit targets Normally, the unregisterised builds avoid generating 64-bit CallishMachOp in StgToCmm, so CmmToC doesn't support these. However, there do exist cases where we'd like to invoke cmmToC for other cmm inputs which may contain such CallishMachOps, and it's a rather low effort to add support for these since they only require calling into existing ghc-prim cbits. - - - - - 04062510 by Alexis King at 2022-09-11T11:30:32+02:00 Add native delimited continuations to the RTS This patch implements GHC proposal 313, "Delimited continuation primops", by adding native support for delimited continuations to the GHC RTS. All things considered, the patch is relatively small. It almost exclusively consists of changes to the RTS; the compiler itself is essentially unaffected. The primops come with fairly extensive Haddock documentation, and an overview of the implementation strategy is given in the Notes in rts/Continuation.c. This first stab at the implementation prioritizes simplicity over performance. Most notably, every continuation is always stored as a single, contiguous chunk of stack. If one of these chunks is particularly large, it can result in poor performance, as the current implementation does not attempt to cleverly squeeze a subset of the stack frames into the existing stack: it must fit all at once. If this proves to be a performance issue in practice, a cleverer strategy would be a worthwhile target for future improvements. - - - - - ee471dfb by Cheng Shao at 2022-09-12T07:07:33-04:00 rts: fix missing dirty_MVAR argument in stg_writeIOPortzh - - - - - a5f9c35f by Cheng Shao at 2022-09-12T13:29:05-04:00 ci: enable parallel compression for xz - - - - - 3a815f30 by Ryan Scott at 2022-09-12T13:29:41-04:00 Windows: Always define _UCRT when compiling C code As seen in #22159, this is required to ensure correct behavior when MinGW-w64 headers are in the `C_INCLUDE_PATH`. Fixes #22159. - - - - - 65a0bd69 by sheaf at 2022-09-13T10:27:52-04:00 Add diagnostic codes This MR adds diagnostic codes, assigning unique numeric codes to error and warnings, e.g. error: [GHC-53633] Pattern match is redundant This is achieved as follows: - a type family GhcDiagnosticCode that gives the diagnostic code for each diagnostic constructor, - a type family ConRecursInto that specifies whether to recur into an argument of the constructor to obtain a more fine-grained code (e.g. different error codes for different 'deriving' errors), - generics machinery to generate the value-level function assigning each diagnostic its error code; see Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. The upshot is that, to add a new diagnostic code, contributors only need to modify the two type families mentioned above. All logic relating to diagnostic codes is thus contained to the GHC.Types.Error.Codes module, with no code duplication. This MR also refactors error message datatypes a bit, ensuring we can derive Generic for them, and cleans up the logic around constraint solver reports by splitting up 'TcSolverReportInfo' into separate datatypes (see #20772). Fixes #21684 - - - - - 362cca13 by sheaf at 2022-09-13T10:27:53-04:00 Diagnostic codes: acccept test changes The testsuite output now contains diagnostic codes, so many tests need to be updated at once. We decided it was best to keep the diagnostic codes in the testsuite output, so that contributors don't inadvertently make changes to the diagnostic codes. - - - - - 08f6730c by Adam Gundry at 2022-09-13T10:28:29-04:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - c14370d7 by Cheng Shao at 2022-09-13T10:29:07-04:00 ci: remove unused appveyor config - - - - - dc6af9ed by Cheng Shao at 2022-09-13T10:29:45-04:00 compiler: remove unused lazy state monad - - - - - 646d15ad by Eric Lindblad at 2022-09-14T03:13:56-04:00 Fix typos This fixes various typos and spelling mistakes in the compiler. Fixes #21891 - - - - - 7d7e71b0 by Matthew Pickering at 2022-09-14T03:14:32-04:00 hadrian: Bump index state This bumps the index state so a build plan can also be found when booting with 9.4. Fixes #22165 - - - - - 98b62871 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - b42cedbe by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6515c32b by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - e470e91f by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - c4438347 by Matthew Pickering at 2022-09-14T17:17:04-04:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 71d8db86 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add extra implicit dependencies from DeriveLift ghc -M should know that modules which use DeriveLift (or TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have to add these extra edges manually or the modules will be compiled before TH.Lib.Internal is compiled which leads to a desugarer error. - - - - - 43e574f0 by Greg Steuck at 2022-09-14T17:17:43-04:00 Repair c++ probing on OpenBSD Failure without this change: ``` checking C++ standard library flavour... libc++ checking for linkage against 'c++ c++abi'... failed checking for linkage against 'c++ cxxrt'... failed configure: error: Failed to find C++ standard library ``` - - - - - 534b39ee by Douglas Wilson at 2022-09-14T17:18:21-04:00 libraries: template-haskell: vendor filepath differently Vendoring with ../ in hs-source-dirs prevents upload to hackage. (cherry picked from commit 1446be7586ba70f9136496f9b67f792955447842) - - - - - bdd61cd6 by M Farkas-Dyck at 2022-09-14T22:39:34-04:00 Unbreak Hadrian with Cabal 3.8. - - - - - df04d6ec by Krzysztof Gogolewski at 2022-09-14T22:40:09-04:00 Fix typos - - - - - d6ea8356 by Andreas Klebinger at 2022-09-15T10:12:41+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 7cce7007 by Andreas Klebinger at 2022-09-15T10:12:42+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 88c4cbdb by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: enable -fprof-late only for profiling ways - - - - - d7235831 by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: add late_ccs flavour transformer - - - - - ce203753 by Cheng Shao at 2022-09-16T13:58:34-04:00 configure: remove unused program checks - - - - - 9b4c1056 by Pierre Le Marre at 2022-09-16T13:59:16-04:00 Update to Unicode 15.0 - - - - - c6e9b89a by Bodigrim at 2022-09-16T13:59:55-04:00 Avoid partial head and tail in ghc-heap; replace with total pattern-matching - - - - - 616afde3 by Cheng Shao at 2022-09-16T14:00:33-04:00 hadrian: relax Cabal upper bound to allow building with Cabal-3.8 A follow up of !8910. - - - - - df35d994 by Alexis King at 2022-09-16T14:01:11-04:00 Add links to the continuations haddocks in the docs for each primop fixes #22176 - - - - - 383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 5031bf49 by sheaf at 2022-09-16T21:42:49-04:00 Hadrian: Don't try to build terminfo on Windows Commit b42cedbe introduced a dependency on terminfo on Windows, but that package isn't available on Windows. - - - - - c9afe221 by M Farkas-Dyck at 2022-09-17T06:44:47-04:00 Clean up some. In particular: • Delete some dead code, largely under `GHC.Utils`. • Clean up a few definitions in `GHC.Utils.(Misc, Monad)`. • Clean up `GHC.Types.SrcLoc`. • Derive stock `Functor, Foldable, Traversable` for more types. • Derive more instances for newtypes. Bump haddock submodule. - - - - - 85431ac3 by Cheng Shao at 2022-09-17T06:45:25-04:00 driver: pass original Cmm filename in ModLocation When compiling Cmm, the ml_hs_file field is used to indicate Cmm filename when later generating DWARF information. We should pass the original filename here, otherwise for preprocessed Cmm files, the filename will be a temporary filename which is confusing. - - - - - 63aa0069 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: remove legacy logging cabal flag - - - - - bd0f4184 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: make threaded ways optional For certain targets (e.g. wasm32-wasi), the threaded rts is known not to work. This patch adds a "threaded" cabal flag to rts to make threaded rts ways optional. Hadrian enables this flag iff the flavour rtsWays contains threaded ways. - - - - - 8a666ad2 by Ryan Scott at 2022-09-18T08:00:44-04:00 DeriveFunctor: Check for last type variables using dataConUnivTyVars Previously, derived instances of `Functor` (as well as the related classes `Foldable`, `Traversable`, and `Generic1`) would determine which constraints to infer by checking for fields that contain the last type variable. The problem was that this last type variable was taken from `tyConTyVars`. For GADTs, the type variables in each data constructor are _not_ the same type variables as in `tyConTyVars`, leading to #22167. This fixes the issue by instead checking for the last type variable using `dataConUnivTyVars`. (This is very similar in spirit to the fix for #21185, which also replaced an errant use of `tyConTyVars` with type variables from each data constructor.) Fixes #22167. - - - - - 78037167 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: pass updated buffer to actions (#22201) In the lexer, predicates have the following type: { ... } :: user -- predicate state -> AlexInput -- input stream before the token -> Int -- length of the token -> AlexInput -- input stream after the token -> Bool -- True <=> accept the token This is documented in the Alex manual. There is access to the input stream both before and after the token. But when the time comes to construct the token, GHC passes only the initial string buffer to the lexer action. This patch fixes it: - type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token) + type Action = PsSpan -> StringBuffer -> Int -> StringBuffer -> P (PsLocated Token) Now lexer actions have access to the string buffer both before and after the token, just like the predicates. It's just a matter of passing an additional function parameter throughout the lexer. - - - - - 75746594 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: define varsym without predicates (#22201) Before this patch, the varsym lexing rules were defined as follows: <0> { @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix } @varsym / { followedByOpeningToken } { varsym_prefix } @varsym / { precededByClosingToken } { varsym_suffix } @varsym { varsym_loose_infix } } Unfortunately, this meant that the predicates 'precededByClosingToken' and 'followedByOpeningToken' were recomputed several times before we could figure out the whitespace context. With this patch, we check for whitespace context directly in the lexer action: <0> { @varsym { with_op_ws varsym } } The checking for opening/closing tokens happens in 'with_op_ws' now, which is part of the lexer action rather than the lexer predicate. - - - - - c1f81b38 by M Farkas-Dyck at 2022-09-19T09:07:05-04:00 Scrub partiality about `NewOrData`. Rather than a list of constructors and a `NewOrData` flag, we define `data DataDefnCons a = NewTypeCon a | DataTypeCons [a]`, which enforces a newtype to have exactly one constructor. Closes #22070. Bump haddock submodule. - - - - - 1e1ed8c5 by Cheng Shao at 2022-09-19T09:07:43-04:00 CmmToC: emit __builtin_unreachable() after noreturn ccalls Emit a __builtin_unreachable() call after a foreign call marked as CmmNeverReturns. This is crucial to generate correctly typed code for wasm; as for other archs, this is also beneficial for the C compiler optimizations. - - - - - 19f45a25 by Jan Hrček at 2022-09-20T03:49:29-04:00 Document :unadd GHCi command in user guide - - - - - 545ff490 by sheaf at 2022-09-20T03:50:06-04:00 Hadrian: merge archives even in stage 0 We now always merge .a archives when ar supports -L. This change is necessary in order to bootstrap GHC using GHC 9.4 on Windows, as nested archives aren't supported. Not doing so triggered bug #21990 when trying to use the Win32 package, with errors such as: Not a x86_64 PE+ file. Unknown COFF 4 type in getHeaderInfo. ld.lld: error: undefined symbol: Win32zm2zi12zi0zi0_SystemziWin32ziConsoleziCtrlHandler_withConsoleCtrlHandler1_info We have to be careful about which ar is meant: in stage 0, the check should be done on the system ar (system-ar in system.config). - - - - - 59fe128c by Vladislav Zavialov at 2022-09-20T03:50:42-04:00 Fix -Woperator-whitespace for consym (part of #19372) Due to an oversight, the initial specification and implementation of -Woperator-whitespace focused on varsym exclusively and completely ignored consym. This meant that expressions such as "x+ y" would produce a warning, while "x:+ y" would not. The specification was corrected in ghc-proposals pull request #404, and this patch updates the implementation accordingly. Regression test included. - - - - - c4c2cca0 by John Ericson at 2022-09-20T13:11:49-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 7beb356e by John Ericson at 2022-09-20T13:11:50-04:00 Relax instances for Functor combinators; put superclass on Class1 and Class2 to make non-breaking This change is approved by the Core Libraries commitee in https://github.com/haskell/core-libraries-committee/issues/10 The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 6a8c6b5e by Tom Ellis at 2022-09-20T13:12:27-04:00 Add notes to ghc-prim Haddocks that users should not import it - - - - - ee9d0f5c by matoro at 2022-09-20T13:13:06-04:00 docs: clarify that LLVM codegen is not available in unregisterised mode The current docs are misleading and suggest that it is possible to use LLVM codegen from an unregisterised build. This is not the case; attempting to pass `-fllvm` to an unregisterised build warns: ``` when making flags consistent: warning: Target platform uses unregisterised ABI, so compiling via C ``` and uses the C codegen anyway. - - - - - 854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00 rts: remove copy-paste error from `cabal.rts.in` This was, likely accidentally, introduced in 4bf542bf1c. See: 4bf542bf1cdf2fa468457fc0af21333478293476 - - - - - c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00 hadrian: Add extra_dependencies edges for all different ways The hack to add extra dependencies needed by DeriveLift extension missed the cases for profiles and dynamic ways. For the profiled way this leads to errors like: ``` GHC error in desugarer lookup in Data.IntSet.Internal: Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’ Perhaps you haven't installed the profiling libraries for package ‘template-haskell’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. ghc: panic! (the 'impossible' happened) GHC version 9.5.20220916: initDs ``` Therefore the fix is to add these extra edges in. Fixes #22197 - - - - - a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00 users-guide: fix incorrect ghcappdata folder for unix and windows - - - - - 06ccad0d by sheaf at 2022-09-21T08:28:49-04:00 Don't use isUnliftedType in isTagged The function GHC.Stg.InferTags.Rewrite.isTagged can be given the Id of a join point, which might be representation polymorphic. This would cause the call to isUnliftedType to crash. It's better to use typeLevity_maybe instead. Fixes #22212 - - - - - c0ba775d by Teo Camarasu at 2022-09-21T14:30:37-04:00 Add fragmentation statistic to GHC.Stats Implements #21537 - - - - - 2463df2f by Torsten Schmits at 2022-09-21T14:31:24-04:00 Rename Solo[constructor] to MkSolo Part of proposal 475 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst) Moves all tuples to GHC.Tuple.Prim Updates ghc-prim version (and bumps bounds in dependents) updates haddock submodule updates deepseq submodule updates text submodule - - - - - 9034fada by Matthew Pickering at 2022-09-22T09:25:29-04:00 Update filepath to filepath-1.4.100.0 Updates submodule * Always rely on vendored filepath * filepath must be built as stage0 dependency because it uses template-haskell. Towards #22098 - - - - - 615e2278 by Krzysztof Gogolewski at 2022-09-22T09:26:05-04:00 Minor refactor around Outputable * Replace 'text . show' and 'ppr' with 'int'. * Remove Outputable.hs-boot, no longer needed * Use pprWithCommas * Factor out instructions in AArch64 codegen - - - - - aeafdba5 by Sebastian Graf at 2022-09-27T15:14:54+02:00 Demand: Clear distinction between Call SubDmd and eval Dmd (#21717) In #21717 we saw a reportedly unsound strictness signature due to an unsound definition of plusSubDmd on Calls. This patch contains a description and the fix to the unsoundness as outlined in `Note [Call SubDemand vs. evaluation Demand]`. This fix means we also get rid of the special handling of `-fpedantic-bottoms` in eta-reduction. Thanks to less strict and actually sound strictness results, we will no longer eta-reduce the problematic cases in the first place, even without `-fpedantic-bottoms`. So fixing the unsoundness also makes our eta-reduction code simpler with less hacks to explain. But there is another, more unfortunate side-effect: We *unfix* #21085, but fortunately we have a new fix ready: See `Note [mkCall and plusSubDmd]`. There's another change: I decided to make `Note [SubDemand denotes at least one evaluation]` a lot simpler by using `plusSubDmd` (instead of `lubPlusSubDmd`) even if both argument demands are lazy. That leads to less precise results, but in turn rids ourselves from the need for 4 different `OpMode`s and the complication of `Note [Manual specialisation of lub*Dmd/plus*Dmd]`. The result is simpler code that is in line with the paper draft on Demand Analysis. I left the abandoned idea in `Note [Unrealised opportunity in plusDmd]` for posterity. The fallout in terms of regressions is negligible, as the testsuite and NoFib shows. ``` Program Allocs Instrs -------------------------------------------------------------------------------- hidden +0.2% -0.2% linear -0.0% -0.7% -------------------------------------------------------------------------------- Min -0.0% -0.7% Max +0.2% +0.0% Geometric Mean +0.0% -0.0% ``` Fixes #21717. - - - - - 9b1595c8 by Ross Paterson at 2022-09-27T14:12:01-04:00 implement proposal 106 (Define Kinds Without Promotion) (fixes #6024) includes corresponding changes to haddock submodule - - - - - c2d73cb4 by Andreas Klebinger at 2022-09-28T15:07:30-04:00 Apply some tricks to speed up core lint. Below are the noteworthy changes and if given their impact on compiler allocations for a type heavy module: * Use the oneShot trick on LintM * Use a unboxed tuple for the result of LintM: ~6% reduction * Avoid a thunk for the result of typeKind in lintType: ~5% reduction * lint_app: Don't allocate the error msg in the hot code path: ~4% reduction * lint_app: Eagerly force the in scope set: ~4% * nonDetCmpType: Try to short cut using reallyUnsafePtrEquality#: ~2% * lintM: Use a unboxed maybe for the `a` result: ~12% * lint_app: make go_app tail recursive to avoid allocating the go function as heap closure: ~7% * expandSynTyCon_maybe: Use a specialized data type For a less type heavy module like nofib/spectral/simple compiled with -O -dcore-lint allocations went down by ~24% and compile time by ~9%. ------------------------- Metric Decrease: T1969 ------------------------- - - - - - b74b6191 by sheaf at 2022-09-28T15:08:10-04:00 matchLocalInst: do domination analysis When multiple Given quantified constraints match a Wanted, and there is a quantified constraint that dominates all others, we now pick it to solve the Wanted. See Note [Use only the best matching quantified constraint]. For example: [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b [G] d2: forall a . C a Int => D a Int [W] {w}: D a Int When solving the Wanted, we find that both Givens match, but we pick the second, because it has a weaker precondition, C a Int, compared to (Eq a, Num Int, C a Int). We thus say that d2 dominates d1; see Note [When does a quantified instance dominate another?]. This domination test is done purely in terms of superclass expansion, in the function GHC.Tc.Solver.Interact.impliedBySCs. We don't attempt to do a full round of constraint solving; this simple check suffices for now. Fixes #22216 and #22223 - - - - - 2a53ac18 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that module * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times. This is compiler/perf, showing only changes over 1%: Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -50.2% GOOD ManyConstructors(normal) +1.0% MultiLayerModulesTH_OneShot(normal) +2.6% PmSeriesG(normal) -1.1% T10547(normal) -1.2% T11195(normal) -1.2% T11276(normal) -1.0% T11303b(normal) -1.6% T11545(normal) -1.4% T11822(normal) -1.3% T12150(optasm) -1.0% T12234(optasm) -1.2% T13056(optasm) -9.3% GOOD T13253(normal) -3.8% GOOD T15164(normal) -3.6% GOOD T16190(normal) -2.1% T16577(normal) -2.8% GOOD T16875(normal) -1.6% T17836(normal) +2.2% T17977b(normal) -1.0% T18223(normal) -33.3% GOOD T18282(normal) -3.4% GOOD T18304(normal) -1.4% T18698a(normal) -1.4% GOOD T18698b(normal) -1.3% GOOD T19695(normal) -2.5% GOOD T5837(normal) -2.3% T9630(normal) -33.0% GOOD WWRec(normal) -9.7% GOOD hard_hole_fits(normal) -2.1% GOOD hie002(normal) +1.6% geo. mean -2.2% minimum -50.2% maximum +2.6% I diligently investigated some of the big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlessly specialising wrappers LargeRecord, T9630 For runtimes, here is perf/should+_run: Metrics: runtime/bytes allocated -------------------------------- T12990(normal) -3.8% T5205(normal) -1.3% T9203(normal) -10.7% GOOD haddock.Cabal(normal) +0.1% haddock.base(normal) -1.1% haddock.compiler(normal) -0.3% lazy-bs-alloc(normal) -0.2% ------------------------------------------ geo. mean -0.3% minimum -10.7% maximum +0.1% I did not investigate exactly what happens in T9203. Nofib is a wash: +-------------------------------++--+-----------+-----------+ | || | tsv (rel) | std. err. | +===============================++==+===========+===========+ | real/anna || | -0.13% | 0.0% | | real/fem || | +0.13% | 0.0% | | real/fulsom || | -0.16% | 0.0% | | real/lift || | -1.55% | 0.0% | | real/reptile || | -0.11% | 0.0% | | real/smallpt || | +0.51% | 0.0% | | spectral/constraints || | +0.20% | 0.0% | | spectral/dom-lt || | +1.80% | 0.0% | | spectral/expert || | +0.33% | 0.0% | +===============================++==+===========+===========+ | geom mean || | | | +-------------------------------++--+-----------+-----------+ I spent quite some time investigating dom-lt, but it's pretty complicated. See my note on !7847. Conclusion: it's just a delicate inlining interaction, and we have plenty of those. Metric Decrease: LargeRecord T13056 T13253 T15164 T16577 T18223 T18282 T18698a T18698b T19695 T9630 WWRec hard_hole_fits T9203 - - - - - addeefc0 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Refactor UnfoldingSource and IfaceUnfolding I finally got tired of the way that IfaceUnfolding reflected a previous structure of unfoldings, not the current one. This MR refactors UnfoldingSource and IfaceUnfolding to be simpler and more consistent. It's largely just a refactor, but in UnfoldingSource (which moves to GHC.Types.Basic, since it is now used in IfaceSyn too), I distinguish between /user-specified/ and /system-generated/ stable unfoldings. data UnfoldingSource = VanillaSrc | StableUserSrc -- From a user-specified pragma | StableSystemSrc -- From a system-generated unfolding | CompulsorySrc This has a minor effect in CSE (see the use of isisStableUserUnfolding in GHC.Core.Opt.CSE), which I tripped over when working on specialisation, but it seems like a Good Thing to know anyway. - - - - - 7be6f9a4 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 INLINE/INLINEABLE pragmas in Foreign.Marshal.Array Foreign.Marshal.Array contains many small functions, all of which are overloaded, and which are critical for performance. Yet none of them had pragmas, so it was a fluke whether or not they got inlined. This patch makes them all either INLINE (small ones) or INLINEABLE and hence specialisable (larger ones). See Note [Specialising array operations] in that module. - - - - - b0c89dfa by Jade Lovelace at 2022-09-28T17:49:49-04:00 Export OnOff from GHC.Driver.Session I was working on fixing an issue where HLS was trying to pass its DynFlags to HLint, but didn't pass any of the disabled language extensions, which HLint would then assume are on because of their default values. Currently it's not possible to get any of the "No" flags because the `DynFlags.extensions` field can't really be used since it is [OnOff Extension] and OnOff is not exported. So let's export it. - - - - - 2f050687 by Bodigrim at 2022-09-28T17:50:28-04:00 Avoid Data.List.group; prefer Data.List.NonEmpty.group This allows to avoid further partiality, e. g., map head . group is replaced by map NE.head . NE.group, and there are less panic calls. - - - - - bc0020fa by M Farkas-Dyck at 2022-09-28T22:51:59-04:00 Clean up `findWiredInUnit`. In particular, avoid `head`. - - - - - 6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00 Eliminate headFS, use unconsFS instead A small step towards #22185 to avoid partial functions + safe implementation of `startsWithUnderscore`. - - - - - 5a535172 by Sebastian Graf at 2022-09-29T17:04:20+02:00 Demand: Format Call SubDemands `Cn(sd)` as `C(n,sd)` (#22231) Justification in #22231. Short form: In a demand like `1C1(C1(L))` it was too easy to confuse which `1` belongs to which `C`. Now that should be more obvious. Fixes #22231 - - - - - ea0083bf by Bryan Richter at 2022-09-29T15:48:38-04:00 Revert "ci: enable parallel compression for xz" Combined wxth XZ_OPT=9, this blew the memory capacity of CI runners. This reverts commit a5f9c35f5831ef5108e87813a96eac62803852ab. - - - - - f5e8f493 by Sebastian Graf at 2022-09-30T18:42:13+02:00 Boxity: Don't update Boxity unless worker/wrapper follows (#21754) A small refactoring in our Core Opt pipeline and some new functions for transfering argument boxities from one signature to another to facilitate `Note [Don't change boxity without worker/wrapper]`. Fixes #21754. - - - - - 4baf7b1c by M Farkas-Dyck at 2022-09-30T17:45:47-04:00 Scrub various partiality involving empty lists. Avoids some uses of `head` and `tail`, and some panics when an argument is null. - - - - - 95ead839 by Alexis King at 2022-10-01T00:37:43-04:00 Fix a bug in continuation capture across multiple stack chunks - - - - - 22096652 by Bodigrim at 2022-10-01T00:38:22-04:00 Enforce internal invariant of OrdList and fix bugs in viewCons / viewSnoc `viewCons` used to ignore `Many` constructor completely, returning `VNothing`. `viewSnoc` violated internal invariant of `Many` being a non-empty list. - - - - - 48ab9ca5 by Nicolas Trangez at 2022-10-04T20:34:10-04:00 chore: extend `.editorconfig` for C files - - - - - b8df5c72 by Brandon Chinn at 2022-10-04T20:34:46-04:00 Fix docs for pattern synonyms - - - - - 463ffe02 by Oleg Grenrus at 2022-10-04T20:35:24-04:00 Use sameByteArray# in sameByteArray - - - - - fbe1e86e by Pierre Le Marre at 2022-10-05T15:58:43+02:00 Minor fixes following Unicode 15.0.0 update - Fix changelog for Unicode 15.0.0 - Fix the checksums of the downloaded Unicode files, in base's tool: "ucd2haskell". - - - - - 8a31d02e by Cheng Shao at 2022-10-05T20:40:41-04:00 rts: don't enforce aligned((8)) on 32-bit targets We simply need to align to the word size for pointer tagging to work. On 32-bit targets, aligned((8)) is wasteful. - - - - - 532de368 by Ryan Scott at 2022-10-06T07:45:46-04:00 Export symbolSing, SSymbol, and friends (CLC#85) This implements this Core Libraries Proposal: https://github.com/haskell/core-libraries-committee/issues/85 In particular, it: 1. Exposes the `symbolSing` method of `KnownSymbol`, 2. Exports the abstract `SSymbol` type used in `symbolSing`, and 3. Defines an API for interacting with `SSymbol`. This also makes corresponding changes for `natSing`/`KnownNat`/`SNat` and `charSing`/`KnownChar`/`SChar`. This fixes #15183 and addresses part (2) of #21568. - - - - - d83a92e6 by sheaf at 2022-10-07T07:36:30-04:00 Remove mention of make from README.md - - - - - 945e8e49 by Bodigrim at 2022-10-10T17:13:31-04:00 Add a newline before since pragma in Data.Array.Byte - - - - - 44fcdb04 by Vladislav Zavialov at 2022-10-10T17:14:06-04:00 Parser/PostProcess: rename failOp* functions There are three functions named failOp* in the parser: failOpNotEnabledImportQualifiedPost failOpImportQualifiedTwice failOpFewArgs Only the last one has anything to do with operators. The other two were named this way either by mistake or due to a misunderstanding of what "op" stands for. This small patch corrects this. - - - - - 96d32ff2 by Simon Peyton Jones at 2022-10-10T22:30:21+01:00 Make rewrite rules "win" over inlining If a rewrite rule and a rewrite rule compete in the simplifier, this patch makes sure that the rewrite rule "win". That is, in general a bit fragile, but it's a huge help when making specialisation work reliably, as #21851 and #22097 showed. The change is fairly straightforwad, and documented in Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration. Compile-times change, up and down a bit -- in some cases because we get better specialisation. But the payoff (more reliable specialisation) is large. Metrics: compile_time/bytes allocated ----------------------------------------------- T10421(normal) +3.7% BAD T10421a(normal) +5.5% T13253(normal) +1.3% T14052(ghci) +1.8% T15304(normal) -1.4% T16577(normal) +3.1% BAD T17516(normal) +2.3% T17836(normal) -1.9% T18223(normal) -1.8% T8095(normal) -1.3% T9961(normal) +2.5% BAD geo. mean +0.0% minimum -1.9% maximum +5.5% Nofib results are (bytes allocated) +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || +0.27% | | imaginary/rfib || -0.04% | | real/anna || +0.02% | | real/fem || -0.04% | | real/fluid || +1.68% | | real/gamteb || -0.34% | | real/gg || +1.54% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/infer || -0.03% | | real/prolog || +0.02% | | real/veritas || -0.47% | | shootout/fannkuch-redux || -0.03% | | shootout/k-nucleotide || -0.02% | | shootout/n-body || -0.06% | | shootout/spectral-norm || -0.01% | | spectral/cryptarithm2 || +1.25% | | spectral/fibheaps || +18.33% | | spectral/last-piece || -0.34% | +===============================++==========+ | geom mean || +0.17% | There are extensive notes in !8897 about the regressions. Briefly * fibheaps: there was a very delicately balanced inlining that tipped over the wrong way after this change. * cryptarithm2 and paraffins are caused by #22274, which is a separate issue really. (I.e. the right fix is *not* to make inlining "win" over rules.) So I'm accepting these changes Metric Increase: T10421 T16577 T9961 - - - - - ed4b5885 by Joachim Breitner at 2022-10-10T23:16:11-04:00 Utils.JSON: do not escapeJsonString in ToJson String instance as `escapeJsonString` is used in `renderJSON`, so the `JSString` constructor is meant to carry the unescaped string. - - - - - fbb88740 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - e058b138 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Interface Files with Core Definitions This commit adds three new flags * -fwrite-if-simplified-core: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for including the core bindings in an interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of these extended interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 9789ea8e by Matthew Pickering at 2022-10-11T12:48:45-04:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - caced757 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Don't keep exit join points so much We were religiously keeping exit join points throughout, which had some bad effects (#21148, #22084). This MR does two things: * Arranges that exit join points are inhibited from inlining only in /one/ Simplifier pass (right after Exitification). See Note [Be selective about not-inlining exit join points] in GHC.Core.Opt.Exitify It's not a big deal, but it shaves 0.1% off compile times. * Inline used-once non-recursive join points very aggressively Given join j x = rhs in joinrec k y = ....j x.... where this is the only occurrence of `j`, we want to inline `j`. (Unless sm_keep_exits is on.) See Note [Inline used-once non-recursive join points] in GHC.Core.Opt.Simplify.Utils This is just a tidy-up really. It doesn't change allocation, but getting rid of a binding is always good. Very effect on nofib -- some up and down. - - - - - 284cf387 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Make SpecConstr bale out less often When doing performance debugging on #22084 / !8901, I found that the algorithm in SpecConstr.decreaseSpecCount was so aggressive that if there were /more/ specialisations available for an outer function, that could more or less kill off specialisation for an /inner/ function. (An example was in nofib/spectral/fibheaps.) This patch makes it a bit more aggressive, by dividing by 2, rather than by the number of outer specialisations. This makes the program bigger, temporarily: T19695(normal) ghc/alloc +11.3% BAD because we get more specialisation. But lots of other programs compile a bit faster and the geometric mean in perf/compiler is 0.0%. Metric Increase: T19695 - - - - - 66af1399 by Cheng Shao at 2022-10-11T12:49:59-04:00 CmmToC: emit explicit tail calls when the C compiler supports it Clang 13+ supports annotating a return statement using the musttail attribute, which guarantees that it lowers to a tail call if compilation succeeds. This patch takes advantage of that feature for the unregisterised code generator. The configure script tests availability of the musttail attribute, if it's available, the Cmm tail calls will become C tail calls that avoids the mini interpreter trampoline overhead. Nothing is affected if the musttail attribute is not supported. Clang documentation: https://clang.llvm.org/docs/AttributeReference.html#musttail - - - - - 7f0decd5 by Matthew Pickering at 2022-10-11T12:50:40-04:00 Don't include BufPos in interface files Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162 - - - - - dce9f320 by Cheng Shao at 2022-10-11T12:51:19-04:00 CLabel: fix isInfoTableLabel isInfoTableLabel does not take Cmm info table into account. This patch is required for data section layout of wasm32 NCG to work. - - - - - da679f2e by Bodigrim at 2022-10-11T18:02:59-04:00 Extend documentation for Data.List, mostly wrt infinite lists - - - - - 9c099387 by jwaldmann at 2022-10-11T18:02:59-04:00 Expand comment for Data.List.permutations - - - - - d3863cb7 by Bodigrim at 2022-10-11T18:03:37-04:00 ByteArray# is unlifted, not unboxed - - - - - f6260e8b by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 69ccec2c by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6e8feb4 by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 866c736e by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Refactor IPE tracing support - - - - - 6b0d2022 by Ben Gamari at 2022-10-11T23:45:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 9b572d54 by Ben Gamari at 2022-10-11T23:45:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 27978ceb by Krzysztof Gogolewski at 2022-10-11T23:45:46-04:00 Make Cmm Lint messages use dump style Lint errors indicate an internal error in GHC, so it makes sense to use it instead of the user style. This is consistent with Core Lint and STG Lint: https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Core/Lint.hs#L429 https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Stg/Lint.hs#L144 Fixes #22218. - - - - - 64a390d9 by Bryan Richter at 2022-10-12T09:52:51+03:00 Mark T7919 as fragile On x86_64-linux, T7919 timed out ~30 times during July 2022. And again ~30 times in September 2022. - - - - - 481467a5 by Ben Gamari at 2022-10-12T08:08:37-04:00 rts: Don't hint inlining of appendToRunQueue These hints have resulted in compile-time warnings due to failed inlinings for quite some time. Moreover, it's quite unlikely that inlining them is all that beneficial given that they are rather sizeable functions. Resolves #22280. - - - - - 81915089 by Curran McConnell at 2022-10-12T16:32:26-04:00 remove name shadowing - - - - - 626652f7 by Tamar Christina at 2022-10-12T16:33:13-04:00 winio: do not re-translate input when handle is uncooked - - - - - 5172789a by Charles Taylor at 2022-10-12T16:33:57-04:00 Unrestricted OverloadedLabels (#11671) Implements GHC proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - ce293908 by Andreas Klebinger at 2022-10-13T05:58:19-04:00 Add a perf test for the generics code pattern from #21839. This code showed a strong shift between compile time (got worse) and run time (got a lot better) recently which is perfectly acceptable. However it wasn't clear why the compile time regression was happening initially so I'm adding this test to make it easier to track such changes in the future. - - - - - 78ab7afe by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 44692713 by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Add support for .fini sections - - - - - beebf546 by Simon Hengel at 2022-10-13T05:59:37-04:00 Update phases.rst (the name of the original source file is $1, not $2) - - - - - eda6c05e by Finley McIlwaine at 2022-10-13T06:00:17-04:00 Clearer error msg for newtype GADTs with defaulted kind When a newtype introduces GADT eq_specs due to a defaulted RuntimeRep, we detect this and print the error message with explicit kinds. This also refactors newtype type checking to use the new diagnostic infra. Fixes #21447 - - - - - 43ab435a by Pierre Le Marre at 2022-10-14T07:45:43-04:00 Add standard Unicode case predicates isUpperCase and isLowerCase. These predicates use the standard Unicode case properties and are more intuitive than isUpper and isLower. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/90#issuecomment-1276649403. Fixes #14589 - - - - - aec5a443 by Bodigrim at 2022-10-14T07:46:21-04:00 Add type signatures in where-clause of Data.List.permutations The type of interleave' is very much revealing, otherwise it's extremely tough to decipher. - - - - - ee0deb80 by Ben Gamari at 2022-10-14T18:29:20-04:00 rts: Use pthread_setname_np correctly on Darwin As noted in #22206, pthread_setname_np on Darwin only supports setting the name of the calling thread. Consequently we must introduce a trampoline which first sets the thread name before entering the thread entrypoint. - - - - - 8eff62a4 by Ben Gamari at 2022-10-14T18:29:57-04:00 testsuite: Add test for #22282 This will complement mpickering's more general port of foundation's numerical testsuite, providing a test for the specific case found in #22282. - - - - - 62a55001 by Ben Gamari at 2022-10-14T18:29:57-04:00 ncg/aarch64: Fix sub-word sign extension yet again In adc7f108141a973b6dcb02a7836eed65d61230e8 we fixed a number of issues to do with sign extension in the AArch64 NCG found by ghc/test-primops>. However, this patch made a critical error, assuming that getSomeReg would allocate a fresh register for the result of its evaluation. However, this is not the case as `getSomeReg (CmmReg r) == r`. Consequently, any mutation of the register returned by `getSomeReg` may have unwanted side-effects on other expressions also mentioning `r`. In the fix listed above, this manifested as the registers containing the operands of binary arithmetic operations being incorrectly sign-extended. This resulted in #22282. Sadly, the rather simple structure of the tests generated by `test-primops` meant that this particular case was not exercised. Even more surprisingly, none of our testsuite caught this case. Here we fix this by ensuring that intermediate sign extension is performed in a fresh register. Fixes #22282. - - - - - 54e41b16 by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: ensure we are below maxHeapSize after returning megablocks When the heap is heavily block fragmented the live byte size might be low while the memory usage is high. We want to ensure that heap overflow triggers in these cases. We do so by checking that we can return enough megablocks to under maxHeapSize at the end of GC. - - - - - 29bb90db by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: trigger a major collection if megablock usage exceeds maxHeapSize When the heap is suffering from block fragmentation, live bytes might be low while megablock usage is high. If megablock usage exceeds maxHeapSize, we want to trigger a major GC to try to recover some memory otherwise we will die from a heapOverflow at the end of the GC. Fixes #21927 - - - - - 4a4641ca by Teo Camarasu at 2022-10-15T18:11:29+01:00 Add realease note for #21927 - - - - - c1e5719a by Sebastian Graf at 2022-10-17T11:58:46-04:00 DmdAnal: Look through unfoldings of DataCon wrappers (#22241) Previously, the demand signature we computed upfront for a DataCon wrapper lacked boxity information and was much less precise than the demand transformer for the DataCon worker. In this patch we adopt the solution to look through unfoldings of DataCon wrappers during Demand Analysis, but still attach a demand signature for other passes such as the Simplifier. See `Note [DmdAnal for DataCon wrappers]` for more details. Fixes #22241. - - - - - 8c72411d by Gergo ERDI at 2022-10-17T19:20:04-04:00 Add `Enum (Down a)` instance that swaps `succ` and `pred` See https://github.com/haskell/core-libraries-committee/issues/51 for discussion. The key points driving the implementation are the following two ideas: * For the `Int` type, `comparing (complement @Int)` behaves exactly as an order-swapping `compare @Int`. * `enumFrom @(Down a)` can be implemented in terms of `enumFromThen @a`, if only the corner case of starting at the very end is handled specially - - - - - d80ad2f4 by Alan Zimmerman at 2022-10-17T19:20:40-04:00 Update the check-exact infrastructure to match ghc-exactprint GHC tests the exact print annotations using the contents of utils/check-exact. The same functionality is provided via https://github.com/alanz/ghc-exactprint The latter was updated to ensure it works with all of the files on hackage when 9.2 was released, as well as updated to ensure users of the library could work properly (apply-refact, retrie, etc). This commit brings the changes from ghc-exactprint into GHC/utils/check-exact, adapting for the changes to master. Once it lands, it will form the basis for the 9.4 version of ghc-exactprint. See also discussion around this process at #21355 - - - - - 08ab5419 by Andreas Klebinger at 2022-10-17T19:21:15-04:00 Avoid allocating intermediate lists for non recursive bindings. We do so by having an explicit folding function that doesn't need to allocate intermediate lists first. Fixes #22196 - - - - - ff6275ef by Andreas Klebinger at 2022-10-17T19:21:52-04:00 Testsuite: Add a new tables_next_to_code predicate. And use it to avoid T21710a failing on non-tntc archs. Fixes #22169 - - - - - abb82f38 by Eric Lindblad at 2022-10-17T19:22:33-04:00 example rewrite - - - - - 39beb801 by Eric Lindblad at 2022-10-17T19:22:33-04:00 remove redirect - - - - - 0d9fb651 by Eric Lindblad at 2022-10-17T19:22:33-04:00 use heredoc - - - - - 0fa2d185 by Matthew Pickering at 2022-10-17T19:23:10-04:00 testsuite: Fix typo when setting llvm_ways Since 2014 llvm_ways has been set to [] so none of the tests which use only_ways(llvm_ways) have worked as expected. Hopefully the tests still pass with this typo fix! - - - - - ced664a2 by Krzysztof Gogolewski at 2022-10-17T19:23:10-04:00 Fix T15155l not getting -fllvm - - - - - 0ac60423 by Andreas Klebinger at 2022-10-18T03:34:47-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 9ecd1ac0 by M Farkas-Dyck at 2022-10-18T03:35:38-04:00 Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions. - - - - - f60244d7 by Ben Gamari at 2022-10-18T03:36:15-04:00 configure: Bump minimum bootstrap GHC version Fixes #22245 - - - - - ba4bd4a4 by Matthew Pickering at 2022-10-18T03:36:55-04:00 Build System: Remove out-of-date comment about make build system Both make and hadrian interleave compilation of modules of different modules and don't respect the package boundaries. Therefore I just remove this comment which points out this "difference". Fixes #22253 - - - - - e1bbd368 by Matthew Pickering at 2022-10-18T16:15:49+02:00 Allow configuration of error message printing This MR implements the idea of #21731 that the printing of a diagnostic method should be configurable at the printing time. The interface of the `Diagnostic` class is modified from: ``` class Diagnostic a where diagnosticMessage :: a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` to ``` class Diagnostic a where type DiagnosticOpts a defaultDiagnosticOpts :: DiagnosticOpts a diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` and so each `Diagnostic` can implement their own configuration record which can then be supplied by a client in order to dictate how to print out the error message. At the moment this only allows us to implement #21722 nicely but in future it is more natural to separate the configuration of how much information we put into an error message and how much we decide to print out of it. Updates Haddock submodule - - - - - 99dc3e3d by Matthew Pickering at 2022-10-18T16:15:53+02:00 Add -fsuppress-error-contexts to disable printing error contexts in errors In many development environments, the source span is the primary means of seeing what an error message relates to, and the In the expression: and In an equation for: clauses are not particularly relevant. However, they can grow to be quite long, which can make the message itself both feel overwhelming and interact badly with limited-space areas. It's simple to implement this flag so we might as well do it and give the user control about how they see their messages. Fixes #21722 - - - - - 5b3a992f by Dai at 2022-10-19T10:45:45-04:00 Add VecSlot for unboxed sums of SIMD vectors This patch adds the missing `VecRep` case to `primRepSlot` function and all the necessary machinery to carry this new `VecSlot` through code generation. This allows programs involving unboxed sums of SIMD vectors to be written and compiled. Fixes #22187 - - - - - 6d7d9181 by sheaf at 2022-10-19T10:45:45-04:00 Remove SIMD conversions This patch makes it so that packing/unpacking SIMD vectors always uses the right sized types, e.g. unpacking a Word16X4# will give a tuple of Word16#s. As a result, we can get rid of the conversion instructions that were previously required. Fixes #22296 - - - - - 3be48877 by sheaf at 2022-10-19T10:45:45-04:00 Cmm Lint: relax SIMD register assignment check As noted in #22297, SIMD vector registers can be used to store different kinds of values, e.g. xmm1 can be used both to store integer and floating point values. The Cmm type system doesn't properly account for this, so we weaken the Cmm register assignment lint check to only compare widths when comparing a vector type with its allocated vector register. - - - - - f7b7a312 by sheaf at 2022-10-19T10:45:45-04:00 Disable some SIMD tests on non-X86 architectures - - - - - 83638dce by M Farkas-Dyck at 2022-10-19T10:46:29-04:00 Scrub various partiality involving lists (again). Lets us avoid some use of `head` and `tail`, and some panics. - - - - - c3732c62 by M Farkas-Dyck at 2022-10-19T10:47:13-04:00 Enforce invariant of `ListBag` constructor. - - - - - 488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00 More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches` and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches` contains a single instance, but these invariants are immediately lost afterwards and not encoded in types. This patch enforces the invariants by pattern matching and makes types more precise, avoiding asserts and partial functions such as `head`. - - - - - 607ce263 by sheaf at 2022-10-19T10:47:52-04:00 Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap - - - - - 1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00 Add SpliceTypes test for hie files This test checks that typed splices and quotes get the right type information when used in hiefiles. See #21619 - - - - - a8b52786 by Jan Hrček at 2022-10-19T10:49:09-04:00 Small language fixes in 'Using GHC' - - - - - 1dab1167 by Gergő Érdi at 2022-10-19T10:49:51-04:00 Fix typo in `Opt_WriteIfSimplifiedCore`'s name - - - - - b17cfc9c by sheaf at 2022-10-19T10:50:37-04:00 TyEq:N assertion: only for saturated applications The assertion that checked TyEq:N in canEqCanLHSFinish incorrectly triggered in the case of an unsaturated newtype TyCon heading the RHS, even though we can't unwrap such an application. Now, we only trigger an assertion failure in case of a saturated application of a newtype TyCon. Fixes #22310 - - - - - ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - f9da50f4 by Ben Gamari at 2023-07-01T11:43:00-04:00 rts: Refuse to create jump islands for symbols with info tables When tables-next-to-code is enabled we must not relocate references to info-table symbols using jump islands. Fixes #20983. - - - - - 13 changed files: - − .appveyor.sh - .editorconfig - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - + .gitlab/gen_ci.hs - + .gitlab/generate_job_metadata - + .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2df6419913b7f70ffbfa3004cb025520befe20d4...f9da50f49cd3e8fe43c8d203f0c49172e3cc1dbc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2df6419913b7f70ffbfa3004cb025520befe20d4...f9da50f49cd3e8fe43c8d203f0c49172e3cc1dbc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 15:47:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 01 Jul 2023 11:47:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a04a855a39d_238a8e18f7fff4538671@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 44d41f69 by Torsten Schmits at 2023-07-01T11:46:33-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d6a4e669 by Ben Gamari at 2023-07-01T11:46:34-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6c8758a9 by Ben Gamari at 2023-07-01T11:46:34-04:00 testsuite: Add test for #23400 - - - - - f257f85a by Ben Gamari at 2023-07-01T11:46:35-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 5200859a by Ben Bellick at 2023-07-01T11:46:40-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - b8069ed2 by Moisés Ackerman at 2023-07-01T11:46:46-04:00 Add failing test case for #23492 - - - - - 72a4219c by Moisés Ackerman at 2023-07-01T11:46:46-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - ddbe1ac3 by Moisés Ackerman at 2023-07-01T11:46:46-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 5e8f7a7b by Moisés Ackerman at 2023-07-01T11:46:46-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 3f0b89e3 by Ryan Hendrickson at 2023-07-01T11:46:52-04:00 Add regression test for #23549 - - - - - 2a9d1c7f by Alexis King at 2023-07-01T11:47:01-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 3046e5db by Bryan Richter at 2023-07-01T11:47:02-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 34de31b9 by Ben Gamari at 2023-07-01T11:47:02-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 513b3841 by Ben Gamari at 2023-07-01T11:47:03-04:00 testsuite: Update documentation - - - - - a3d53f04 by Gregory Gerasev at 2023-07-01T11:47:07-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - ba714a15 by Dave Barton at 2023-07-01T11:47:10-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae1dd0c5ca5e4bbcad28854b29727f366655b908...ba714a1574e9e373e93ee73a2af8b2657b78dafe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae1dd0c5ca5e4bbcad28854b29727f366655b908...ba714a1574e9e373e93ee73a2af8b2657b78dafe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 19:00:46 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 01 Jul 2023 15:00:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-annlist-decls Message-ID: <64a077de84d_238a8e18f7fff45741bc@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-annlist-decls at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-annlist-decls You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 20:01:12 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 16:01:12 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch` Message-ID: <64a0860826108_238a8e18f7fff45833ed@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: f2861a31 by Ben Gamari at 2023-07-01T15:57:27-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 22 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - + compiler/GHC/Utils/Touch.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Settings/Default.hs - m4/fp_settings.m4 - − utils/touchy/Makefile - − utils/touchy/touchy.c - − utils/touchy/touchy.cabal Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -259,6 +259,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Utils.Touch import qualified GHC.LanguageExtensions as LangExt @@ -269,7 +270,6 @@ import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) import GHC.Data.Maybe -import qualified GHC.SysTools import GHC.SysTools (initSysTools) import GHC.SysTools.BaseDir (findTopDir) @@ -1262,7 +1262,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do -- .hie files. let hie_file = ml_hie_file mod_location whenM (doesFileExist hie_file) $ - GHC.SysTools.touch logger dflags "Touching hie file" hie_file + GHC.Utils.Touch.touch hie_file else -- See Note [Strictness in ModIface] forceModIface iface ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -72,6 +72,7 @@ import System.IO import GHC.Linker.ExtraObj import GHC.Linker.Dynamic import GHC.Utils.Panic +import GHC.Utils.Touch import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder @@ -363,14 +364,10 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- | Run the JS Backend postHsc phase. runJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath -runJsPhase _pipe_env hsc_env _location input_fn = do - let dflags = hsc_dflags hsc_env - let logger = hsc_logger hsc_env - +runJsPhase _pipe_env _hsc_env _location input_fn = do -- The object file is already generated. We only touch it to ensure the -- timestamp is refreshed, see Note [JS Backend .o file procedure]. - touchObjectFile logger dflags input_fn - + touchObjectFile input_fn return input_fn -- | Deal with foreign JS files (embed them into .o files) @@ -552,7 +549,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - HsBootFile -> touchObjectFile logger dflags o_file + HsBootFile -> touchObjectFile o_file HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" -- MP: I wonder if there are any lurking bugs here because we @@ -1148,10 +1145,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do -touchObjectFile :: Logger -> DynFlags -> FilePath -> IO () -touchObjectFile logger dflags path = do +touchObjectFile :: FilePath -> IO () +touchObjectFile path = do createDirectoryIfMissing True $ takeDirectory path - GHC.SysTools.touch logger dflags "Touching object file" path + GHC.Utils.Touch.touch path -- Note [-fPIC for assembler] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_l, sPgm_lm, sPgm_dll, - sPgm_T, sPgm_windres, sPgm_ar, sPgm_ranlib, @@ -137,7 +136,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_dll, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags -pgm_T :: DynFlags -> String -pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Settings , sPgm_l , sPgm_lm , sPgm_dll - , sPgm_T , sPgm_windres , sPgm_ar , sPgm_otool @@ -111,7 +110,6 @@ data ToolSettings = ToolSettings -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String , toolSettings_pgm_otool :: String @@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings sPgm_dll :: Settings -> (String, [Option]) sPgm_dll = toolSettings_pgm_dll . sToolSettings -sPgm_T :: Settings -> String -sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String sPgm_windres = toolSettings_pgm_windres . sToolSettings sPgm_ar :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -125,8 +125,6 @@ initSettings top_dir = do install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" - touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -191,7 +189,6 @@ initSettings top_dir = do , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) - , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path , toolSettings_pgm_otool = otool_path ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do mb_env <- getGccEnv cc_args runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env -touch :: Logger -> DynFlags -> String -> String -> IO () -touch logger dflags purpose arg = traceSystoolCommand logger "touch" $ - runSomething logger purpose (pgm_T dflags) [FileOption "" arg] ===================================== compiler/GHC/Utils/Touch.hs ===================================== @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} + +module GHC.Utils.Touch (touch) where + +import GHC.Prelude + +#if defined(mingw32_HOST_OS) +import System.Win32.File +import System.Win32.Time +#else +import System.Posix.Files +import System.Posix.IO +#endif + +-- | Set the mtime of the given file to the current time. +touch :: FilePath -> IO () +touch file = do +#if defined(mingw32_HOST_OS) + hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing + t <- getSystemTimeAsFileTime + setFileTime hdl Nothing Nothing (Just t) + closeHandle hdl +#else +#if MIN_VERSION_unix(2,8,0) + let oflags = defaultFileFlags { noctty = True, creat = Just 0o666 } + fd <- openFd file WriteOnly oflags +#else + let oflags = defaultFileFlags { noctty = True } + fd <- openFd file WriteOnly (Just 0o666) oflags +#endif + touchFd fd + closeFd fd +#endif + ===================================== compiler/ghc.cabal.in ===================================== @@ -902,6 +902,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== hadrian/bindist/Makefile ===================================== @@ -102,7 +102,6 @@ lib/settings : config.mk @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsTouchCommand = @SettingsTouchCommand@ SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ -settings-touch-command = @SettingsTouchCommand@ settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -236,7 +236,6 @@ instance H.Builder Builder where pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the @@ -245,7 +244,6 @@ instance H.Builder Builder where return $ [ unlitPath ] ++ ghcdeps - ++ [ touchyPath | windowsHost ] ++ [ root -/- mingwStamp | windowsHost ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -49,8 +49,8 @@ class ShakeValue b => Builder b where -- capture the @stdout@ result and return it. askBuilderWith :: b -> BuildInfo -> Action String - -- | Runtime dependencies of a builder. For example, on Windows GHC requires - -- the utility @touchy.exe@ to be available on a specific path. + -- | Runtime dependencies of a builder. For example, GHC requires the + -- utility @unlit@ to be available on a specific path. runtimeDependencies :: b -> Action [FilePath] runtimeDependencies _ = return [] ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -125,7 +125,6 @@ data SettingsFileSetting | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand @@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -40,7 +40,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, - terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, + terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package @@ -117,7 +117,6 @@ terminfo = lib "terminfo" text = lib "text" time = lib "time" timeout = util "timeout" `setPath` "testsuite/timeout" -touchy = util "touchy" transformers = lib "transformers" unlit = util "unlit" unix = lib "unix" @@ -192,12 +191,12 @@ programName Context {..} = do -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context at Context {..} = do - -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of - -- @bin@, which is likely just a historical accident that should be fixed. - -- See: https://github.com/snowleopard/hadrian/issues/570 - -- Likewise for @iserv@ and @unlit at . + -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory + -- instead of @bin@, which is likely just a historical accident that should + -- be fixed. See: + -- https://github.com/snowleopard/hadrian/issues/570 name <- programName context - path <- if package `elem` [iserv, touchy, unlit] + path <- if package `elem` [iserv, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage return $ path -/- name <.> exe @@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) -- TODO: Combine this with 'programName'. -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -461,7 +461,6 @@ generateSettings = do , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do (True, s) | s > stage0InTree -> do srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -105,7 +105,6 @@ stage0Packages = do ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] - ++ [ touchy | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] @@ -155,9 +154,8 @@ stage1Packages = do , runGhc ] , when (winTarget && not cross) - [ touchy - -- See Note [Hadrian's ghci-wrapper package] - , ghciWrapper + [ -- See Note [Hadrian's ghci-wrapper package] + ghciWrapper ] ] ===================================== m4/fp_settings.m4 ===================================== @@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS], SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' else # This case handles the "normal" platforms (e.g. not Windows) where we @@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="$WindresCmd" fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi - if test "$EnableDistroToolchain" = "YES"; then # If the user specified --enable-distro-toolchain then we just use the # executable names, not paths. @@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) ===================================== utils/touchy/Makefile deleted ===================================== @@ -1,37 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -# -# Substitute for 'touch' on win32 platforms (without an Unix toolset installed). -# -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=touchy.c -C_PROG=touchy -SRC_CC_OPTS += -O - -# -# Install touchy in lib/.* -# -INSTALL_LIBEXECS += $(C_PROG) - -include $(TOP)/mk/target.mk - -# Get it over with! -boot :: all - -binary-dist: - $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy - $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/ - $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/ - ===================================== utils/touchy/touchy.c deleted ===================================== @@ -1,123 +0,0 @@ -/* - * Simple 'touch' program for Windows - * - */ -#if !defined(_WIN32) -#error "Win32-only, the platform you're using is supposed to have 'touch' already." -#else -#include -#include -#include -#include -#include -#include -#include - -/* -touch is used by GHC both during building and during compilation of -Haskell files. Unfortunately this means we need a 'touch' like program -in the GHC bindist. Since touch is not standard on Windows and msys2 -doesn't include a mingw-w64 build of coreutils we need touchy for now. - -With Windows 7 in a virtual box VM on OS X, some very odd things happen -with dates and time stamps when SSHing into cygwin. e.g. here the -"Change" time is in the past: - -$ date; touch foo; stat foo -Fri Dec 2 16:58:07 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:58:07.414457900 +0000 -Modify: 2011-12-02 16:58:07.414457900 +0000 -Change: 2011-12-02 16:58:03.495141800 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - -And if we copy such a file, then the copy is older (as determined by the -"Modify" time) than the original: - -$ date; touch foo; stat foo; cp foo bar; stat bar -Fri Dec 2 16:59:10 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:10.118457900 +0000 -Modify: 2011-12-02 16:59:10.118457900 +0000 -Change: 2011-12-02 16:59:06.189477700 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - File: `bar' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:06.394555800 +0000 -Modify: 2011-12-02 16:59:06.394555800 +0000 -Change: 2011-12-02 16:59:06.395532400 +0000 - Birth: 2011-12-02 16:58:40.921899600 +0000 - -This means that make thinks that things are out of date when it -shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS -infinite-recursion test triggers. - -The touchy program, like most other programs, creates files with both -Modify and Change in the past, which is still a little odd, but is -consistent, so doesn't break make. - -We used to use _utime(argv[i],NULL)) to set the file modification times, -but after a BST -> GMT change this started giving files a modification -time an hour in the future: - -$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile -Tue, Oct 30, 2012 11:33:06 PM - File: `testfile' - Size: 0 Blocks: 0 IO Block: 65536 regular empty file -Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1 -Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2012-10-31 00:33:06.000000000 +0000 -Modify: 2012-10-31 00:33:06.000000000 +0000 -Change: 2012-10-30 23:33:06.769118900 +0000 - Birth: 2012-10-30 23:33:06.769118900 +0000 - -so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime. -*/ - -int -main(int argc, char** argv) -{ - int i; - FILETIME ft; - BOOL b; - HANDLE hFile; - - if (argc == 1) { - fprintf(stderr, "Usage: %s \n", argv[0]); - return 1; - } - - for (i = 1; i < argc; i++) { - hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, - FILE_ATTRIBUTE_NORMAL, NULL); - if (hFile == INVALID_HANDLE_VALUE) { - fprintf(stderr, "Unable to open %s\n", argv[i]); - exit(1); - } - GetSystemTimeAsFileTime(&ft); - b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft); - if (b == 0) { - fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]); - exit(1); - } - b = CloseHandle(hFile); - if (b == 0) { - fprintf(stderr, "Closing failed for %s\n", argv[i]); - exit(1); - } - } - - return 0; -} -#endif ===================================== utils/touchy/touchy.cabal deleted ===================================== @@ -1,15 +0,0 @@ -cabal-version: 2.2 -Name: touchy -Version: 0.1 -Copyright: XXX -License: BSD-3-Clause -Author: XXX -Maintainer: XXX -Synopsis: @touch@ for windows -Description: XXX -Category: Development -build-type: Simple - -Executable touchy - Default-Language: Haskell2010 - Main-Is: touchy.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f2861a3153d9b650240b4d4fe7d262e4caa0a7a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f2861a3153d9b650240b4d4fe7d262e4caa0a7a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 21:35:52 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sat, 01 Jul 2023 17:35:52 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Add instances for debugging Message-ID: <64a09c38e8ea6_238a8e1e64f8d45919c0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: c97d6541 by Rodrigo Mesquita at 2023-07-01T22:35:45+01:00 Add instances for debugging - - - - - 2 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -26,7 +26,7 @@ import qualified Data.Equality.Graph.Monad as EGM import Data.Equality.Utils (Fix(..)) import GHC.Utils.Misc (all2) -import GHC.Utils.Outputable (showPprUnsafe) +import GHC.Utils.Outputable import GHC.Core.Coercion (coercionType) -- Important to note the binders are also represented by $a$ @@ -343,16 +343,37 @@ cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where GT -> GT go l r = compare l r --- ROMES:TODO: DEBRUIJN ORDERING ON TYPES!!! cmpDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Ordering cmpDeBruijnType d1@(D _ t1) d2@(D _ t2) = if eqDeBruijnType d1 d2 then EQ + -- ROMES:TODO: Is this OK? else compare (showPprUnsafe t1) (showPprUnsafe t2) - --- ROMES:TODO: DEBRUIJN ORDERING ON COERCIONS!!! cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering cmpDeBruijnCoercion (D env1 co1) (D env2 co2) = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) +-- instances for debugging purposes +instance Show a => Show (DeBruijnF CoreExprF a) where + show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id + show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit + show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b + show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a + show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a + show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts + + show (DF (D _ (CastF _a _cor) )) = "CastF" + show (DF (D _ (TickF _cotick _a))) = "Tick" + show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t) + show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co + + +instance Show a => Show (BindF CoreBndr a) where + show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a + show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs) + +instance Show a => Show (AltF CoreBndr a) where + show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a + + ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | Domain types used in "GHC.HsToCore.Pmc.Solver". -- The ultimate goal is to define 'Nabla', which models normalised refinement @@ -241,7 +242,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt _ dirty) = text "" $$ ppr dirty + ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -829,6 +830,9 @@ instance Outputable PmEquality where -- type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) +-- TODO delete orphans for showing TmEGraph for debugging reasons +instance Show VarInfo where + show = showPprUnsafe . ppr representId :: Id -> Nabla -> (ClassId, Nabla) -- Will need to justify this well @@ -842,7 +846,7 @@ representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) na -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. instance Eq VarInfo where - (==) _ _ = False + (==) a b = vi_id a == vi_id b instance Analysis VarInfo (DeBruijnF CoreExprF) where {-# INLINE makeA #-} {-# INLINE joinA #-} @@ -865,3 +869,4 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble joinA _a b = b + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c97d6541036baa725c50909146eabcb7892bfc0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c97d6541036baa725c50909146eabcb7892bfc0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 21:51:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 01 Jul 2023 17:51:34 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <64a09fe69ccb2_238a8e1e64f8d45942ae@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 5d829fcb by Ben Gamari at 2023-07-01T17:51:22-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 13 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - + testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,243 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc, mkVarOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons ++ + map mkVarOcc integerConversionIds + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + + -- Conversion functions in GHC.Integer which are only exposed on 32-bit + -- platforms + integerConversionIds = + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> nest 2 (text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}") + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d829fcba4a6ca5d686e86bffcddadb4aba22c94 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d829fcba4a6ca5d686e86bffcddadb4aba22c94 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 22:45:25 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sat, 01 Jul 2023 18:45:25 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Things that were broken due to unlawfulness of e-graph instances Message-ID: <64a0ac8541520_238a8e35f92aec59515f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: eac4bce1 by Rodrigo Mesquita at 2023-07-01T23:45:20+01:00 Things that were broken due to unlawfulness of e-graph instances - - - - - 1 changed file: - compiler/GHC/HsToCore/Pmc/Solver.hs Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -846,8 +846,17 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = case equate env x y of -- Add the constraints we had for x to y -- See Note [Joining e-classes PMC] todo mention from joinA - (vi_x, env') -> do - let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } + -- Now, here's a really tricky bit (TODO Write note, is it the one above?) + -- Bc the joinA operation is unlawful, and because the makeA operation for + -- expressions is also unlawful (sets the type to ()::(), mostly out of + -- laziness, we could reconstruct the type if we wanted), + -- Then we must make sure that when we're "completing the joinA manually", + -- We *also update the type* (WTF1). + -- This is because every e-class should always have a match-var first, which will always have a type, and it should appear on "the left" + -- We also rebuild here, we did just merge two things. TODO: Where and when exactly should we merge? + (vi_x, EG.rebuild -> env') -> do + let env'' = env' & _class x . _data %~ (\i -> i{vi_id = vi_id vi_x}) -- (WTF1), we keep the id from the left of the merge (We could do this on the join operation really...) (We *should* have a lawful join operation. I think it would simplify things in the long run + let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env''} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args nabla_pos <- foldlM add_pos nabla_equated (vi_pos vi_x) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eac4bce1d8cb65d05140282f1748bc7d1923fa63 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eac4bce1d8cb65d05140282f1748bc7d1923fa63 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 1 23:43:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sat, 01 Jul 2023 19:43:43 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Temporary hegg commit with rebuild before find Message-ID: <64a0ba2ff001d_238a8e1e64f8d45961d9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 0026561e by Rodrigo Mesquita at 2023-07-02T00:41:25+01:00 Temporary hegg commit with rebuild before find - - - - - 1 changed file: - libraries/hegg Changes: ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit d2862ab93d0420841aae3b8436f27301814d61a0 +Subproject commit c7af135c6c6c94d12e3af4f2c24f26bba531d4c6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0026561ee14d285ed08a74bc73c80a39960cbf52 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0026561ee14d285ed08a74bc73c80a39960cbf52 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 11:29:22 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 02 Jul 2023 07:29:22 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 2 commits: Revert "Temporary hegg commit with rebuild before find" Message-ID: <64a15f928014d_2e0e5b4751875653@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: a02d5225 by Rodrigo Mesquita at 2023-07-02T10:12:14+01:00 Revert "Temporary hegg commit with rebuild before find" This reverts commit 0026561ee14d285ed08a74bc73c80a39960cbf52. - - - - - 55a0531a by Rodrigo Mesquita at 2023-07-02T12:29:16+01:00 Scuffed merging without effects to salvage some information that might get lost in merging that happens outside of addVarCt - - - - - 5 changed files: - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/TyThing/Ppr.hs-boot - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -855,8 +855,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- This is because every e-class should always have a match-var first, which will always have a type, and it should appear on "the left" -- We also rebuild here, we did just merge two things. TODO: Where and when exactly should we merge? (vi_x, EG.rebuild -> env') -> do - let env'' = env' & _class x . _data %~ (\i -> i{vi_id = vi_id vi_x}) -- (WTF1), we keep the id from the left of the merge (We could do this on the join operation really...) (We *should* have a lawful join operation. I think it would simplify things in the long run - let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env''} } + let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args nabla_pos <- foldlM add_pos nabla_equated (vi_pos vi_x) @@ -877,7 +876,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = equate :: TmEGraph -> ClassId -> ClassId -> (VarInfo, TmEGraph) equate eg x y = let (_, eg') = EG.merge x y eg in (eg ^. _class x ._data, eg') - -- Note: lookup in @eg@, not @eg'@, because it's before the merge. + -- Note: lookup in @eg@, not @eg'@, because we want to return x's data before the merge. -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based @@ -1336,9 +1335,8 @@ traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = go (IS.elems dirty) env where go [] env = pure ts{ts_facts=env} - go (x:xs) !_env = do - let vi = env ^._class x._data - vi' <- f x vi + go (x:xs) !env = do + vi' <- f x (lookupVarInfo ts x) go xs (env & _class x._data .~ vi') -- Use 'over' or so instead? traverseAll :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -867,6 +867,47 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble - joinA _a b = b - + -- Hacks hacks hacks + -- Do some "obvious" things in this merge, despite keeping all the nuanced + -- joining operations in addVarCt. Some part of them will be redundant, but + -- if we don't do the simple things here we might end up losing information + -- when merging things through the e-graph outside of 'addVarCt' + +-- I think we really need effects, because the operation is only well-defined +-- since it can fail when it is conflicting +-- and that would allow us to do the merge procedure correcly here instead of in addVarCt +-- we may be able to have Analysis (Effect VarInfo) (...) + joinA a b = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b + , vi_pos = case (vi_pos a, vi_pos b) of + ([], []) -> [] + ([], x) -> x + (x, []) -> x + (_x, y) -> y -- keep right + , vi_neg = foldr (flip extendPmAltConSet) (vi_neg b) (pmAltConSetElems $ vi_neg a) + , vi_bot = case (vi_bot a, vi_bot b) of + (IsBot,IsBot) -> IsBot + (IsBot,IsNotBot) -> IsNotBot -- keep b, achhhhh + (IsBot,MaybeBot) -> IsBot + (IsNotBot,IsBot) -> IsBot -- keep b, achhhhh + (IsNotBot,IsNotBot) -> IsNotBot + (IsNotBot,MaybeBot) -> IsNotBot + (MaybeBot, IsBot) -> IsBot + (MaybeBot, IsNotBot) -> IsNotBot + (MaybeBot, MaybeBot) -> MaybeBot + , vi_rcm = case (vi_rcm a, vi_rcm b) of + (RCM Nothing Nothing,RCM a b) -> RCM a b + (RCM Nothing (Just a),RCM Nothing Nothing) -> RCM Nothing (Just a) + (RCM Nothing (Just _a),RCM Nothing (Just b)) -> RCM Nothing (Just b) -- keep right + (RCM Nothing (Just a),RCM (Just b) Nothing) -> RCM (Just b) (Just a) + (RCM Nothing (Just _a),RCM (Just b) (Just c)) -> RCM (Just b) (Just c) -- keep right + (RCM (Just a) Nothing,RCM Nothing Nothing) -> RCM (Just a) Nothing + (RCM (Just a) Nothing,RCM Nothing (Just b)) -> RCM (Just a) (Just b) + (RCM (Just _a) Nothing,RCM (Just b) Nothing) -> RCM (Just b) Nothing -- keep right + (RCM (Just _a) Nothing,RCM (Just b) (Just c)) -> RCM (Just b) (Just c) + (RCM (Just a) (Just b),RCM Nothing Nothing) -> RCM (Just a) (Just b) + (RCM (Just a) (Just _b),RCM Nothing (Just c)) -> RCM (Just a) (Just c) + (RCM (Just _a) (Just b),RCM (Just c) Nothing) -> RCM (Just c) (Just b) + (RCM (Just _a) (Just _b),RCM (Just c) (Just d)) -> RCM (Just c) (Just d) + -- we could also have _ _, (Just c) (Just d) -> (Just c, Just d) + } ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic -import {-# SOURCE #-} Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) import GHC.Data.FastString (fsLit) import Language.Haskell.Syntax (LPat, LIdP) ===================================== compiler/GHC/Types/TyThing/Ppr.hs-boot ===================================== @@ -3,7 +3,7 @@ module GHC.Types.TyThing.Ppr ( pprTyThingInContext ) where -import {-# SOURCE #-} GHC.Iface.Type ( ShowSub ) +import GHC.Iface.Type ( ShowSub ) import GHC.Types.TyThing ( TyThing ) import GHC.Utils.Outputable ( SDoc ) ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit c7af135c6c6c94d12e3af4f2c24f26bba531d4c6 +Subproject commit d2862ab93d0420841aae3b8436f27301814d61a0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0026561ee14d285ed08a74bc73c80a39960cbf52...55a0531ad75f140a062eddde9f540827ff412fa3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0026561ee14d285ed08a74bc73c80a39960cbf52...55a0531ad75f140a062eddde9f540827ff412fa3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 12:59:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 08:59:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a174cbbd347_2e0e5b47518965aa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ee880793 by Torsten Schmits at 2023-07-02T08:59:09-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d4e1d52c by Ben Gamari at 2023-07-02T08:59:10-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 5d97d259 by Ben Gamari at 2023-07-02T08:59:10-04:00 testsuite: Add test for #23400 - - - - - 6f1c26df by Ben Gamari at 2023-07-02T08:59:12-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 9ed16973 by Ben Bellick at 2023-07-02T08:59:16-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 34ccf4cc by Moisés Ackerman at 2023-07-02T08:59:22-04:00 Add failing test case for #23492 - - - - - ca822f40 by Moisés Ackerman at 2023-07-02T08:59:22-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 6973ec76 by Moisés Ackerman at 2023-07-02T08:59:22-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 6d760adb by Moisés Ackerman at 2023-07-02T08:59:22-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 2f096050 by Ryan Hendrickson at 2023-07-02T08:59:28-04:00 Add regression test for #23549 - - - - - 2beba3a4 by Alexis King at 2023-07-02T08:59:39-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 8ce77116 by Bryan Richter at 2023-07-02T08:59:39-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 2ec39cc1 by Ben Gamari at 2023-07-02T08:59:40-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 4c89d591 by Ben Gamari at 2023-07-02T08:59:40-04:00 testsuite: Update documentation - - - - - c6afb4fc by Gregory Gerasev at 2023-07-02T08:59:45-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - f20d6d7e by Dave Barton at 2023-07-02T08:59:48-04:00 Fix some broken links and typos - - - - - 73cbcb0f by Ben Gamari at 2023-07-02T08:59:49-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ba714a1574e9e373e93ee73a2af8b2657b78dafe...73cbcb0f8e4b3f43b2ba7a6a300d96c4590ce0f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ba714a1574e9e373e93ee73a2af8b2657b78dafe...73cbcb0f8e4b3f43b2ba7a6a300d96c4590ce0f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:02:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:02:20 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1755c74a8_2e0e5b475b8108727@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bc0b5f2d by Torsten Schmits at 2023-07-02T09:01:34-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 77a8b9e6 by Ben Gamari at 2023-07-02T09:01:35-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6e074943 by Ben Gamari at 2023-07-02T09:01:35-04:00 testsuite: Add test for #23400 - - - - - 05ae3e15 by Ben Gamari at 2023-07-02T09:01:37-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - bc04789d by Ben Bellick at 2023-07-02T09:01:41-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 45158c64 by Moisés Ackerman at 2023-07-02T09:01:47-04:00 Add failing test case for #23492 - - - - - c8837cc5 by Moisés Ackerman at 2023-07-02T09:01:47-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - fe5d914c by Moisés Ackerman at 2023-07-02T09:01:48-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 1cfee10b by Moisés Ackerman at 2023-07-02T09:01:48-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - a3b6b28f by Ryan Hendrickson at 2023-07-02T09:01:53-04:00 Add regression test for #23549 - - - - - 594a65f3 by Alexis King at 2023-07-02T09:02:04-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - b032f6a3 by Bryan Richter at 2023-07-02T09:02:04-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 37eef2e2 by Ben Gamari at 2023-07-02T09:02:05-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 586d1d24 by Ben Gamari at 2023-07-02T09:02:05-04:00 testsuite: Update documentation - - - - - 6c1a8229 by Gregory Gerasev at 2023-07-02T09:02:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 72035d83 by Dave Barton at 2023-07-02T09:02:14-04:00 Fix some broken links and typos - - - - - 3fe3a155 by Ben Gamari at 2023-07-02T09:02:14-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73cbcb0f8e4b3f43b2ba7a6a300d96c4590ce0f7...3fe3a1557977a237e1c1e4a89dc53c0e8aa41dec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73cbcb0f8e4b3f43b2ba7a6a300d96c4590ce0f7...3fe3a1557977a237e1c1e4a89dc53c0e8aa41dec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:04:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:04:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a175f9e5e1f_2e0e5b474f01239f2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: de830cfc by Torsten Schmits at 2023-07-02T09:03:58-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 9fa14901 by Ben Gamari at 2023-07-02T09:03:59-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 325294e4 by Ben Gamari at 2023-07-02T09:03:59-04:00 testsuite: Add test for #23400 - - - - - 193c6566 by Ben Gamari at 2023-07-02T09:04:01-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - f90b0920 by Ben Bellick at 2023-07-02T09:04:05-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 799dafb2 by Moisés Ackerman at 2023-07-02T09:04:11-04:00 Add failing test case for #23492 - - - - - a5808dd4 by Moisés Ackerman at 2023-07-02T09:04:11-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - d657a8bf by Moisés Ackerman at 2023-07-02T09:04:11-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - fdd66998 by Moisés Ackerman at 2023-07-02T09:04:11-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 4cd14ed8 by Ryan Hendrickson at 2023-07-02T09:04:17-04:00 Add regression test for #23549 - - - - - 98dcbf84 by Alexis King at 2023-07-02T09:04:28-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 9169c7a8 by Bryan Richter at 2023-07-02T09:04:28-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 3272c3f4 by Ben Gamari at 2023-07-02T09:04:29-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aec0bc84 by Ben Gamari at 2023-07-02T09:04:29-04:00 testsuite: Update documentation - - - - - b891f8c5 by Gregory Gerasev at 2023-07-02T09:04:34-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 83551994 by Dave Barton at 2023-07-02T09:04:38-04:00 Fix some broken links and typos - - - - - f3337ae7 by Ben Gamari at 2023-07-02T09:04:38-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3fe3a1557977a237e1c1e4a89dc53c0e8aa41dec...f3337ae711343ca30f6770fea3901966b7a13531 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3fe3a1557977a237e1c1e4a89dc53c0e8aa41dec...f3337ae711343ca30f6770fea3901966b7a13531 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:07:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:07:03 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17677e1aef_2e0e5b475cc13325d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 80cd96e0 by Torsten Schmits at 2023-07-02T09:06:17-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - dfa14688 by Ben Gamari at 2023-07-02T09:06:18-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 5a8ed18e by Ben Gamari at 2023-07-02T09:06:18-04:00 testsuite: Add test for #23400 - - - - - cbb71c35 by Ben Gamari at 2023-07-02T09:06:20-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 52aa6f54 by Ben Bellick at 2023-07-02T09:06:25-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 55b664aa by Moisés Ackerman at 2023-07-02T09:06:30-04:00 Add failing test case for #23492 - - - - - 517dd30a by Moisés Ackerman at 2023-07-02T09:06:30-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 8001c0e4 by Moisés Ackerman at 2023-07-02T09:06:31-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - aa0ed718 by Moisés Ackerman at 2023-07-02T09:06:31-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 83f232b7 by Ryan Hendrickson at 2023-07-02T09:06:37-04:00 Add regression test for #23549 - - - - - f47388bb by Alexis King at 2023-07-02T09:06:47-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - ef85d49e by Bryan Richter at 2023-07-02T09:06:47-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 82a8459f by Ben Gamari at 2023-07-02T09:06:48-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - ded8ca9b by Ben Gamari at 2023-07-02T09:06:48-04:00 testsuite: Update documentation - - - - - c3f5eecb by Gregory Gerasev at 2023-07-02T09:06:53-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 7d1f437b by Dave Barton at 2023-07-02T09:06:57-04:00 Fix some broken links and typos - - - - - 57affc56 by Ben Gamari at 2023-07-02T09:06:58-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3337ae711343ca30f6770fea3901966b7a13531...57affc56c5f56c423967b0aaf8c62fb18145a674 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3337ae711343ca30f6770fea3901966b7a13531...57affc56c5f56c423967b0aaf8c62fb18145a674 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:09:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:09:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a177097d2d_2e0e5b475e014548a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 81459042 by Torsten Schmits at 2023-07-02T09:08:41-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - f509e0d9 by Ben Gamari at 2023-07-02T09:08:42-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - b930c3e0 by Ben Gamari at 2023-07-02T09:08:42-04:00 testsuite: Add test for #23400 - - - - - 43e0f7f6 by Ben Gamari at 2023-07-02T09:08:44-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - e624f2c3 by Ben Bellick at 2023-07-02T09:08:49-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 863ddfb2 by Moisés Ackerman at 2023-07-02T09:08:54-04:00 Add failing test case for #23492 - - - - - 40cdf656 by Moisés Ackerman at 2023-07-02T09:08:54-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 119d5c19 by Moisés Ackerman at 2023-07-02T09:08:54-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - f46426e8 by Moisés Ackerman at 2023-07-02T09:08:54-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - de8399f6 by Ryan Hendrickson at 2023-07-02T09:09:00-04:00 Add regression test for #23549 - - - - - 138b73f9 by Alexis King at 2023-07-02T09:09:10-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 33343045 by Bryan Richter at 2023-07-02T09:09:11-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 1670a76c by Ben Gamari at 2023-07-02T09:09:11-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d30e8bee by Ben Gamari at 2023-07-02T09:09:12-04:00 testsuite: Update documentation - - - - - e81155c9 by Gregory Gerasev at 2023-07-02T09:09:16-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 1be95fbf by Dave Barton at 2023-07-02T09:09:20-04:00 Fix some broken links and typos - - - - - 7594f381 by Ben Gamari at 2023-07-02T09:09:21-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57affc56c5f56c423967b0aaf8c62fb18145a674...7594f38166946469c3114fd192c93cf8b504ec49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57affc56c5f56c423967b0aaf8c62fb18145a674...7594f38166946469c3114fd192c93cf8b504ec49 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:11:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:11:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17797ed62a_2e0e5b475041576d2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 612db71a by Torsten Schmits at 2023-07-02T09:11:07-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - eaf7d5ca by Ben Gamari at 2023-07-02T09:11:08-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 1941e5ee by Ben Gamari at 2023-07-02T09:11:08-04:00 testsuite: Add test for #23400 - - - - - cd347b18 by Ben Gamari at 2023-07-02T09:11:10-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - eaf3a8d7 by Ben Bellick at 2023-07-02T09:11:15-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - e0ebc602 by Moisés Ackerman at 2023-07-02T09:11:20-04:00 Add failing test case for #23492 - - - - - c0aef4f9 by Moisés Ackerman at 2023-07-02T09:11:20-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 14b1e277 by Moisés Ackerman at 2023-07-02T09:11:20-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - cdb0f4ac by Moisés Ackerman at 2023-07-02T09:11:20-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 2fafb76f by Ryan Hendrickson at 2023-07-02T09:11:26-04:00 Add regression test for #23549 - - - - - 4a391e2b by Alexis King at 2023-07-02T09:11:37-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - fc60c1d8 by Bryan Richter at 2023-07-02T09:11:37-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 961b7eb6 by Ben Gamari at 2023-07-02T09:11:38-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 92a2d04f by Ben Gamari at 2023-07-02T09:11:38-04:00 testsuite: Update documentation - - - - - c1844d1e by Gregory Gerasev at 2023-07-02T09:11:43-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4dca8c78 by Dave Barton at 2023-07-02T09:11:47-04:00 Fix some broken links and typos - - - - - 1e908948 by Ben Gamari at 2023-07-02T09:11:47-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7594f38166946469c3114fd192c93cf8b504ec49...1e908948029404750d22a4996ff7eeb3e698472e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7594f38166946469c3114fd192c93cf8b504ec49...1e908948029404750d22a4996ff7eeb3e698472e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:14:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:14:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a178221379f_2e0e5b475cc1578e1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5fba08ba by Torsten Schmits at 2023-07-02T09:13:25-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d94fb32b by Ben Gamari at 2023-07-02T09:13:26-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 08a6a04a by Ben Gamari at 2023-07-02T09:13:26-04:00 testsuite: Add test for #23400 - - - - - 1dec5dc5 by Ben Gamari at 2023-07-02T09:13:28-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 5451a2f9 by Ben Bellick at 2023-07-02T09:13:33-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 2b21b681 by Moisés Ackerman at 2023-07-02T09:13:39-04:00 Add failing test case for #23492 - - - - - 04673007 by Moisés Ackerman at 2023-07-02T09:13:39-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 45cdc727 by Moisés Ackerman at 2023-07-02T09:13:39-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 83b0495e by Moisés Ackerman at 2023-07-02T09:13:39-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - ef95d79c by Ryan Hendrickson at 2023-07-02T09:13:44-04:00 Add regression test for #23549 - - - - - 44458764 by Alexis King at 2023-07-02T09:13:55-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - b3aa055d by Bryan Richter at 2023-07-02T09:13:56-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 4449b705 by Ben Gamari at 2023-07-02T09:13:56-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a02276f1 by Ben Gamari at 2023-07-02T09:13:56-04:00 testsuite: Update documentation - - - - - 928ce956 by Gregory Gerasev at 2023-07-02T09:14:01-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 9e806463 by Dave Barton at 2023-07-02T09:14:05-04:00 Fix some broken links and typos - - - - - bfec4fd9 by Ben Gamari at 2023-07-02T09:14:05-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e908948029404750d22a4996ff7eeb3e698472e...bfec4fd9a5ed22619517ca5c2db757ad7f87d282 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e908948029404750d22a4996ff7eeb3e698472e...bfec4fd9a5ed22619517ca5c2db757ad7f87d282 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:16:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:16:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a178b25894b_2e0e5b474f0158067@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5468d148 by Torsten Schmits at 2023-07-02T09:15:44-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 4dfb3284 by Ben Gamari at 2023-07-02T09:15:46-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 187b0d4a by Ben Gamari at 2023-07-02T09:15:46-04:00 testsuite: Add test for #23400 - - - - - 94b2a45e by Ben Gamari at 2023-07-02T09:15:47-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a04983cb by Ben Bellick at 2023-07-02T09:15:52-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 8c5a79ae by Moisés Ackerman at 2023-07-02T09:15:58-04:00 Add failing test case for #23492 - - - - - 28082b86 by Moisés Ackerman at 2023-07-02T09:15:58-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 0d268ad4 by Moisés Ackerman at 2023-07-02T09:15:58-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 9a78f1da by Moisés Ackerman at 2023-07-02T09:15:58-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 037aa5e2 by Ryan Hendrickson at 2023-07-02T09:16:04-04:00 Add regression test for #23549 - - - - - 518d2f18 by Alexis King at 2023-07-02T09:16:15-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - bfb7370b by Bryan Richter at 2023-07-02T09:16:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - c73b1663 by Ben Gamari at 2023-07-02T09:16:16-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 47479037 by Ben Gamari at 2023-07-02T09:16:16-04:00 testsuite: Update documentation - - - - - d70a80d4 by Gregory Gerasev at 2023-07-02T09:16:22-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4e462975 by Dave Barton at 2023-07-02T09:16:29-04:00 Fix some broken links and typos - - - - - 92778f1e by Ben Gamari at 2023-07-02T09:16:29-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfec4fd9a5ed22619517ca5c2db757ad7f87d282...92778f1eb6dbe49e267197d91fc0f922d28cedca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfec4fd9a5ed22619517ca5c2db757ad7f87d282...92778f1eb6dbe49e267197d91fc0f922d28cedca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:19:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:19:02 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17946c205b_2e0e5b475cc1582cf@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 25620db3 by Torsten Schmits at 2023-07-02T09:18:16-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 36b1c767 by Ben Gamari at 2023-07-02T09:18:17-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 2cca7515 by Ben Gamari at 2023-07-02T09:18:17-04:00 testsuite: Add test for #23400 - - - - - e8359683 by Ben Gamari at 2023-07-02T09:18:19-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 4113c09d by Ben Bellick at 2023-07-02T09:18:24-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6c23b714 by Moisés Ackerman at 2023-07-02T09:18:30-04:00 Add failing test case for #23492 - - - - - 6c4ca540 by Moisés Ackerman at 2023-07-02T09:18:30-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 597dffe2 by Moisés Ackerman at 2023-07-02T09:18:30-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - c4f13731 by Moisés Ackerman at 2023-07-02T09:18:30-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - ccb279bb by Ryan Hendrickson at 2023-07-02T09:18:36-04:00 Add regression test for #23549 - - - - - 3f8c02e0 by Alexis King at 2023-07-02T09:18:48-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 19594706 by Bryan Richter at 2023-07-02T09:18:48-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6079263f by Ben Gamari at 2023-07-02T09:18:48-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - ff50453f by Ben Gamari at 2023-07-02T09:18:49-04:00 testsuite: Update documentation - - - - - b66e0629 by Gregory Gerasev at 2023-07-02T09:18:53-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 2e8c05f3 by Dave Barton at 2023-07-02T09:18:57-04:00 Fix some broken links and typos - - - - - e883120f by Ben Gamari at 2023-07-02T09:18:58-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92778f1eb6dbe49e267197d91fc0f922d28cedca...e883120f4cd16c0dd6e84ba5389183cd0b9e9269 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92778f1eb6dbe49e267197d91fc0f922d28cedca...e883120f4cd16c0dd6e84ba5389183cd0b9e9269 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:21:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:21:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a179d5565ed_2e0e5b475041584d2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0c27ad61 by Torsten Schmits at 2023-07-02T09:20:39-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 9f82f715 by Ben Gamari at 2023-07-02T09:20:40-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 3792a9d2 by Ben Gamari at 2023-07-02T09:20:40-04:00 testsuite: Add test for #23400 - - - - - 4c68e73d by Ben Gamari at 2023-07-02T09:20:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - ceffccbb by Ben Bellick at 2023-07-02T09:20:47-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6796d5e8 by Moisés Ackerman at 2023-07-02T09:20:53-04:00 Add failing test case for #23492 - - - - - 107c43b5 by Moisés Ackerman at 2023-07-02T09:20:53-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 722e1482 by Moisés Ackerman at 2023-07-02T09:20:53-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 0eb78cef by Moisés Ackerman at 2023-07-02T09:20:53-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 4c79545f by Ryan Hendrickson at 2023-07-02T09:20:59-04:00 Add regression test for #23549 - - - - - d7d59ac1 by Alexis King at 2023-07-02T09:21:10-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 993e0e3a by Bryan Richter at 2023-07-02T09:21:10-04:00 Add missing void prototypes to rts functions See #23561. - - - - - a3917abc by Ben Gamari at 2023-07-02T09:21:11-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 708acd95 by Ben Gamari at 2023-07-02T09:21:11-04:00 testsuite: Update documentation - - - - - 2ccc8edf by Gregory Gerasev at 2023-07-02T09:21:16-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - f0285543 by Dave Barton at 2023-07-02T09:21:20-04:00 Fix some broken links and typos - - - - - 14f1c58f by Ben Gamari at 2023-07-02T09:21:20-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e883120f4cd16c0dd6e84ba5389183cd0b9e9269...14f1c58f0372fe2eb76cb2ef35bd02d69998f07a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e883120f4cd16c0dd6e84ba5389183cd0b9e9269...14f1c58f0372fe2eb76cb2ef35bd02d69998f07a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:23:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:23:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17a5eafd5e_2e0e5b474f0158685@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7ab41cff by Torsten Schmits at 2023-07-02T09:22:58-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - b759e7fd by Ben Gamari at 2023-07-02T09:22:59-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - aa455cce by Ben Gamari at 2023-07-02T09:22:59-04:00 testsuite: Add test for #23400 - - - - - 56cefdd8 by Ben Gamari at 2023-07-02T09:23:00-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - d98cf604 by Ben Bellick at 2023-07-02T09:23:05-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 2c078145 by Moisés Ackerman at 2023-07-02T09:23:11-04:00 Add failing test case for #23492 - - - - - 5c8196b4 by Moisés Ackerman at 2023-07-02T09:23:11-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 6a0a8a83 by Moisés Ackerman at 2023-07-02T09:23:11-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - d61ca395 by Moisés Ackerman at 2023-07-02T09:23:11-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 1ed280b7 by Ryan Hendrickson at 2023-07-02T09:23:17-04:00 Add regression test for #23549 - - - - - fe0a99c4 by Alexis King at 2023-07-02T09:23:27-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - d7e6f60c by Bryan Richter at 2023-07-02T09:23:28-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 7c3c4345 by Ben Gamari at 2023-07-02T09:23:28-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - dfa54c0e by Ben Gamari at 2023-07-02T09:23:29-04:00 testsuite: Update documentation - - - - - a7275445 by Gregory Gerasev at 2023-07-02T09:23:33-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 950045d1 by Dave Barton at 2023-07-02T09:23:37-04:00 Fix some broken links and typos - - - - - dadb5395 by Ben Gamari at 2023-07-02T09:23:38-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14f1c58f0372fe2eb76cb2ef35bd02d69998f07a...dadb5395b3e6aae65645bd9f8fb792ff854da103 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/14f1c58f0372fe2eb76cb2ef35bd02d69998f07a...dadb5395b3e6aae65645bd9f8fb792ff854da103 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:26:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:26:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17af3cb704_2e0e5b475901588e3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 38de0368 by Torsten Schmits at 2023-07-02T09:25:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 46737b5b by Ben Gamari at 2023-07-02T09:25:28-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 0b66354f by Ben Gamari at 2023-07-02T09:25:28-04:00 testsuite: Add test for #23400 - - - - - 57dac2e8 by Ben Gamari at 2023-07-02T09:25:30-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 79d7528f by Ben Bellick at 2023-07-02T09:25:34-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - e0536952 by Moisés Ackerman at 2023-07-02T09:25:40-04:00 Add failing test case for #23492 - - - - - 3590acb3 by Moisés Ackerman at 2023-07-02T09:25:40-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c9ebf34c by Moisés Ackerman at 2023-07-02T09:25:40-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - af001d6a by Moisés Ackerman at 2023-07-02T09:25:40-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 5bb73509 by Ryan Hendrickson at 2023-07-02T09:25:46-04:00 Add regression test for #23549 - - - - - 94548e53 by Alexis King at 2023-07-02T09:25:57-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 2f57801e by Bryan Richter at 2023-07-02T09:25:57-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 132d96bf by Ben Gamari at 2023-07-02T09:25:57-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 1233fbec by Ben Gamari at 2023-07-02T09:25:58-04:00 testsuite: Update documentation - - - - - 24a360b2 by Gregory Gerasev at 2023-07-02T09:26:02-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - bf47d29a by Dave Barton at 2023-07-02T09:26:06-04:00 Fix some broken links and typos - - - - - 7e8a7f56 by Ben Gamari at 2023-07-02T09:26:07-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dadb5395b3e6aae65645bd9f8fb792ff854da103...7e8a7f566afcf5817209699395b6bf17564ccd01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dadb5395b3e6aae65645bd9f8fb792ff854da103...7e8a7f566afcf5817209699395b6bf17564ccd01 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:28:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:28:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17b82e573_2e0e5b475181590de@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d628a44e by Torsten Schmits at 2023-07-02T09:27:48-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d1386ad8 by Ben Gamari at 2023-07-02T09:27:50-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - da00cb96 by Ben Gamari at 2023-07-02T09:27:50-04:00 testsuite: Add test for #23400 - - - - - 4208b73a by Ben Gamari at 2023-07-02T09:27:51-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 6bd693fe by Ben Bellick at 2023-07-02T09:27:56-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 1e2633e2 by Moisés Ackerman at 2023-07-02T09:28:01-04:00 Add failing test case for #23492 - - - - - 9bdf2695 by Moisés Ackerman at 2023-07-02T09:28:01-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - ca8594cc by Moisés Ackerman at 2023-07-02T09:28:02-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 725cd091 by Moisés Ackerman at 2023-07-02T09:28:02-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 07e503f4 by Ryan Hendrickson at 2023-07-02T09:28:08-04:00 Add regression test for #23549 - - - - - f213f860 by Alexis King at 2023-07-02T09:28:18-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 37e19109 by Bryan Richter at 2023-07-02T09:28:18-04:00 Add missing void prototypes to rts functions See #23561. - - - - - a9de5e25 by Ben Gamari at 2023-07-02T09:28:19-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa9235e2 by Ben Gamari at 2023-07-02T09:28:19-04:00 testsuite: Update documentation - - - - - 2119a8b7 by Gregory Gerasev at 2023-07-02T09:28:25-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 76fe881a by Dave Barton at 2023-07-02T09:28:29-04:00 Fix some broken links and typos - - - - - 40116853 by Ben Gamari at 2023-07-02T09:28:29-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e8a7f566afcf5817209699395b6bf17564ccd01...401168537eb65fcee4119667e382601506b698f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e8a7f566afcf5817209699395b6bf17564ccd01...401168537eb65fcee4119667e382601506b698f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:30:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:30:48 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17c0878c60_2e0e5b4752c159220@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 18140ec6 by Torsten Schmits at 2023-07-02T09:30:04-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fa918c59 by Ben Gamari at 2023-07-02T09:30:05-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - f021dd5d by Ben Gamari at 2023-07-02T09:30:05-04:00 testsuite: Add test for #23400 - - - - - 27c000c9 by Ben Gamari at 2023-07-02T09:30:07-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - f0ba0ae8 by Ben Bellick at 2023-07-02T09:30:11-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 06a83c6a by Moisés Ackerman at 2023-07-02T09:30:17-04:00 Add failing test case for #23492 - - - - - aebd6b92 by Moisés Ackerman at 2023-07-02T09:30:17-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 490079eb by Moisés Ackerman at 2023-07-02T09:30:17-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - a5adfa87 by Moisés Ackerman at 2023-07-02T09:30:17-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 9235acf6 by Ryan Hendrickson at 2023-07-02T09:30:23-04:00 Add regression test for #23549 - - - - - 058e5906 by Alexis King at 2023-07-02T09:30:33-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 245ae032 by Bryan Richter at 2023-07-02T09:30:34-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6ed7a4f8 by Ben Gamari at 2023-07-02T09:30:34-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - fd808aeb by Ben Gamari at 2023-07-02T09:30:35-04:00 testsuite: Update documentation - - - - - e63a3857 by Gregory Gerasev at 2023-07-02T09:30:39-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 12d03275 by Dave Barton at 2023-07-02T09:30:43-04:00 Fix some broken links and typos - - - - - e387bbfe by Ben Gamari at 2023-07-02T09:30:44-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/401168537eb65fcee4119667e382601506b698f9...e387bbfe3313064ffc8abe8a55519a6f855890b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/401168537eb65fcee4119667e382601506b698f9...e387bbfe3313064ffc8abe8a55519a6f855890b7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:33:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:33:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17c97c3519_2e0e5b475cc159419@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f24bcf3b by Torsten Schmits at 2023-07-02T09:32:22-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 420b8c03 by Ben Gamari at 2023-07-02T09:32:23-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 7a09177f by Ben Gamari at 2023-07-02T09:32:23-04:00 testsuite: Add test for #23400 - - - - - 9420bd04 by Ben Gamari at 2023-07-02T09:32:25-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a5c50fb6 by Ben Bellick at 2023-07-02T09:32:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 66c329e3 by Moisés Ackerman at 2023-07-02T09:32:37-04:00 Add failing test case for #23492 - - - - - 6759d890 by Moisés Ackerman at 2023-07-02T09:32:37-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - f1c2b51b by Moisés Ackerman at 2023-07-02T09:32:37-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 8ed29569 by Moisés Ackerman at 2023-07-02T09:32:37-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - b1b78871 by Ryan Hendrickson at 2023-07-02T09:32:42-04:00 Add regression test for #23549 - - - - - 75e05f5a by Alexis King at 2023-07-02T09:32:53-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - c9a6f079 by Bryan Richter at 2023-07-02T09:32:53-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 4f6d02f9 by Ben Gamari at 2023-07-02T09:32:54-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - b8ae88ca by Ben Gamari at 2023-07-02T09:32:54-04:00 testsuite: Update documentation - - - - - 29e8e1f1 by Gregory Gerasev at 2023-07-02T09:32:59-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - d64e1511 by Dave Barton at 2023-07-02T09:33:02-04:00 Fix some broken links and typos - - - - - d895ebf6 by Ben Gamari at 2023-07-02T09:33:03-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e387bbfe3313064ffc8abe8a55519a6f855890b7...d895ebf6fdfc16f46efa03f088eb0af3c9d5550c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e387bbfe3313064ffc8abe8a55519a6f855890b7...d895ebf6fdfc16f46efa03f088eb0af3c9d5550c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:35:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:35:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17d20b2eb0_2e0e5b4759015965e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: de17fed4 by Torsten Schmits at 2023-07-02T09:34:44-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - cb5e756f by Ben Gamari at 2023-07-02T09:34:45-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 53af1250 by Ben Gamari at 2023-07-02T09:34:45-04:00 testsuite: Add test for #23400 - - - - - 77284b99 by Ben Gamari at 2023-07-02T09:34:47-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - c6f37e9c by Ben Bellick at 2023-07-02T09:34:51-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 60539104 by Moisés Ackerman at 2023-07-02T09:34:57-04:00 Add failing test case for #23492 - - - - - 793612ca by Moisés Ackerman at 2023-07-02T09:34:57-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 288b798a by Moisés Ackerman at 2023-07-02T09:34:57-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 79b76e93 by Moisés Ackerman at 2023-07-02T09:34:57-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - b3f5e477 by Ryan Hendrickson at 2023-07-02T09:35:03-04:00 Add regression test for #23549 - - - - - b6ffff11 by Alexis King at 2023-07-02T09:35:14-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - eb8a8872 by Bryan Richter at 2023-07-02T09:35:14-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 247bd0d6 by Ben Gamari at 2023-07-02T09:35:15-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 2947c443 by Ben Gamari at 2023-07-02T09:35:15-04:00 testsuite: Update documentation - - - - - a97e085f by Gregory Gerasev at 2023-07-02T09:35:20-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - bb68bde2 by Dave Barton at 2023-07-02T09:35:23-04:00 Fix some broken links and typos - - - - - b8a954c1 by Ben Gamari at 2023-07-02T09:35:24-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d895ebf6fdfc16f46efa03f088eb0af3c9d5550c...b8a954c1d6a1cf64ed04eeb39370a13724a1350e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d895ebf6fdfc16f46efa03f088eb0af3c9d5550c...b8a954c1d6a1cf64ed04eeb39370a13724a1350e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:37:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:37:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17daae214d_2e0e5b475f4161853@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: aed6ea95 by Torsten Schmits at 2023-07-02T09:37:01-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - da290d06 by Ben Gamari at 2023-07-02T09:37:03-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 10ca5729 by Ben Gamari at 2023-07-02T09:37:03-04:00 testsuite: Add test for #23400 - - - - - aa89fb4b by Ben Gamari at 2023-07-02T09:37:05-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - f09712a9 by Ben Bellick at 2023-07-02T09:37:09-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 010e7f86 by Moisés Ackerman at 2023-07-02T09:37:15-04:00 Add failing test case for #23492 - - - - - 6efad199 by Moisés Ackerman at 2023-07-02T09:37:15-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - cbd450a6 by Moisés Ackerman at 2023-07-02T09:37:15-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 1a22c8d2 by Moisés Ackerman at 2023-07-02T09:37:15-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 2d2deb68 by Ryan Hendrickson at 2023-07-02T09:37:21-04:00 Add regression test for #23549 - - - - - 649e9778 by Alexis King at 2023-07-02T09:37:31-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 81119bd6 by Bryan Richter at 2023-07-02T09:37:32-04:00 Add missing void prototypes to rts functions See #23561. - - - - - fda45715 by Ben Gamari at 2023-07-02T09:37:32-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d5b293eb by Ben Gamari at 2023-07-02T09:37:33-04:00 testsuite: Update documentation - - - - - 8748ff0c by Gregory Gerasev at 2023-07-02T09:37:38-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - f016d2e2 by Dave Barton at 2023-07-02T09:37:41-04:00 Fix some broken links and typos - - - - - 32cc22db by Ben Gamari at 2023-07-02T09:37:42-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8a954c1d6a1cf64ed04eeb39370a13724a1350e...32cc22db34569a27a8cc7b89bb0dc2edf323886d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8a954c1d6a1cf64ed04eeb39370a13724a1350e...32cc22db34569a27a8cc7b89bb0dc2edf323886d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:40:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:40:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17e3471d32_2e0e5b475401620d3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ecbe5fba by Torsten Schmits at 2023-07-02T09:39:18-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - e5351c27 by Ben Gamari at 2023-07-02T09:39:19-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ceb515ff by Ben Gamari at 2023-07-02T09:39:19-04:00 testsuite: Add test for #23400 - - - - - 28c4bed9 by Ben Gamari at 2023-07-02T09:39:21-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - b299f905 by Ben Bellick at 2023-07-02T09:39:25-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - aaed2002 by Moisés Ackerman at 2023-07-02T09:39:31-04:00 Add failing test case for #23492 - - - - - 3d33f47e by Moisés Ackerman at 2023-07-02T09:39:31-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 72c20f6a by Moisés Ackerman at 2023-07-02T09:39:31-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - a011682d by Moisés Ackerman at 2023-07-02T09:39:31-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 231071a5 by Ryan Hendrickson at 2023-07-02T09:39:37-04:00 Add regression test for #23549 - - - - - 8d001adf by Alexis King at 2023-07-02T09:39:48-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 0ce004a2 by Bryan Richter at 2023-07-02T09:39:49-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 8a26e565 by Ben Gamari at 2023-07-02T09:39:49-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9c37bb82 by Ben Gamari at 2023-07-02T09:39:49-04:00 testsuite: Update documentation - - - - - 8081efd0 by Gregory Gerasev at 2023-07-02T09:39:54-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 89f9c569 by Dave Barton at 2023-07-02T09:39:58-04:00 Fix some broken links and typos - - - - - 7c577e32 by Ben Gamari at 2023-07-02T09:39:58-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32cc22db34569a27a8cc7b89bb0dc2edf323886d...7c577e3221297508ac663bd3fc439b1417aacac6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32cc22db34569a27a8cc7b89bb0dc2edf323886d...7c577e3221297508ac663bd3fc439b1417aacac6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:42:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:42:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17eba34ba3_2e0e5b475e01622e9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 820b5714 by Torsten Schmits at 2023-07-02T09:41:34-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 790d05bc by Ben Gamari at 2023-07-02T09:41:35-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ed7a17d5 by Ben Gamari at 2023-07-02T09:41:35-04:00 testsuite: Add test for #23400 - - - - - 660b7d84 by Ben Gamari at 2023-07-02T09:41:37-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - f0a9bac9 by Ben Bellick at 2023-07-02T09:41:41-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 494acf0a by Moisés Ackerman at 2023-07-02T09:41:47-04:00 Add failing test case for #23492 - - - - - 285f5d36 by Moisés Ackerman at 2023-07-02T09:41:47-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 449978e8 by Moisés Ackerman at 2023-07-02T09:41:47-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 6d7f5316 by Moisés Ackerman at 2023-07-02T09:41:47-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 4ae023ce by Ryan Hendrickson at 2023-07-02T09:41:53-04:00 Add regression test for #23549 - - - - - 1acfd663 by Alexis King at 2023-07-02T09:42:04-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 3999b530 by Bryan Richter at 2023-07-02T09:42:04-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 4eedf997 by Ben Gamari at 2023-07-02T09:42:04-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 26f3c5cc by Ben Gamari at 2023-07-02T09:42:05-04:00 testsuite: Update documentation - - - - - 0b40731e by Gregory Gerasev at 2023-07-02T09:42:09-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - ad515173 by Dave Barton at 2023-07-02T09:42:13-04:00 Fix some broken links and typos - - - - - 26c6e553 by Ben Gamari at 2023-07-02T09:42:14-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c577e3221297508ac663bd3fc439b1417aacac6...26c6e5534fb10299689ff2afc23fe3f400552d54 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c577e3221297508ac663bd3fc439b1417aacac6...26c6e5534fb10299689ff2afc23fe3f400552d54 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:44:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:44:32 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17f4013959_2e0e5b475cc162413@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fa594380 by Torsten Schmits at 2023-07-02T09:43:47-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - a72f15df by Ben Gamari at 2023-07-02T09:43:49-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 8976f9c1 by Ben Gamari at 2023-07-02T09:43:49-04:00 testsuite: Add test for #23400 - - - - - cc32711d by Ben Gamari at 2023-07-02T09:43:50-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - bc5caf3f by Ben Bellick at 2023-07-02T09:43:55-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6a274ec9 by Moisés Ackerman at 2023-07-02T09:44:00-04:00 Add failing test case for #23492 - - - - - 26190b19 by Moisés Ackerman at 2023-07-02T09:44:00-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 8e27037f by Moisés Ackerman at 2023-07-02T09:44:01-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 387fd2da by Moisés Ackerman at 2023-07-02T09:44:01-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 17c009b1 by Ryan Hendrickson at 2023-07-02T09:44:06-04:00 Add regression test for #23549 - - - - - 2d0eb2a9 by Alexis King at 2023-07-02T09:44:17-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 38d1d556 by Bryan Richter at 2023-07-02T09:44:17-04:00 Add missing void prototypes to rts functions See #23561. - - - - - c247d779 by Ben Gamari at 2023-07-02T09:44:18-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - c36d5bf8 by Ben Gamari at 2023-07-02T09:44:18-04:00 testsuite: Update documentation - - - - - 3b0f5215 by Gregory Gerasev at 2023-07-02T09:44:23-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4e453d80 by Dave Barton at 2023-07-02T09:44:27-04:00 Fix some broken links and typos - - - - - 68a05d7e by Ben Gamari at 2023-07-02T09:44:27-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26c6e5534fb10299689ff2afc23fe3f400552d54...68a05d7e5b876a74028b8fa12d40353ddbc24cfe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26c6e5534fb10299689ff2afc23fe3f400552d54...68a05d7e5b876a74028b8fa12d40353ddbc24cfe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:46:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:46:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a17fc333545_2e0e5b4752c1626cd@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9c9cdd1e by Torsten Schmits at 2023-07-02T09:45:59-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - adcc0538 by Ben Gamari at 2023-07-02T09:46:00-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ceb26283 by Ben Gamari at 2023-07-02T09:46:00-04:00 testsuite: Add test for #23400 - - - - - 934084e5 by Ben Gamari at 2023-07-02T09:46:02-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 5666b34b by Ben Bellick at 2023-07-02T09:46:06-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 4fed15f6 by Moisés Ackerman at 2023-07-02T09:46:12-04:00 Add failing test case for #23492 - - - - - 8d258548 by Moisés Ackerman at 2023-07-02T09:46:12-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c273db24 by Moisés Ackerman at 2023-07-02T09:46:12-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 80b3decb by Moisés Ackerman at 2023-07-02T09:46:12-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 711f151b by Ryan Hendrickson at 2023-07-02T09:46:18-04:00 Add regression test for #23549 - - - - - 3d8b1381 by Alexis King at 2023-07-02T09:46:29-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - a4079c18 by Bryan Richter at 2023-07-02T09:46:29-04:00 Add missing void prototypes to rts functions See #23561. - - - - - ecb0b2a3 by Ben Gamari at 2023-07-02T09:46:29-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 25afe8fb by Ben Gamari at 2023-07-02T09:46:30-04:00 testsuite: Update documentation - - - - - 7849921c by Gregory Gerasev at 2023-07-02T09:46:34-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - fc734d36 by Dave Barton at 2023-07-02T09:46:38-04:00 Fix some broken links and typos - - - - - b289a1a9 by Ben Gamari at 2023-07-02T09:46:39-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68a05d7e5b876a74028b8fa12d40353ddbc24cfe...b289a1a9ac01656d69f42d3c44e1bad32249874a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68a05d7e5b876a74028b8fa12d40353ddbc24cfe...b289a1a9ac01656d69f42d3c44e1bad32249874a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:49:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:49:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1804c7c77f_2e0e5b475181628b6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ffc2a762 by Torsten Schmits at 2023-07-02T09:48:16-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 08db8994 by Ben Gamari at 2023-07-02T09:48:17-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - db391517 by Ben Gamari at 2023-07-02T09:48:17-04:00 testsuite: Add test for #23400 - - - - - 47661b04 by Ben Gamari at 2023-07-02T09:48:19-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 31931b3c by Ben Bellick at 2023-07-02T09:48:23-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 596a19e4 by Moisés Ackerman at 2023-07-02T09:48:29-04:00 Add failing test case for #23492 - - - - - f19131b4 by Moisés Ackerman at 2023-07-02T09:48:29-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3d4e1a7e by Moisés Ackerman at 2023-07-02T09:48:29-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 590da2a1 by Moisés Ackerman at 2023-07-02T09:48:29-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 3e4196f9 by Ryan Hendrickson at 2023-07-02T09:48:35-04:00 Add regression test for #23549 - - - - - ece45c55 by Alexis King at 2023-07-02T09:48:46-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 1c4a1a9a by Bryan Richter at 2023-07-02T09:48:46-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 93f6629d by Ben Gamari at 2023-07-02T09:48:46-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 73c51a9a by Ben Gamari at 2023-07-02T09:48:47-04:00 testsuite: Update documentation - - - - - fa02326a by Gregory Gerasev at 2023-07-02T09:48:51-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - eece8cd2 by Dave Barton at 2023-07-02T09:48:55-04:00 Fix some broken links and typos - - - - - 208f5d70 by Ben Gamari at 2023-07-02T09:48:56-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b289a1a9ac01656d69f42d3c44e1bad32249874a...208f5d707e9ad2e1add4796c4e051c7a7e896c5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b289a1a9ac01656d69f42d3c44e1bad32249874a...208f5d707e9ad2e1add4796c4e051c7a7e896c5a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:51:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:51:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a180d5d053e_2e0e5b475b8163038@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b9df3eb0 by Torsten Schmits at 2023-07-02T09:50:33-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d09d00f2 by Ben Gamari at 2023-07-02T09:50:34-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6926e108 by Ben Gamari at 2023-07-02T09:50:34-04:00 testsuite: Add test for #23400 - - - - - 9d53ea90 by Ben Gamari at 2023-07-02T09:50:35-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 8687494b by Ben Bellick at 2023-07-02T09:50:40-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - ef29fb36 by Moisés Ackerman at 2023-07-02T09:50:46-04:00 Add failing test case for #23492 - - - - - cab9ef24 by Moisés Ackerman at 2023-07-02T09:50:46-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 06253542 by Moisés Ackerman at 2023-07-02T09:50:46-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - b086cfb5 by Moisés Ackerman at 2023-07-02T09:50:46-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 7ca2a5ff by Ryan Hendrickson at 2023-07-02T09:50:52-04:00 Add regression test for #23549 - - - - - 3bf3b7eb by Alexis King at 2023-07-02T09:51:03-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 99e78d36 by Bryan Richter at 2023-07-02T09:51:03-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6e59acc4 by Ben Gamari at 2023-07-02T09:51:04-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9d483013 by Ben Gamari at 2023-07-02T09:51:04-04:00 testsuite: Update documentation - - - - - 3d7475d3 by Gregory Gerasev at 2023-07-02T09:51:09-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - fae5a4c9 by Dave Barton at 2023-07-02T09:51:12-04:00 Fix some broken links and typos - - - - - bc7498c2 by Ben Gamari at 2023-07-02T09:51:13-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/208f5d707e9ad2e1add4796c4e051c7a7e896c5a...bc7498c2901a4a4ae031dd705d6d8e4edf8101ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/208f5d707e9ad2e1add4796c4e051c7a7e896c5a...bc7498c2901a4a4ae031dd705d6d8e4edf8101ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:53:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:53:35 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1815f23ad2_2e0e5b4752c16323e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 961b8515 by Torsten Schmits at 2023-07-02T09:52:48-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - aa44dca1 by Ben Gamari at 2023-07-02T09:52:49-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 531b569a by Ben Gamari at 2023-07-02T09:52:49-04:00 testsuite: Add test for #23400 - - - - - 6b994509 by Ben Gamari at 2023-07-02T09:52:51-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 20d8975d by Ben Bellick at 2023-07-02T09:52:56-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - b7d7d8e5 by Moisés Ackerman at 2023-07-02T09:53:01-04:00 Add failing test case for #23492 - - - - - 799773f3 by Moisés Ackerman at 2023-07-02T09:53:01-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 2ee74271 by Moisés Ackerman at 2023-07-02T09:53:01-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 30bbe3f7 by Moisés Ackerman at 2023-07-02T09:53:01-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - fc58f7fa by Ryan Hendrickson at 2023-07-02T09:53:08-04:00 Add regression test for #23549 - - - - - 5598b7e7 by Alexis King at 2023-07-02T09:53:19-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 5f3725e5 by Bryan Richter at 2023-07-02T09:53:19-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 8808bb4b by Ben Gamari at 2023-07-02T09:53:20-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a9c20b77 by Ben Gamari at 2023-07-02T09:53:20-04:00 testsuite: Update documentation - - - - - a4dd1755 by Gregory Gerasev at 2023-07-02T09:53:25-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - bb041b96 by Dave Barton at 2023-07-02T09:53:29-04:00 Fix some broken links and typos - - - - - 4051b60d by Ben Gamari at 2023-07-02T09:53:29-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc7498c2901a4a4ae031dd705d6d8e4edf8101ed...4051b60d3beb66c269a50f64a702db8242f87b2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc7498c2901a4a4ae031dd705d6d8e4edf8101ed...4051b60d3beb66c269a50f64a702db8242f87b2e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:55:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:55:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a181e6cf9d3_2e0e5b475041634c5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 58ddcf7e by Torsten Schmits at 2023-07-02T09:55:06-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 3ac1afe2 by Ben Gamari at 2023-07-02T09:55:07-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 9761d0e0 by Ben Gamari at 2023-07-02T09:55:07-04:00 testsuite: Add test for #23400 - - - - - 62b17f04 by Ben Gamari at 2023-07-02T09:55:09-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - c7c8d487 by Ben Bellick at 2023-07-02T09:55:13-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 0491df44 by Moisés Ackerman at 2023-07-02T09:55:19-04:00 Add failing test case for #23492 - - - - - a657eb00 by Moisés Ackerman at 2023-07-02T09:55:19-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 783f9354 by Moisés Ackerman at 2023-07-02T09:55:19-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 3b7490b6 by Moisés Ackerman at 2023-07-02T09:55:19-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0d877d97 by Ryan Hendrickson at 2023-07-02T09:55:26-04:00 Add regression test for #23549 - - - - - 6f389077 by Alexis King at 2023-07-02T09:55:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - f31513ce by Bryan Richter at 2023-07-02T09:55:36-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 2850e24d by Ben Gamari at 2023-07-02T09:55:37-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 55c03f74 by Ben Gamari at 2023-07-02T09:55:37-04:00 testsuite: Update documentation - - - - - cc663d43 by Gregory Gerasev at 2023-07-02T09:55:42-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - d3d5967d by Dave Barton at 2023-07-02T09:55:46-04:00 Fix some broken links and typos - - - - - b3e99008 by Ben Gamari at 2023-07-02T09:55:46-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4051b60d3beb66c269a50f64a702db8242f87b2e...b3e990088e717043d47d3f728155cbded68ff5dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4051b60d3beb66c269a50f64a702db8242f87b2e...b3e990088e717043d47d3f728155cbded68ff5dd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 13:58:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 09:58:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1826f5e98b_2e0e5b475401636d9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2ad774de by Torsten Schmits at 2023-07-02T09:57:21-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 2957a3c9 by Ben Gamari at 2023-07-02T09:57:22-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - b8eefa05 by Ben Gamari at 2023-07-02T09:57:22-04:00 testsuite: Add test for #23400 - - - - - ed196788 by Ben Gamari at 2023-07-02T09:57:24-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03addecc by Ben Bellick at 2023-07-02T09:57:28-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - a6f2315c by Moisés Ackerman at 2023-07-02T09:57:34-04:00 Add failing test case for #23492 - - - - - 0bf7aab5 by Moisés Ackerman at 2023-07-02T09:57:34-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 96552f91 by Moisés Ackerman at 2023-07-02T09:57:34-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 53bd2383 by Moisés Ackerman at 2023-07-02T09:57:34-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - d1844cc7 by Ryan Hendrickson at 2023-07-02T09:57:40-04:00 Add regression test for #23549 - - - - - 65c592f0 by Alexis King at 2023-07-02T09:57:51-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - b184bc4e by Bryan Richter at 2023-07-02T09:57:51-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 8e921fc5 by Ben Gamari at 2023-07-02T09:57:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 303c8322 by Ben Gamari at 2023-07-02T09:57:52-04:00 testsuite: Update documentation - - - - - 86ddf1d0 by Gregory Gerasev at 2023-07-02T09:57:56-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 028be31a by Dave Barton at 2023-07-02T09:58:00-04:00 Fix some broken links and typos - - - - - e25c3d9e by Ben Gamari at 2023-07-02T09:58:01-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3e990088e717043d47d3f728155cbded68ff5dd...e25c3d9e4edec11468173d478c6114393e9e59f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3e990088e717043d47d3f728155cbded68ff5dd...e25c3d9e4edec11468173d478c6114393e9e59f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:00:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:00:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a182f3b3a99_2e0e5b475041638c5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7fe0dc61 by Torsten Schmits at 2023-07-02T09:59:35-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 03f692c7 by Ben Gamari at 2023-07-02T09:59:36-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ee36bf79 by Ben Gamari at 2023-07-02T09:59:36-04:00 testsuite: Add test for #23400 - - - - - 0d8bf939 by Ben Gamari at 2023-07-02T09:59:38-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - f50525b8 by Ben Bellick at 2023-07-02T09:59:42-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - a69bbf3f by Moisés Ackerman at 2023-07-02T09:59:48-04:00 Add failing test case for #23492 - - - - - 00b5c921 by Moisés Ackerman at 2023-07-02T09:59:48-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 93ae933c by Moisés Ackerman at 2023-07-02T09:59:48-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - c3e03c78 by Moisés Ackerman at 2023-07-02T09:59:48-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - e629faff by Ryan Hendrickson at 2023-07-02T09:59:54-04:00 Add regression test for #23549 - - - - - 00f13a65 by Alexis King at 2023-07-02T10:00:04-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - a351908b by Bryan Richter at 2023-07-02T10:00:05-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 98f7e6b1 by Ben Gamari at 2023-07-02T10:00:05-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9471093d by Ben Gamari at 2023-07-02T10:00:06-04:00 testsuite: Update documentation - - - - - 505ab367 by Gregory Gerasev at 2023-07-02T10:00:11-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - e6882471 by Dave Barton at 2023-07-02T10:00:14-04:00 Fix some broken links and typos - - - - - 63d6192d by Ben Gamari at 2023-07-02T10:00:15-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e25c3d9e4edec11468173d478c6114393e9e59f5...63d6192d7f5a263431ddae682dfb824e18b9419c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e25c3d9e4edec11468173d478c6114393e9e59f5...63d6192d7f5a263431ddae682dfb824e18b9419c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:02:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:02:40 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a183809610b_2e0e5b474f01640ce@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: eee4b4f6 by Torsten Schmits at 2023-07-02T10:01:56-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 6a3a7f99 by Ben Gamari at 2023-07-02T10:01:57-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 3ebd67ba by Ben Gamari at 2023-07-02T10:01:57-04:00 testsuite: Add test for #23400 - - - - - f83aaca5 by Ben Gamari at 2023-07-02T10:01:59-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - d87d4b60 by Ben Bellick at 2023-07-02T10:02:03-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 666e2f2d by Moisés Ackerman at 2023-07-02T10:02:09-04:00 Add failing test case for #23492 - - - - - ce6eec08 by Moisés Ackerman at 2023-07-02T10:02:09-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c0c5132c by Moisés Ackerman at 2023-07-02T10:02:09-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 42014f1e by Moisés Ackerman at 2023-07-02T10:02:09-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 4af0fd84 by Ryan Hendrickson at 2023-07-02T10:02:15-04:00 Add regression test for #23549 - - - - - 3fe83814 by Alexis King at 2023-07-02T10:02:26-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 577f55d4 by Bryan Richter at 2023-07-02T10:02:26-04:00 Add missing void prototypes to rts functions See #23561. - - - - - b9d59766 by Ben Gamari at 2023-07-02T10:02:27-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 490a0ed0 by Ben Gamari at 2023-07-02T10:02:27-04:00 testsuite: Update documentation - - - - - 12797377 by Gregory Gerasev at 2023-07-02T10:02:32-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - dad61d44 by Dave Barton at 2023-07-02T10:02:36-04:00 Fix some broken links and typos - - - - - d5e496df by Ben Gamari at 2023-07-02T10:02:36-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63d6192d7f5a263431ddae682dfb824e18b9419c...d5e496df71df2c9364ef492d98fbe4e5a30d718e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63d6192d7f5a263431ddae682dfb824e18b9419c...d5e496df71df2c9364ef492d98fbe4e5a30d718e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:04:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:04:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a184071592b_2e0e5b475e01642f9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 84b308b0 by Torsten Schmits at 2023-07-02T10:04:10-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 043f4721 by Ben Gamari at 2023-07-02T10:04:11-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 0af4c295 by Ben Gamari at 2023-07-02T10:04:11-04:00 testsuite: Add test for #23400 - - - - - 2cf5ce1a by Ben Gamari at 2023-07-02T10:04:12-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - f5ac50fe by Ben Bellick at 2023-07-02T10:04:17-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 77ebe4cf by Moisés Ackerman at 2023-07-02T10:04:23-04:00 Add failing test case for #23492 - - - - - 63cd0368 by Moisés Ackerman at 2023-07-02T10:04:23-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - fe5b3b2b by Moisés Ackerman at 2023-07-02T10:04:23-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 474ab20f by Moisés Ackerman at 2023-07-02T10:04:23-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - cc54a153 by Ryan Hendrickson at 2023-07-02T10:04:29-04:00 Add regression test for #23549 - - - - - b78cf5aa by Alexis King at 2023-07-02T10:04:40-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 7a1c045b by Bryan Richter at 2023-07-02T10:04:41-04:00 Add missing void prototypes to rts functions See #23561. - - - - - fb0dae67 by Ben Gamari at 2023-07-02T10:04:41-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 3f41edfa by Ben Gamari at 2023-07-02T10:04:42-04:00 testsuite: Update documentation - - - - - b2101aee by Gregory Gerasev at 2023-07-02T10:04:46-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - f53637df by Dave Barton at 2023-07-02T10:04:50-04:00 Fix some broken links and typos - - - - - 0f2464cf by Ben Gamari at 2023-07-02T10:04:50-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5e496df71df2c9364ef492d98fbe4e5a30d718e...0f2464cff6e85110d566ee3d2254ea5bdc7e1a64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5e496df71df2c9364ef492d98fbe4e5a30d718e...0f2464cff6e85110d566ee3d2254ea5bdc7e1a64 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:07:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:07:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18493a7789_2e0e5b4759016443@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a2facebd by Torsten Schmits at 2023-07-02T10:06:24-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 076fa363 by Ben Gamari at 2023-07-02T10:06:25-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 3dd3aa11 by Ben Gamari at 2023-07-02T10:06:25-04:00 testsuite: Add test for #23400 - - - - - f8346aaf by Ben Gamari at 2023-07-02T10:06:27-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 41ea05b3 by Ben Bellick at 2023-07-02T10:06:32-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 86f9d19a by Moisés Ackerman at 2023-07-02T10:06:37-04:00 Add failing test case for #23492 - - - - - 751299a4 by Moisés Ackerman at 2023-07-02T10:06:37-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 6f2fe091 by Moisés Ackerman at 2023-07-02T10:06:37-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - be527cd0 by Moisés Ackerman at 2023-07-02T10:06:38-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 19fa3a11 by Ryan Hendrickson at 2023-07-02T10:06:44-04:00 Add regression test for #23549 - - - - - 7b08741d by Alexis King at 2023-07-02T10:06:54-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 3ba551c2 by Bryan Richter at 2023-07-02T10:06:54-04:00 Add missing void prototypes to rts functions See #23561. - - - - - c55cccd7 by Ben Gamari at 2023-07-02T10:06:55-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 68041676 by Ben Gamari at 2023-07-02T10:06:55-04:00 testsuite: Update documentation - - - - - 6d7ebbd3 by Gregory Gerasev at 2023-07-02T10:07:00-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - e4043973 by Dave Barton at 2023-07-02T10:07:04-04:00 Fix some broken links and typos - - - - - 423344eb by Ben Gamari at 2023-07-02T10:07:04-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f2464cff6e85110d566ee3d2254ea5bdc7e1a64...423344eb85403482fcbc0aceefff7851b6ab1f78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f2464cff6e85110d566ee3d2254ea5bdc7e1a64...423344eb85403482fcbc0aceefff7851b6ab1f78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:09:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:09:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a185165345b_2e0e5b475cc1646cf@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 25607c36 by Torsten Schmits at 2023-07-02T10:08:42-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 354cea1b by Ben Gamari at 2023-07-02T10:08:43-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 4db427ec by Ben Gamari at 2023-07-02T10:08:43-04:00 testsuite: Add test for #23400 - - - - - 2263181d by Ben Gamari at 2023-07-02T10:08:45-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 232b1567 by Ben Bellick at 2023-07-02T10:08:49-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 4bd8a953 by Moisés Ackerman at 2023-07-02T10:08:55-04:00 Add failing test case for #23492 - - - - - f4ec2cd0 by Moisés Ackerman at 2023-07-02T10:08:55-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - b0bf0498 by Moisés Ackerman at 2023-07-02T10:08:55-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - b5cc4d42 by Moisés Ackerman at 2023-07-02T10:08:55-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - e776a964 by Ryan Hendrickson at 2023-07-02T10:09:01-04:00 Add regression test for #23549 - - - - - 41aaa8ac by Alexis King at 2023-07-02T10:09:11-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 611f3fb1 by Bryan Richter at 2023-07-02T10:09:12-04:00 Add missing void prototypes to rts functions See #23561. - - - - - a5882107 by Ben Gamari at 2023-07-02T10:09:12-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 62ca74d6 by Ben Gamari at 2023-07-02T10:09:13-04:00 testsuite: Update documentation - - - - - 442d4e5c by Gregory Gerasev at 2023-07-02T10:09:17-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 8665fa84 by Dave Barton at 2023-07-02T10:09:21-04:00 Fix some broken links and typos - - - - - 736c06ad by Ben Gamari at 2023-07-02T10:09:22-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/423344eb85403482fcbc0aceefff7851b6ab1f78...736c06ad3d23858adc10ca3e82f3c68fcdc69cef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/423344eb85403482fcbc0aceefff7851b6ab1f78...736c06ad3d23858adc10ca3e82f3c68fcdc69cef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:11:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:11:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1859e550d8_2e0e5b475401648af@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ade59f29 by Torsten Schmits at 2023-07-02T10:10:57-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - dc6b0491 by Ben Gamari at 2023-07-02T10:10:58-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - eed9370c by Ben Gamari at 2023-07-02T10:10:58-04:00 testsuite: Add test for #23400 - - - - - a05406b0 by Ben Gamari at 2023-07-02T10:11:00-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 0b5ff56d by Ben Bellick at 2023-07-02T10:11:05-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - fa0573ba by Moisés Ackerman at 2023-07-02T10:11:10-04:00 Add failing test case for #23492 - - - - - ee5f132a by Moisés Ackerman at 2023-07-02T10:11:10-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 6bc2c7d3 by Moisés Ackerman at 2023-07-02T10:11:10-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - f67d5bf7 by Moisés Ackerman at 2023-07-02T10:11:10-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - a51b99dd by Ryan Hendrickson at 2023-07-02T10:11:16-04:00 Add regression test for #23549 - - - - - 5a43f167 by Alexis King at 2023-07-02T10:11:27-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 00d6d55a by Bryan Richter at 2023-07-02T10:11:27-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 35c724b6 by Ben Gamari at 2023-07-02T10:11:27-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 281e3397 by Ben Gamari at 2023-07-02T10:11:28-04:00 testsuite: Update documentation - - - - - 548feb70 by Gregory Gerasev at 2023-07-02T10:11:32-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 66afd191 by Dave Barton at 2023-07-02T10:11:36-04:00 Fix some broken links and typos - - - - - a8107057 by Ben Gamari at 2023-07-02T10:11:37-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/736c06ad3d23858adc10ca3e82f3c68fcdc69cef...a81070572b88e06bac16b1ffb76e20094eb604d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/736c06ad3d23858adc10ca3e82f3c68fcdc69cef...a81070572b88e06bac16b1ffb76e20094eb604d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:13:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:13:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18626e49f9_2e0e5b475401670f8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ae0cc49d by Torsten Schmits at 2023-07-02T10:13:14-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd6b4aeb by Ben Gamari at 2023-07-02T10:13:15-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 3a03a75e by Ben Gamari at 2023-07-02T10:13:15-04:00 testsuite: Add test for #23400 - - - - - e9097add by Ben Gamari at 2023-07-02T10:13:17-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 111dcfc9 by Ben Bellick at 2023-07-02T10:13:21-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 776f09f6 by Moisés Ackerman at 2023-07-02T10:13:27-04:00 Add failing test case for #23492 - - - - - 59a6e34b by Moisés Ackerman at 2023-07-02T10:13:27-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3e224e23 by Moisés Ackerman at 2023-07-02T10:13:27-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - e2503151 by Moisés Ackerman at 2023-07-02T10:13:27-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - c54af59e by Ryan Hendrickson at 2023-07-02T10:13:33-04:00 Add regression test for #23549 - - - - - 4cdccb51 by Alexis King at 2023-07-02T10:13:43-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - c31545cb by Bryan Richter at 2023-07-02T10:13:44-04:00 Add missing void prototypes to rts functions See #23561. - - - - - f06a5a69 by Ben Gamari at 2023-07-02T10:13:44-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - f6ff3ae0 by Ben Gamari at 2023-07-02T10:13:45-04:00 testsuite: Update documentation - - - - - 3c5bcb5b by Gregory Gerasev at 2023-07-02T10:13:50-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 3b6aa38e by Dave Barton at 2023-07-02T10:13:53-04:00 Fix some broken links and typos - - - - - c54a6ca1 by Ben Gamari at 2023-07-02T10:13:54-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a81070572b88e06bac16b1ffb76e20094eb604d8...c54a6ca13c71afad824951efe157fced4c6e74a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a81070572b88e06bac16b1ffb76e20094eb604d8...c54a6ca13c71afad824951efe157fced4c6e74a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:16:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:16:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a186af9cf79_2e0e5b475cc1672f7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: dd6b990c by Torsten Schmits at 2023-07-02T10:15:29-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 6104687f by Ben Gamari at 2023-07-02T10:15:30-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6b0e4746 by Ben Gamari at 2023-07-02T10:15:30-04:00 testsuite: Add test for #23400 - - - - - 87b57d32 by Ben Gamari at 2023-07-02T10:15:32-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 45dee314 by Ben Bellick at 2023-07-02T10:15:37-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 28ef43a8 by Moisés Ackerman at 2023-07-02T10:15:42-04:00 Add failing test case for #23492 - - - - - 70925249 by Moisés Ackerman at 2023-07-02T10:15:42-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - f5714f99 by Moisés Ackerman at 2023-07-02T10:15:43-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 6b423593 by Moisés Ackerman at 2023-07-02T10:15:43-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 26ec16b9 by Ryan Hendrickson at 2023-07-02T10:15:49-04:00 Add regression test for #23549 - - - - - 1297b68e by Alexis King at 2023-07-02T10:15:59-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 3c5b7cdb by Bryan Richter at 2023-07-02T10:16:00-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 0f772c63 by Ben Gamari at 2023-07-02T10:16:00-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 6b2caa55 by Ben Gamari at 2023-07-02T10:16:01-04:00 testsuite: Update documentation - - - - - 7f502b9d by Gregory Gerasev at 2023-07-02T10:16:05-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - cd18049f by Dave Barton at 2023-07-02T10:16:09-04:00 Fix some broken links and typos - - - - - 0f7a1c65 by Ben Gamari at 2023-07-02T10:16:10-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c54a6ca13c71afad824951efe157fced4c6e74a8...0f7a1c65501a128716c63b7d59505cf729deb140 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c54a6ca13c71afad824951efe157fced4c6e74a8...0f7a1c65501a128716c63b7d59505cf729deb140 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:18:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:18:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1873f25bfd_2e0e5b47504167413@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b8a780fd by Torsten Schmits at 2023-07-02T10:17:54-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 208abba4 by Ben Gamari at 2023-07-02T10:17:55-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 5727f4f4 by Ben Gamari at 2023-07-02T10:17:55-04:00 testsuite: Add test for #23400 - - - - - f88d245a by Ben Gamari at 2023-07-02T10:17:57-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 8fc808dc by Ben Bellick at 2023-07-02T10:18:01-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 466a1f52 by Moisés Ackerman at 2023-07-02T10:18:08-04:00 Add failing test case for #23492 - - - - - b60bb7f0 by Moisés Ackerman at 2023-07-02T10:18:08-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 520cf9cf by Moisés Ackerman at 2023-07-02T10:18:08-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 1e828689 by Moisés Ackerman at 2023-07-02T10:18:08-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - c8aeef29 by Ryan Hendrickson at 2023-07-02T10:18:14-04:00 Add regression test for #23549 - - - - - 9e0ea151 by Alexis King at 2023-07-02T10:18:24-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - b8ddb45b by Bryan Richter at 2023-07-02T10:18:24-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 42cfd624 by Ben Gamari at 2023-07-02T10:18:25-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 29a3de90 by Ben Gamari at 2023-07-02T10:18:25-04:00 testsuite: Update documentation - - - - - efb8ded5 by Gregory Gerasev at 2023-07-02T10:18:30-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 834baf8e by Dave Barton at 2023-07-02T10:18:33-04:00 Fix some broken links and typos - - - - - 3b45768f by Ben Gamari at 2023-07-02T10:18:34-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f7a1c65501a128716c63b7d59505cf729deb140...3b45768fe6d0e87ea2b06c2cefdf3a9fe8f41865 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f7a1c65501a128716c63b7d59505cf729deb140...3b45768fe6d0e87ea2b06c2cefdf3a9fe8f41865 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:20:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:20:53 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a187c5c4f2c_2e0e5b475041676ca@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 18195fed by Torsten Schmits at 2023-07-02T10:20:09-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 016b7c78 by Ben Gamari at 2023-07-02T10:20:10-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ff0ba852 by Ben Gamari at 2023-07-02T10:20:10-04:00 testsuite: Add test for #23400 - - - - - e6994586 by Ben Gamari at 2023-07-02T10:20:12-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 59c6581c by Ben Bellick at 2023-07-02T10:20:16-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 362283c5 by Moisés Ackerman at 2023-07-02T10:20:22-04:00 Add failing test case for #23492 - - - - - 553a2759 by Moisés Ackerman at 2023-07-02T10:20:22-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 43e50577 by Moisés Ackerman at 2023-07-02T10:20:22-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 2bb7a68d by Moisés Ackerman at 2023-07-02T10:20:22-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 8bd164d8 by Ryan Hendrickson at 2023-07-02T10:20:28-04:00 Add regression test for #23549 - - - - - 7d7c11bd by Alexis King at 2023-07-02T10:20:39-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 035046c7 by Bryan Richter at 2023-07-02T10:20:39-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 476782c9 by Ben Gamari at 2023-07-02T10:20:39-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 2e937f63 by Ben Gamari at 2023-07-02T10:20:40-04:00 testsuite: Update documentation - - - - - 3435c4b5 by Gregory Gerasev at 2023-07-02T10:20:44-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - d85b0895 by Dave Barton at 2023-07-02T10:20:48-04:00 Fix some broken links and typos - - - - - bccd40f3 by Ben Gamari at 2023-07-02T10:20:49-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3b45768fe6d0e87ea2b06c2cefdf3a9fe8f41865...bccd40f35b4e29a50b6e4fa2c66fab33ab206098 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3b45768fe6d0e87ea2b06c2cefdf3a9fe8f41865...bccd40f35b4e29a50b6e4fa2c66fab33ab206098 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:23:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:23:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a188505ba93_2e0e5b474f016784@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 253c93ba by Torsten Schmits at 2023-07-02T10:22:25-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 0d8d2f0d by Ben Gamari at 2023-07-02T10:22:27-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 3f20fdb1 by Ben Gamari at 2023-07-02T10:22:27-04:00 testsuite: Add test for #23400 - - - - - 3a11fb3a by Ben Gamari at 2023-07-02T10:22:28-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 10b6e986 by Ben Bellick at 2023-07-02T10:22:33-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 70794477 by Moisés Ackerman at 2023-07-02T10:22:39-04:00 Add failing test case for #23492 - - - - - 158695a9 by Moisés Ackerman at 2023-07-02T10:22:39-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 605f4632 by Moisés Ackerman at 2023-07-02T10:22:39-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 2c77f607 by Moisés Ackerman at 2023-07-02T10:22:39-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 064f7961 by Ryan Hendrickson at 2023-07-02T10:22:45-04:00 Add regression test for #23549 - - - - - 8b660a37 by Alexis King at 2023-07-02T10:22:56-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 19cd3d8f by Bryan Richter at 2023-07-02T10:22:56-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 9ffea5d6 by Ben Gamari at 2023-07-02T10:22:56-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a01e9a79 by Ben Gamari at 2023-07-02T10:22:57-04:00 testsuite: Update documentation - - - - - 818e5cb3 by Gregory Gerasev at 2023-07-02T10:23:01-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 2f91bb0f by Dave Barton at 2023-07-02T10:23:06-04:00 Fix some broken links and typos - - - - - 8837275c by Ben Gamari at 2023-07-02T10:23:07-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bccd40f35b4e29a50b6e4fa2c66fab33ab206098...8837275c57f3d9beef198cdb1d0028203210ca47 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bccd40f35b4e29a50b6e4fa2c66fab33ab206098...8837275c57f3d9beef198cdb1d0028203210ca47 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:25:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:25:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a188d7cd3bc_2e0e5b475f4168033@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8f663c9e by Torsten Schmits at 2023-07-02T10:24:42-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - cfa68449 by Ben Gamari at 2023-07-02T10:24:43-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - a8cdf8ca by Ben Gamari at 2023-07-02T10:24:43-04:00 testsuite: Add test for #23400 - - - - - c73c0671 by Ben Gamari at 2023-07-02T10:24:45-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a5e4ea29 by Ben Bellick at 2023-07-02T10:24:50-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - acf46076 by Moisés Ackerman at 2023-07-02T10:24:56-04:00 Add failing test case for #23492 - - - - - 4a6d73f4 by Moisés Ackerman at 2023-07-02T10:24:56-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 5367ac58 by Moisés Ackerman at 2023-07-02T10:24:56-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - a9e1c975 by Moisés Ackerman at 2023-07-02T10:24:56-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 7bed29cf by Ryan Hendrickson at 2023-07-02T10:25:02-04:00 Add regression test for #23549 - - - - - 7a5c45e0 by Alexis King at 2023-07-02T10:25:13-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 4ba29e46 by Bryan Richter at 2023-07-02T10:25:13-04:00 Add missing void prototypes to rts functions See #23561. - - - - - dd96ab19 by Ben Gamari at 2023-07-02T10:25:13-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 96ba1736 by Ben Gamari at 2023-07-02T10:25:14-04:00 testsuite: Update documentation - - - - - 213983c6 by Gregory Gerasev at 2023-07-02T10:25:18-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 8742ffc0 by Dave Barton at 2023-07-02T10:25:22-04:00 Fix some broken links and typos - - - - - d8cd1584 by Ben Gamari at 2023-07-02T10:25:23-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8837275c57f3d9beef198cdb1d0028203210ca47...d8cd1584aaf34b8f752fb4e8e2c1dfa2f4e74834 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8837275c57f3d9beef198cdb1d0028203210ca47...d8cd1584aaf34b8f752fb4e8e2c1dfa2f4e74834 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:27:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:27:40 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1895cb5bcf_2e0e5b475901682a9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1b668a27 by Torsten Schmits at 2023-07-02T10:26:56-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - dee32ab0 by Ben Gamari at 2023-07-02T10:26:58-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 262e7b05 by Ben Gamari at 2023-07-02T10:26:58-04:00 testsuite: Add test for #23400 - - - - - c1c47984 by Ben Gamari at 2023-07-02T10:26:59-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a608a6af by Ben Bellick at 2023-07-02T10:27:03-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 7289bb5d by Moisés Ackerman at 2023-07-02T10:27:09-04:00 Add failing test case for #23492 - - - - - ff3a369e by Moisés Ackerman at 2023-07-02T10:27:09-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 6f32aa31 by Moisés Ackerman at 2023-07-02T10:27:09-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - a7dc5e94 by Moisés Ackerman at 2023-07-02T10:27:09-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - beaf7a02 by Ryan Hendrickson at 2023-07-02T10:27:15-04:00 Add regression test for #23549 - - - - - 076e53a1 by Alexis King at 2023-07-02T10:27:26-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 5c1b4023 by Bryan Richter at 2023-07-02T10:27:26-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 4b902209 by Ben Gamari at 2023-07-02T10:27:27-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 7dbee375 by Ben Gamari at 2023-07-02T10:27:27-04:00 testsuite: Update documentation - - - - - d9cf5698 by Gregory Gerasev at 2023-07-02T10:27:32-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 9e81d3ed by Dave Barton at 2023-07-02T10:27:36-04:00 Fix some broken links and typos - - - - - ea161c2f by Ben Gamari at 2023-07-02T10:27:36-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8cd1584aaf34b8f752fb4e8e2c1dfa2f4e74834...ea161c2f6989d62d711783c7df24ad5c5afe016e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d8cd1584aaf34b8f752fb4e8e2c1dfa2f4e74834...ea161c2f6989d62d711783c7df24ad5c5afe016e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:29:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:29:56 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a189e48b71f_2e0e5b474f01684c4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b5d98168 by Torsten Schmits at 2023-07-02T10:29:12-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 79a048d0 by Ben Gamari at 2023-07-02T10:29:13-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6f0fe3e7 by Ben Gamari at 2023-07-02T10:29:13-04:00 testsuite: Add test for #23400 - - - - - e3f4ecba by Ben Gamari at 2023-07-02T10:29:15-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 665f4a3d by Ben Bellick at 2023-07-02T10:29:19-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 1716b4c2 by Moisés Ackerman at 2023-07-02T10:29:25-04:00 Add failing test case for #23492 - - - - - bb2da7bb by Moisés Ackerman at 2023-07-02T10:29:25-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - bf59fe98 by Moisés Ackerman at 2023-07-02T10:29:25-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 36d8eddb by Moisés Ackerman at 2023-07-02T10:29:25-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - ae0755fd by Ryan Hendrickson at 2023-07-02T10:29:31-04:00 Add regression test for #23549 - - - - - 70d4a9a7 by Alexis King at 2023-07-02T10:29:42-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - dbe55c1e by Bryan Richter at 2023-07-02T10:29:42-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 55e02b76 by Ben Gamari at 2023-07-02T10:29:43-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 0f04a70f by Ben Gamari at 2023-07-02T10:29:43-04:00 testsuite: Update documentation - - - - - 5a2ced02 by Gregory Gerasev at 2023-07-02T10:29:48-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 69decd42 by Dave Barton at 2023-07-02T10:29:51-04:00 Fix some broken links and typos - - - - - bf26946f by Ben Gamari at 2023-07-02T10:29:52-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea161c2f6989d62d711783c7df24ad5c5afe016e...bf26946f3041aaf965e77a96be346f59704b0793 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea161c2f6989d62d711783c7df24ad5c5afe016e...bf26946f3041aaf965e77a96be346f59704b0793 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:32:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:32:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18a71b3a34_2e0e5b474f016862a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 16382a95 by Torsten Schmits at 2023-07-02T10:31:33-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - dc956d5b by Ben Gamari at 2023-07-02T10:31:34-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 00ca9591 by Ben Gamari at 2023-07-02T10:31:34-04:00 testsuite: Add test for #23400 - - - - - bd752baa by Ben Gamari at 2023-07-02T10:31:36-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 45148a2f by Ben Bellick at 2023-07-02T10:31:41-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 994bb767 by Moisés Ackerman at 2023-07-02T10:31:46-04:00 Add failing test case for #23492 - - - - - 0ec1dc38 by Moisés Ackerman at 2023-07-02T10:31:46-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 8b4b35a1 by Moisés Ackerman at 2023-07-02T10:31:47-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 7eb6def8 by Moisés Ackerman at 2023-07-02T10:31:47-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 2b70a0f2 by Ryan Hendrickson at 2023-07-02T10:31:52-04:00 Add regression test for #23549 - - - - - c43371ad by Alexis King at 2023-07-02T10:32:03-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - d10e35d7 by Bryan Richter at 2023-07-02T10:32:03-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 027bc30c by Ben Gamari at 2023-07-02T10:32:04-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 56b09526 by Ben Gamari at 2023-07-02T10:32:04-04:00 testsuite: Update documentation - - - - - 243d7b52 by Gregory Gerasev at 2023-07-02T10:32:09-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 69024e73 by Dave Barton at 2023-07-02T10:32:12-04:00 Fix some broken links and typos - - - - - 587a7302 by Ben Gamari at 2023-07-02T10:32:13-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf26946f3041aaf965e77a96be346f59704b0793...587a73021d8a19145ffb55c5acd46d1f2c70312d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf26946f3041aaf965e77a96be346f59704b0793...587a73021d8a19145ffb55c5acd46d1f2c70312d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:34:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:34:32 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18af84871b_2e0e5b475cc168827@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7ced40aa by Torsten Schmits at 2023-07-02T10:33:48-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 6cb46e73 by Ben Gamari at 2023-07-02T10:33:49-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6febb594 by Ben Gamari at 2023-07-02T10:33:49-04:00 testsuite: Add test for #23400 - - - - - f96d30b1 by Ben Gamari at 2023-07-02T10:33:51-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 6640031a by Ben Bellick at 2023-07-02T10:33:55-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 31722a38 by Moisés Ackerman at 2023-07-02T10:34:01-04:00 Add failing test case for #23492 - - - - - 6d305860 by Moisés Ackerman at 2023-07-02T10:34:01-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 9bd89e59 by Moisés Ackerman at 2023-07-02T10:34:01-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 59b6409d by Moisés Ackerman at 2023-07-02T10:34:01-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - ce0246bc by Ryan Hendrickson at 2023-07-02T10:34:07-04:00 Add regression test for #23549 - - - - - 6f1a2334 by Alexis King at 2023-07-02T10:34:18-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - cb6cad46 by Bryan Richter at 2023-07-02T10:34:18-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 2e8e781b by Ben Gamari at 2023-07-02T10:34:18-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 6ee8add8 by Ben Gamari at 2023-07-02T10:34:19-04:00 testsuite: Update documentation - - - - - aa25485b by Gregory Gerasev at 2023-07-02T10:34:23-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - b9c9db37 by Dave Barton at 2023-07-02T10:34:27-04:00 Fix some broken links and typos - - - - - 7daf27c0 by Ben Gamari at 2023-07-02T10:34:28-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/587a73021d8a19145ffb55c5acd46d1f2c70312d...7daf27c0c77029e58e96a4f2b9b39f9487ae0fdd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/587a73021d8a19145ffb55c5acd46d1f2c70312d...7daf27c0c77029e58e96a4f2b9b39f9487ae0fdd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:36:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:36:48 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18b8026f31_2e0e5b475cc1690c1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2b3dc711 by Torsten Schmits at 2023-07-02T10:36:03-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 70a8951b by Ben Gamari at 2023-07-02T10:36:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 9b06ecb6 by Ben Gamari at 2023-07-02T10:36:04-04:00 testsuite: Add test for #23400 - - - - - a185d848 by Ben Gamari at 2023-07-02T10:36:06-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 6242fd32 by Ben Bellick at 2023-07-02T10:36:10-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - a995ede9 by Moisés Ackerman at 2023-07-02T10:36:16-04:00 Add failing test case for #23492 - - - - - eb7f0317 by Moisés Ackerman at 2023-07-02T10:36:16-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c1d8a655 by Moisés Ackerman at 2023-07-02T10:36:16-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - c799133e by Moisés Ackerman at 2023-07-02T10:36:16-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 346e5305 by Ryan Hendrickson at 2023-07-02T10:36:22-04:00 Add regression test for #23549 - - - - - 75fe74ce by Alexis King at 2023-07-02T10:36:33-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 4f3db23d by Bryan Richter at 2023-07-02T10:36:33-04:00 Add missing void prototypes to rts functions See #23561. - - - - - d542f892 by Ben Gamari at 2023-07-02T10:36:34-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - f0e54856 by Ben Gamari at 2023-07-02T10:36:34-04:00 testsuite: Update documentation - - - - - e21a57bd by Gregory Gerasev at 2023-07-02T10:36:39-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 78d37eb1 by Dave Barton at 2023-07-02T10:36:43-04:00 Fix some broken links and typos - - - - - 9b13a9ed by Ben Gamari at 2023-07-02T10:36:43-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7daf27c0c77029e58e96a4f2b9b39f9487ae0fdd...9b13a9ed350f00c678fa6ab60e0b1f5b45f6570f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7daf27c0c77029e58e96a4f2b9b39f9487ae0fdd...9b13a9ed350f00c678fa6ab60e0b1f5b45f6570f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:39:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:39:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18c0ea8307_2e0e5b475401692ee@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a3032f7e by Torsten Schmits at 2023-07-02T10:38:25-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 7c013258 by Ben Gamari at 2023-07-02T10:38:26-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 975d63be by Ben Gamari at 2023-07-02T10:38:26-04:00 testsuite: Add test for #23400 - - - - - 5408c1d2 by Ben Gamari at 2023-07-02T10:38:28-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 76996e5c by Ben Bellick at 2023-07-02T10:38:32-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - dae234b6 by Moisés Ackerman at 2023-07-02T10:38:38-04:00 Add failing test case for #23492 - - - - - 1dd1cfe1 by Moisés Ackerman at 2023-07-02T10:38:38-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 1f1dd395 by Moisés Ackerman at 2023-07-02T10:38:38-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - b63df877 by Moisés Ackerman at 2023-07-02T10:38:38-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 692da8c7 by Ryan Hendrickson at 2023-07-02T10:38:44-04:00 Add regression test for #23549 - - - - - 8125c498 by Alexis King at 2023-07-02T10:38:55-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 0302955b by Bryan Richter at 2023-07-02T10:38:55-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 491b5cc9 by Ben Gamari at 2023-07-02T10:38:56-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - f1ebc2a2 by Ben Gamari at 2023-07-02T10:38:56-04:00 testsuite: Update documentation - - - - - 9dbcb926 by Gregory Gerasev at 2023-07-02T10:39:01-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - d2fe1d01 by Dave Barton at 2023-07-02T10:39:05-04:00 Fix some broken links and typos - - - - - 0539c6cb by Ben Gamari at 2023-07-02T10:39:05-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b13a9ed350f00c678fa6ab60e0b1f5b45f6570f...0539c6cbbbaf193c61bec926c215dbf4ebb3986c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b13a9ed350f00c678fa6ab60e0b1f5b45f6570f...0539c6cbbbaf193c61bec926c215dbf4ebb3986c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:41:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:41:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18c96e95bf_2e0e5b4752c17142d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b5a61631 by Torsten Schmits at 2023-07-02T10:40:40-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - e20b189a by Ben Gamari at 2023-07-02T10:40:41-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - c7138895 by Ben Gamari at 2023-07-02T10:40:41-04:00 testsuite: Add test for #23400 - - - - - ffaf484a by Ben Gamari at 2023-07-02T10:40:43-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 133259a5 by Ben Bellick at 2023-07-02T10:40:47-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - da9918de by Moisés Ackerman at 2023-07-02T10:40:53-04:00 Add failing test case for #23492 - - - - - 7cb043e4 by Moisés Ackerman at 2023-07-02T10:40:53-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - d462dd7e by Moisés Ackerman at 2023-07-02T10:40:53-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 55fb735f by Moisés Ackerman at 2023-07-02T10:40:53-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - dc55f189 by Ryan Hendrickson at 2023-07-02T10:40:59-04:00 Add regression test for #23549 - - - - - 601bd7a5 by Alexis King at 2023-07-02T10:41:10-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 5cd4da8c by Bryan Richter at 2023-07-02T10:41:10-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 90f4863a by Ben Gamari at 2023-07-02T10:41:10-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - e25ae9ba by Ben Gamari at 2023-07-02T10:41:11-04:00 testsuite: Update documentation - - - - - a270cd20 by Gregory Gerasev at 2023-07-02T10:41:15-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 6350f8ef by Dave Barton at 2023-07-02T10:41:19-04:00 Fix some broken links and typos - - - - - d33b4e0c by Ben Gamari at 2023-07-02T10:41:20-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0539c6cbbbaf193c61bec926c215dbf4ebb3986c...d33b4e0ce0c401fdf4374cd6f78da209eec26de9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0539c6cbbbaf193c61bec926c215dbf4ebb3986c...d33b4e0ce0c401fdf4374cd6f78da209eec26de9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:43:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:43:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18d1d2bd75_2e0e5b475041716fb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a2871647 by Torsten Schmits at 2023-07-02T10:42:57-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d0376a6a by Ben Gamari at 2023-07-02T10:42:58-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - be31b3a6 by Ben Gamari at 2023-07-02T10:42:58-04:00 testsuite: Add test for #23400 - - - - - 8c57aa75 by Ben Gamari at 2023-07-02T10:43:00-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - dad1d3af by Ben Bellick at 2023-07-02T10:43:04-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 2084c46d by Moisés Ackerman at 2023-07-02T10:43:10-04:00 Add failing test case for #23492 - - - - - afb09438 by Moisés Ackerman at 2023-07-02T10:43:10-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 7b9ab414 by Moisés Ackerman at 2023-07-02T10:43:10-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 225e1724 by Moisés Ackerman at 2023-07-02T10:43:10-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 7fc6f4b8 by Ryan Hendrickson at 2023-07-02T10:43:16-04:00 Add regression test for #23549 - - - - - 6e9cd0d4 by Alexis King at 2023-07-02T10:43:26-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 973fcaeb by Bryan Richter at 2023-07-02T10:43:27-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 29ed9f04 by Ben Gamari at 2023-07-02T10:43:27-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 5a98115c by Ben Gamari at 2023-07-02T10:43:28-04:00 testsuite: Update documentation - - - - - 397f1ad0 by Gregory Gerasev at 2023-07-02T10:43:32-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 39b79a87 by Dave Barton at 2023-07-02T10:43:36-04:00 Fix some broken links and typos - - - - - 5693eb76 by Ben Gamari at 2023-07-02T10:43:36-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d33b4e0ce0c401fdf4374cd6f78da209eec26de9...5693eb76d200cbad0bd7ce22ec1abcfc16567119 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d33b4e0ce0c401fdf4374cd6f78da209eec26de9...5693eb76d200cbad0bd7ce22ec1abcfc16567119 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:46:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:46:03 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18dab1e44c_2e0e5b475b8171871@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6d1eae0e by Torsten Schmits at 2023-07-02T10:45:18-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 280bb1f4 by Ben Gamari at 2023-07-02T10:45:19-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 31d66b03 by Ben Gamari at 2023-07-02T10:45:19-04:00 testsuite: Add test for #23400 - - - - - ba907b3b by Ben Gamari at 2023-07-02T10:45:21-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 131e0679 by Ben Bellick at 2023-07-02T10:45:25-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 5ca3c8ed by Moisés Ackerman at 2023-07-02T10:45:31-04:00 Add failing test case for #23492 - - - - - f8652ba2 by Moisés Ackerman at 2023-07-02T10:45:31-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 51ef2ab9 by Moisés Ackerman at 2023-07-02T10:45:31-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 8fde154b by Moisés Ackerman at 2023-07-02T10:45:31-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 4a364e82 by Ryan Hendrickson at 2023-07-02T10:45:37-04:00 Add regression test for #23549 - - - - - d2c3ae5b by Alexis King at 2023-07-02T10:45:48-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 7d1defb1 by Bryan Richter at 2023-07-02T10:45:48-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 240c6b45 by Ben Gamari at 2023-07-02T10:45:48-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 557c0af4 by Ben Gamari at 2023-07-02T10:45:49-04:00 testsuite: Update documentation - - - - - 79bf6304 by Gregory Gerasev at 2023-07-02T10:45:53-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 3ed2287b by Dave Barton at 2023-07-02T10:45:57-04:00 Fix some broken links and typos - - - - - fecfd1aa by Ben Gamari at 2023-07-02T10:45:58-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5693eb76d200cbad0bd7ce22ec1abcfc16567119...fecfd1aa6f91501e11ce20d96a1ddfa8371e0d78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5693eb76d200cbad0bd7ce22ec1abcfc16567119...fecfd1aa6f91501e11ce20d96a1ddfa8371e0d78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:48:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:48:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18e3c3e65a_2e0e5b475b8173930@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6c2e98b3 by Torsten Schmits at 2023-07-02T10:47:40-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 0d9352c4 by Ben Gamari at 2023-07-02T10:47:41-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 92bffe9f by Ben Gamari at 2023-07-02T10:47:41-04:00 testsuite: Add test for #23400 - - - - - b968ffa0 by Ben Gamari at 2023-07-02T10:47:43-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - e662e1b7 by Ben Bellick at 2023-07-02T10:47:47-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - ce275259 by Moisés Ackerman at 2023-07-02T10:47:53-04:00 Add failing test case for #23492 - - - - - 332bd020 by Moisés Ackerman at 2023-07-02T10:47:53-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - d56dbf30 by Moisés Ackerman at 2023-07-02T10:47:53-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - e4d5833f by Moisés Ackerman at 2023-07-02T10:47:53-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - fefa2a7e by Ryan Hendrickson at 2023-07-02T10:47:59-04:00 Add regression test for #23549 - - - - - 277c9c42 by Alexis King at 2023-07-02T10:48:10-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 6dcb97ac by Bryan Richter at 2023-07-02T10:48:10-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 31dee93c by Ben Gamari at 2023-07-02T10:48:11-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d3b26317 by Ben Gamari at 2023-07-02T10:48:11-04:00 testsuite: Update documentation - - - - - 4b002b94 by Gregory Gerasev at 2023-07-02T10:48:16-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - f3a31908 by Dave Barton at 2023-07-02T10:48:20-04:00 Fix some broken links and typos - - - - - 8dc23c7b by Ben Gamari at 2023-07-02T10:48:20-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fecfd1aa6f91501e11ce20d96a1ddfa8371e0d78...8dc23c7b9babf6c466567c4414128028ccc3fabf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fecfd1aa6f91501e11ce20d96a1ddfa8371e0d78...8dc23c7b9babf6c466567c4414128028ccc3fabf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:50:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:50:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18ecbb4966_2e0e5b475181746ed@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6bd9782a by Torsten Schmits at 2023-07-02T10:50:04-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - a575351f by Ben Gamari at 2023-07-02T10:50:05-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - c4f597a5 by Ben Gamari at 2023-07-02T10:50:05-04:00 testsuite: Add test for #23400 - - - - - 947853ea by Ben Gamari at 2023-07-02T10:50:07-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 5c21c6e2 by Ben Bellick at 2023-07-02T10:50:12-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6f8ec7f3 by Moisés Ackerman at 2023-07-02T10:50:17-04:00 Add failing test case for #23492 - - - - - 6a676110 by Moisés Ackerman at 2023-07-02T10:50:17-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 9bc99bd1 by Moisés Ackerman at 2023-07-02T10:50:17-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 3b75ddb5 by Moisés Ackerman at 2023-07-02T10:50:18-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - d86def16 by Ryan Hendrickson at 2023-07-02T10:50:23-04:00 Add regression test for #23549 - - - - - 110fe231 by Alexis King at 2023-07-02T10:50:34-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 53b2f705 by Bryan Richter at 2023-07-02T10:50:34-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 16a88c1b by Ben Gamari at 2023-07-02T10:50:35-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d5ade866 by Ben Gamari at 2023-07-02T10:50:35-04:00 testsuite: Update documentation - - - - - 75e7ac8e by Gregory Gerasev at 2023-07-02T10:50:40-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - d68a9876 by Dave Barton at 2023-07-02T10:50:43-04:00 Fix some broken links and typos - - - - - ceae516f by Ben Gamari at 2023-07-02T10:50:44-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8dc23c7b9babf6c466567c4414128028ccc3fabf...ceae516f17462e2f011791f1b6d13dc3045e7ca8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8dc23c7b9babf6c466567c4414128028ccc3fabf...ceae516f17462e2f011791f1b6d13dc3045e7ca8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:50:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 02 Jul 2023 10:50:45 -0400 Subject: [Git][ghc/ghc][wip/ipe-section] 194 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <64a18ec587971_2e0e5b475cc1744fc@gitlab.mail> Ben Gamari pushed to branch wip/ipe-section at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - b6ecb0be by Ben Gamari at 2023-07-02T10:50:37-04:00 compiler: Place IPE information in separate section Previously IPE information would end up in the `.data` section. Not only does this make it difficult to measure the size of the IPE metadata, but by placing it in its own section we reduce the probability of the (generally rather large) IPE metadata inducing large displacements at link-time. Moreover, we can now in principle allow the data to be stripped post-build; we would merely need to sort out how to make the could - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ad00621110047da4b229aa9b9970341e18a7d11...b6ecb0be0258bda9bb3277410da74bd87417cd8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ad00621110047da4b229aa9b9970341e18a7d11...b6ecb0be0258bda9bb3277410da74bd87417cd8b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:53:06 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:53:06 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18f52a98ab_2e0e5b47504174865@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 504e2b27 by Torsten Schmits at 2023-07-02T10:52:22-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 7ae7bdb6 by Ben Gamari at 2023-07-02T10:52:23-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - fa3df5d1 by Ben Gamari at 2023-07-02T10:52:23-04:00 testsuite: Add test for #23400 - - - - - 7cf11d6c by Ben Gamari at 2023-07-02T10:52:25-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 4896511a by Ben Bellick at 2023-07-02T10:52:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 9bff3ccf by Moisés Ackerman at 2023-07-02T10:52:35-04:00 Add failing test case for #23492 - - - - - d0292286 by Moisés Ackerman at 2023-07-02T10:52:35-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 2ca624da by Moisés Ackerman at 2023-07-02T10:52:35-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 5d28d407 by Moisés Ackerman at 2023-07-02T10:52:35-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 79072b2c by Ryan Hendrickson at 2023-07-02T10:52:41-04:00 Add regression test for #23549 - - - - - 98c01658 by Alexis King at 2023-07-02T10:52:52-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 7c01bb43 by Bryan Richter at 2023-07-02T10:52:52-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6e3496b1 by Ben Gamari at 2023-07-02T10:52:53-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d897a077 by Ben Gamari at 2023-07-02T10:52:53-04:00 testsuite: Update documentation - - - - - 5da44501 by Gregory Gerasev at 2023-07-02T10:52:58-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 9f1fe89b by Dave Barton at 2023-07-02T10:53:02-04:00 Fix some broken links and typos - - - - - 4fe24aa5 by Ben Gamari at 2023-07-02T10:53:02-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ceae516f17462e2f011791f1b6d13dc3045e7ca8...4fe24aa50101f34d2385d6f68cfff8d8db84f0a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ceae516f17462e2f011791f1b6d13dc3045e7ca8...4fe24aa50101f34d2385d6f68cfff8d8db84f0a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:55:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:55:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a18fe020116_2e0e5b474f0175087@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3f914906 by Torsten Schmits at 2023-07-02T10:54:43-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 7019aef4 by Ben Gamari at 2023-07-02T10:54:44-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 872502da by Ben Gamari at 2023-07-02T10:54:44-04:00 testsuite: Add test for #23400 - - - - - 37b35939 by Ben Gamari at 2023-07-02T10:54:46-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - eee80edb by Ben Bellick at 2023-07-02T10:54:50-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 0f5fd52e by Moisés Ackerman at 2023-07-02T10:54:56-04:00 Add failing test case for #23492 - - - - - 4f1c1829 by Moisés Ackerman at 2023-07-02T10:54:56-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 644f4b04 by Moisés Ackerman at 2023-07-02T10:54:56-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 7fb3f3d8 by Moisés Ackerman at 2023-07-02T10:54:56-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 6db9a3c9 by Ryan Hendrickson at 2023-07-02T10:55:02-04:00 Add regression test for #23549 - - - - - fbe14aed by Alexis King at 2023-07-02T10:55:13-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 8525a80b by Bryan Richter at 2023-07-02T10:55:13-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 1d72babe by Ben Gamari at 2023-07-02T10:55:14-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - bbbbfd32 by Ben Gamari at 2023-07-02T10:55:14-04:00 testsuite: Update documentation - - - - - b6cb746f by Gregory Gerasev at 2023-07-02T10:55:19-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 6a7ff263 by Dave Barton at 2023-07-02T10:55:23-04:00 Fix some broken links and typos - - - - - 8498cef0 by Ben Gamari at 2023-07-02T10:55:23-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fe24aa50101f34d2385d6f68cfff8d8db84f0a2...8498cef033ae9d7fb43cc152d80d2e67ba085029 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fe24aa50101f34d2385d6f68cfff8d8db84f0a2...8498cef033ae9d7fb43cc152d80d2e67ba085029 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 14:57:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 10:57:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19075218bc_2e0e5b475e017522e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b17c7cf1 by Torsten Schmits at 2023-07-02T10:57:09-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d4759d69 by Ben Gamari at 2023-07-02T10:57:10-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - b1a76830 by Ben Gamari at 2023-07-02T10:57:10-04:00 testsuite: Add test for #23400 - - - - - ba9d02ef by Ben Gamari at 2023-07-02T10:57:12-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 5684bd4d by Ben Bellick at 2023-07-02T10:57:17-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 244c518e by Moisés Ackerman at 2023-07-02T10:57:22-04:00 Add failing test case for #23492 - - - - - 4f228f32 by Moisés Ackerman at 2023-07-02T10:57:22-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - be4410af by Moisés Ackerman at 2023-07-02T10:57:22-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 7add8846 by Moisés Ackerman at 2023-07-02T10:57:22-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 00d58a14 by Ryan Hendrickson at 2023-07-02T10:57:28-04:00 Add regression test for #23549 - - - - - 24cf89e9 by Alexis King at 2023-07-02T10:57:38-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - e304afe4 by Bryan Richter at 2023-07-02T10:57:39-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 04975844 by Ben Gamari at 2023-07-02T10:57:39-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 115ce6e2 by Ben Gamari at 2023-07-02T10:57:40-04:00 testsuite: Update documentation - - - - - 512e413b by Gregory Gerasev at 2023-07-02T10:57:44-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - b7a13213 by Dave Barton at 2023-07-02T10:57:48-04:00 Fix some broken links and typos - - - - - 7901b6fa by Ben Gamari at 2023-07-02T10:57:49-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8498cef033ae9d7fb43cc152d80d2e67ba085029...7901b6fab763ecd7c5e2b9778aa0696050f73d19 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8498cef033ae9d7fb43cc152d80d2e67ba085029...7901b6fab763ecd7c5e2b9778aa0696050f73d19 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:00:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:00:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1912ac0c03_2e0e5b475f41861d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1aa09f01 by Torsten Schmits at 2023-07-02T10:59:23-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 52e078d2 by Ben Gamari at 2023-07-02T10:59:24-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 0b6d2b9c by Ben Gamari at 2023-07-02T10:59:24-04:00 testsuite: Add test for #23400 - - - - - 242658c0 by Ben Gamari at 2023-07-02T10:59:26-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a181db06 by Ben Bellick at 2023-07-02T10:59:30-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 7694b7db by Moisés Ackerman at 2023-07-02T10:59:36-04:00 Add failing test case for #23492 - - - - - 1d08b7b2 by Moisés Ackerman at 2023-07-02T10:59:36-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 26af0928 by Moisés Ackerman at 2023-07-02T10:59:36-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 5e54efaf by Moisés Ackerman at 2023-07-02T10:59:36-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 97998512 by Ryan Hendrickson at 2023-07-02T10:59:42-04:00 Add regression test for #23549 - - - - - 664d7f45 by Alexis King at 2023-07-02T10:59:53-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 0cbffb2c by Bryan Richter at 2023-07-02T10:59:53-04:00 Add missing void prototypes to rts functions See #23561. - - - - - f5ec14b7 by Ben Gamari at 2023-07-02T10:59:53-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 59d73f10 by Ben Gamari at 2023-07-02T10:59:54-04:00 testsuite: Update documentation - - - - - 9a09aeea by Gregory Gerasev at 2023-07-02T10:59:58-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - f03fffd5 by Dave Barton at 2023-07-02T11:00:03-04:00 Fix some broken links and typos - - - - - 72940223 by Ben Gamari at 2023-07-02T11:00:03-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7901b6fab763ecd7c5e2b9778aa0696050f73d19...7294022350962e76a2bb379e3a5dc12af376e246 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7901b6fab763ecd7c5e2b9778aa0696050f73d19...7294022350962e76a2bb379e3a5dc12af376e246 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:02:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:02:32 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19188c441c_2e0e5b475e01877c9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cbef2f5a by Torsten Schmits at 2023-07-02T11:01:46-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 6896fbb6 by Ben Gamari at 2023-07-02T11:01:47-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 15f0acb7 by Ben Gamari at 2023-07-02T11:01:47-04:00 testsuite: Add test for #23400 - - - - - b6cb9b98 by Ben Gamari at 2023-07-02T11:01:49-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - de2a3d35 by Ben Bellick at 2023-07-02T11:01:53-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 36c41413 by Moisés Ackerman at 2023-07-02T11:01:59-04:00 Add failing test case for #23492 - - - - - f2e184ee by Moisés Ackerman at 2023-07-02T11:01:59-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - da1f00cd by Moisés Ackerman at 2023-07-02T11:01:59-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 9669782a by Moisés Ackerman at 2023-07-02T11:01:59-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 2d0776b2 by Ryan Hendrickson at 2023-07-02T11:02:05-04:00 Add regression test for #23549 - - - - - 2d95b218 by Alexis King at 2023-07-02T11:02:16-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 33690f8a by Bryan Richter at 2023-07-02T11:02:16-04:00 Add missing void prototypes to rts functions See #23561. - - - - - d7e38d20 by Ben Gamari at 2023-07-02T11:02:16-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 5c5a3a89 by Ben Gamari at 2023-07-02T11:02:17-04:00 testsuite: Update documentation - - - - - c9a6de24 by Gregory Gerasev at 2023-07-02T11:02:21-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - fb91719d by Dave Barton at 2023-07-02T11:02:25-04:00 Fix some broken links and typos - - - - - 71b4f31b by Ben Gamari at 2023-07-02T11:02:26-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7294022350962e76a2bb379e3a5dc12af376e246...71b4f31bcf39bc61a443fe16e3483adb49122ae0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7294022350962e76a2bb379e3a5dc12af376e246...71b4f31bcf39bc61a443fe16e3483adb49122ae0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:04:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:04:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a192135b2e4_2e0e5b475401999f8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5b256422 by Torsten Schmits at 2023-07-02T11:04:05-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 835cb65b by Ben Gamari at 2023-07-02T11:04:06-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - c0ab36c7 by Ben Gamari at 2023-07-02T11:04:06-04:00 testsuite: Add test for #23400 - - - - - e239b43a by Ben Gamari at 2023-07-02T11:04:08-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a1c243e4 by Ben Bellick at 2023-07-02T11:04:13-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 04544480 by Moisés Ackerman at 2023-07-02T11:04:18-04:00 Add failing test case for #23492 - - - - - bad50a69 by Moisés Ackerman at 2023-07-02T11:04:18-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - d728db07 by Moisés Ackerman at 2023-07-02T11:04:18-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 47b39aa5 by Moisés Ackerman at 2023-07-02T11:04:18-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 7fc1cf79 by Ryan Hendrickson at 2023-07-02T11:04:24-04:00 Add regression test for #23549 - - - - - 590b1d98 by Alexis King at 2023-07-02T11:04:35-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - f96b64dd by Bryan Richter at 2023-07-02T11:04:35-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 1a940e0d by Ben Gamari at 2023-07-02T11:04:36-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - f40608ef by Ben Gamari at 2023-07-02T11:04:36-04:00 testsuite: Update documentation - - - - - b7e4b4b9 by Gregory Gerasev at 2023-07-02T11:04:41-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 213bbc07 by Dave Barton at 2023-07-02T11:04:45-04:00 Fix some broken links and typos - - - - - 24c201d4 by Ben Gamari at 2023-07-02T11:04:45-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71b4f31bcf39bc61a443fe16e3483adb49122ae0...24c201d4c815685ad701bccc5163d60600ca4288 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71b4f31bcf39bc61a443fe16e3483adb49122ae0...24c201d4c815685ad701bccc5163d60600ca4288 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:08:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:08:01 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a192d15bbad_2e0e5b475b82228c6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 64e9498e by Torsten Schmits at 2023-07-02T11:06:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 70db0164 by Ben Gamari at 2023-07-02T11:06:29-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 41f38c76 by Ben Gamari at 2023-07-02T11:06:29-04:00 testsuite: Add test for #23400 - - - - - 48278755 by Ben Gamari at 2023-07-02T11:06:30-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 35ef3927 by Ben Bellick at 2023-07-02T11:06:35-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 070bafa9 by Moisés Ackerman at 2023-07-02T11:06:40-04:00 Add failing test case for #23492 - - - - - fd4d2529 by Moisés Ackerman at 2023-07-02T11:06:40-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - bfd10dcb by Moisés Ackerman at 2023-07-02T11:06:41-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 2e493db8 by Moisés Ackerman at 2023-07-02T11:06:41-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 51240f74 by Ryan Hendrickson at 2023-07-02T11:06:47-04:00 Add regression test for #23549 - - - - - 5ee91f61 by Alexis King at 2023-07-02T11:06:57-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - b354f6dd by Bryan Richter at 2023-07-02T11:06:58-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 066acb49 by Ben Gamari at 2023-07-02T11:06:58-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d200e563 by Ben Gamari at 2023-07-02T11:06:59-04:00 testsuite: Update documentation - - - - - 5e52583a by Gregory Gerasev at 2023-07-02T11:07:03-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - e9f19c30 by Dave Barton at 2023-07-02T11:07:07-04:00 Fix some broken links and typos - - - - - f90ceb1e by Ben Gamari at 2023-07-02T11:07:07-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24c201d4c815685ad701bccc5163d60600ca4288...f90ceb1e0a0aebaa36d3d230baa572d13f1db991 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24c201d4c815685ad701bccc5163d60600ca4288...f90ceb1e0a0aebaa36d3d230baa572d13f1db991 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:09:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:09:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a193331b2ed_2e0e5b475182244e5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3b270791 by Torsten Schmits at 2023-07-02T11:08:52-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 2e8a254c by Ben Gamari at 2023-07-02T11:08:53-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 68f69349 by Ben Gamari at 2023-07-02T11:08:53-04:00 testsuite: Add test for #23400 - - - - - d7996528 by Ben Gamari at 2023-07-02T11:08:55-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 02e7ccd8 by Ben Bellick at 2023-07-02T11:09:00-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 92ccb992 by Moisés Ackerman at 2023-07-02T11:09:05-04:00 Add failing test case for #23492 - - - - - ad8563ed by Moisés Ackerman at 2023-07-02T11:09:05-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 4c859bd3 by Moisés Ackerman at 2023-07-02T11:09:05-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - c20fb52d by Moisés Ackerman at 2023-07-02T11:09:05-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 081e4e87 by Ryan Hendrickson at 2023-07-02T11:09:11-04:00 Add regression test for #23549 - - - - - 67c23dc6 by Alexis King at 2023-07-02T11:09:22-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - bcfee664 by Bryan Richter at 2023-07-02T11:09:23-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 4914cc58 by Ben Gamari at 2023-07-02T11:09:23-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 46036182 by Ben Gamari at 2023-07-02T11:09:24-04:00 testsuite: Update documentation - - - - - da4ad178 by Gregory Gerasev at 2023-07-02T11:09:28-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - cfe2d961 by Dave Barton at 2023-07-02T11:09:32-04:00 Fix some broken links and typos - - - - - 18895b44 by Ben Gamari at 2023-07-02T11:09:32-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f90ceb1e0a0aebaa36d3d230baa572d13f1db991...18895b44a424de4df5fdd046ab1d3897ac61e75f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f90ceb1e0a0aebaa36d3d230baa572d13f1db991...18895b44a424de4df5fdd046ab1d3897ac61e75f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:12:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:12:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a193da800fc_2e0e5b475182366e8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c58f7be8 by Torsten Schmits at 2023-07-02T11:11:41-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - ecdb541d by Ben Gamari at 2023-07-02T11:11:42-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6bbdcaed by Ben Gamari at 2023-07-02T11:11:42-04:00 testsuite: Add test for #23400 - - - - - 64da7094 by Ben Gamari at 2023-07-02T11:11:44-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 05b28626 by Ben Bellick at 2023-07-02T11:11:48-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 365e8128 by Moisés Ackerman at 2023-07-02T11:11:54-04:00 Add failing test case for #23492 - - - - - 77fb50a6 by Moisés Ackerman at 2023-07-02T11:11:54-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 6ca86b13 by Moisés Ackerman at 2023-07-02T11:11:54-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 50ac2fa9 by Moisés Ackerman at 2023-07-02T11:11:55-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 5f872698 by Ryan Hendrickson at 2023-07-02T11:12:01-04:00 Add regression test for #23549 - - - - - ba0ab6b6 by Alexis King at 2023-07-02T11:12:12-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - afd2ab0b by Bryan Richter at 2023-07-02T11:12:12-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 9e35f60b by Ben Gamari at 2023-07-02T11:12:12-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 4d5d4fc3 by Ben Gamari at 2023-07-02T11:12:13-04:00 testsuite: Update documentation - - - - - 3bf7963c by Gregory Gerasev at 2023-07-02T11:12:17-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - aa31ef66 by Dave Barton at 2023-07-02T11:12:21-04:00 Fix some broken links and typos - - - - - 181b1844 by Ben Gamari at 2023-07-02T11:12:22-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18895b44a424de4df5fdd046ab1d3897ac61e75f...181b1844c93e82a64dde2c300c2937da460b88d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18895b44a424de4df5fdd046ab1d3897ac61e75f...181b1844c93e82a64dde2c300c2937da460b88d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:15:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:15:03 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19477dc283_2e0e5b47590236895@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f76d0b0a by Torsten Schmits at 2023-07-02T11:14:17-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 57c80740 by Ben Gamari at 2023-07-02T11:14:18-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 2c31ec42 by Ben Gamari at 2023-07-02T11:14:18-04:00 testsuite: Add test for #23400 - - - - - 048204e8 by Ben Gamari at 2023-07-02T11:14:20-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 64a9fc21 by Ben Bellick at 2023-07-02T11:14:25-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 971dd3b0 by Moisés Ackerman at 2023-07-02T11:14:31-04:00 Add failing test case for #23492 - - - - - c6233897 by Moisés Ackerman at 2023-07-02T11:14:31-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 0949d030 by Moisés Ackerman at 2023-07-02T11:14:31-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 99a3ee61 by Moisés Ackerman at 2023-07-02T11:14:31-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 701a86e9 by Ryan Hendrickson at 2023-07-02T11:14:37-04:00 Add regression test for #23549 - - - - - 89480196 by Alexis King at 2023-07-02T11:14:48-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 10e0f377 by Bryan Richter at 2023-07-02T11:14:49-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 64188624 by Ben Gamari at 2023-07-02T11:14:49-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a7a2abf2 by Ben Gamari at 2023-07-02T11:14:50-04:00 testsuite: Update documentation - - - - - 3c13e994 by Gregory Gerasev at 2023-07-02T11:14:55-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - b33ff148 by Dave Barton at 2023-07-02T11:14:59-04:00 Fix some broken links and typos - - - - - 954f792f by Ben Gamari at 2023-07-02T11:14:59-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/181b1844c93e82a64dde2c300c2937da460b88d6...954f792fe2b37a095a740f21b561dea1639d165c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/181b1844c93e82a64dde2c300c2937da460b88d6...954f792fe2b37a095a740f21b561dea1639d165c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:17:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:17:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1950bacc7a_2e0e5b47540237014@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 76c13b54 by Torsten Schmits at 2023-07-02T11:16:45-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 9cb8b577 by Ben Gamari at 2023-07-02T11:16:46-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - fae365d8 by Ben Gamari at 2023-07-02T11:16:46-04:00 testsuite: Add test for #23400 - - - - - 222ed2cd by Ben Gamari at 2023-07-02T11:16:48-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 0ddc8afe by Ben Bellick at 2023-07-02T11:16:52-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 5f06030f by Moisés Ackerman at 2023-07-02T11:16:58-04:00 Add failing test case for #23492 - - - - - b11a5804 by Moisés Ackerman at 2023-07-02T11:16:58-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c5f639b7 by Moisés Ackerman at 2023-07-02T11:16:58-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - d33f30db by Moisés Ackerman at 2023-07-02T11:16:58-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 82e00746 by Ryan Hendrickson at 2023-07-02T11:17:05-04:00 Add regression test for #23549 - - - - - 3ae3785f by Alexis King at 2023-07-02T11:17:16-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - f5cf627b by Bryan Richter at 2023-07-02T11:17:17-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 4d035c1c by Ben Gamari at 2023-07-02T11:17:17-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - dd49f2c4 by Ben Gamari at 2023-07-02T11:17:18-04:00 testsuite: Update documentation - - - - - 9a3145ec by Gregory Gerasev at 2023-07-02T11:17:22-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 7d693384 by Dave Barton at 2023-07-02T11:17:26-04:00 Fix some broken links and typos - - - - - e4dbfa09 by Ben Gamari at 2023-07-02T11:17:27-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/954f792fe2b37a095a740f21b561dea1639d165c...e4dbfa0977cd1e3aee9f097e5e1a6c29c755d8e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/954f792fe2b37a095a740f21b561dea1639d165c...e4dbfa0977cd1e3aee9f097e5e1a6c29c755d8e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:19:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:19:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1959b7124d_2e0e5b475cc2372c1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 771fe1ba by Torsten Schmits at 2023-07-02T11:19:09-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 921ee408 by Ben Gamari at 2023-07-02T11:19:10-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 3ff45d3f by Ben Gamari at 2023-07-02T11:19:10-04:00 testsuite: Add test for #23400 - - - - - ebd9a13a by Ben Gamari at 2023-07-02T11:19:12-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - ecd93914 by Ben Bellick at 2023-07-02T11:19:17-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6b3b444d by Moisés Ackerman at 2023-07-02T11:19:22-04:00 Add failing test case for #23492 - - - - - 4fa50400 by Moisés Ackerman at 2023-07-02T11:19:22-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - a944e222 by Moisés Ackerman at 2023-07-02T11:19:23-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 5a833eef by Moisés Ackerman at 2023-07-02T11:19:23-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - d6b20d4b by Ryan Hendrickson at 2023-07-02T11:19:29-04:00 Add regression test for #23549 - - - - - 6a2af56e by Alexis King at 2023-07-02T11:19:40-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 1bff1f24 by Bryan Richter at 2023-07-02T11:19:41-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 34f6e6be by Ben Gamari at 2023-07-02T11:19:41-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a59f7002 by Ben Gamari at 2023-07-02T11:19:42-04:00 testsuite: Update documentation - - - - - 829651f1 by Gregory Gerasev at 2023-07-02T11:19:46-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 537a6af0 by Dave Barton at 2023-07-02T11:19:50-04:00 Fix some broken links and typos - - - - - 944271b2 by Ben Gamari at 2023-07-02T11:19:50-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4dbfa0977cd1e3aee9f097e5e1a6c29c755d8e0...944271b2bf5d3b8c6dfeca7f911862f00d48a600 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4dbfa0977cd1e3aee9f097e5e1a6c29c755d8e0...944271b2bf5d3b8c6dfeca7f911862f00d48a600 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:22:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:22:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a196228b481_2e0e5b475cc2394df@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 250de0b5 by Torsten Schmits at 2023-07-02T11:21:26-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 1e9fdb16 by Ben Gamari at 2023-07-02T11:21:27-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ed4a4753 by Ben Gamari at 2023-07-02T11:21:27-04:00 testsuite: Add test for #23400 - - - - - 894477d6 by Ben Gamari at 2023-07-02T11:21:29-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 315d5899 by Ben Bellick at 2023-07-02T11:21:34-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 5b951842 by Moisés Ackerman at 2023-07-02T11:21:39-04:00 Add failing test case for #23492 - - - - - 6772b06b by Moisés Ackerman at 2023-07-02T11:21:39-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - d2008be4 by Moisés Ackerman at 2023-07-02T11:21:39-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 91b55670 by Moisés Ackerman at 2023-07-02T11:21:39-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 98246878 by Ryan Hendrickson at 2023-07-02T11:21:45-04:00 Add regression test for #23549 - - - - - 756c4cb3 by Alexis King at 2023-07-02T11:21:56-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 11c53eb2 by Bryan Richter at 2023-07-02T11:21:56-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 5cae5c8d by Ben Gamari at 2023-07-02T11:21:57-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 1b97d754 by Ben Gamari at 2023-07-02T11:21:57-04:00 testsuite: Update documentation - - - - - 3930e0d1 by Gregory Gerasev at 2023-07-02T11:22:02-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - b0bf9402 by Dave Barton at 2023-07-02T11:22:06-04:00 Fix some broken links and typos - - - - - 2d8bb524 by Ben Gamari at 2023-07-02T11:22:06-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/944271b2bf5d3b8c6dfeca7f911862f00d48a600...2d8bb524b2126a336223871d29993353364a0b69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/944271b2bf5d3b8c6dfeca7f911862f00d48a600...2d8bb524b2126a336223871d29993353364a0b69 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:24:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:24:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a196ad21b8c_2e0e5b475b823961f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d95f002f by Torsten Schmits at 2023-07-02T11:23:44-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 72f991d4 by Ben Gamari at 2023-07-02T11:23:45-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 911a6319 by Ben Gamari at 2023-07-02T11:23:45-04:00 testsuite: Add test for #23400 - - - - - c375427e by Ben Gamari at 2023-07-02T11:23:47-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 229ff4f9 by Ben Bellick at 2023-07-02T11:23:52-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 33d9aec4 by Moisés Ackerman at 2023-07-02T11:23:57-04:00 Add failing test case for #23492 - - - - - 94d6d42e by Moisés Ackerman at 2023-07-02T11:23:57-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 9cda72a2 by Moisés Ackerman at 2023-07-02T11:23:57-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - a40ff73f by Moisés Ackerman at 2023-07-02T11:23:57-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 95748721 by Ryan Hendrickson at 2023-07-02T11:24:03-04:00 Add regression test for #23549 - - - - - 31064fda by Alexis King at 2023-07-02T11:24:14-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 73fdf58a by Bryan Richter at 2023-07-02T11:24:14-04:00 Add missing void prototypes to rts functions See #23561. - - - - - e0d24570 by Ben Gamari at 2023-07-02T11:24:15-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a3d1285d by Ben Gamari at 2023-07-02T11:24:15-04:00 testsuite: Update documentation - - - - - 7c3747b7 by Gregory Gerasev at 2023-07-02T11:24:20-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - d9c07f49 by Dave Barton at 2023-07-02T11:24:24-04:00 Fix some broken links and typos - - - - - c37163c1 by Ben Gamari at 2023-07-02T11:24:24-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d8bb524b2126a336223871d29993353364a0b69...c37163c14f4d73452c6f70202641c7bdd121a06f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d8bb524b2126a336223871d29993353364a0b69...c37163c14f4d73452c6f70202641c7bdd121a06f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:26:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:26:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a197413131b_2e0e5b475f423985d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d79b6746 by Torsten Schmits at 2023-07-02T11:26:12-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - a188841f by Ben Gamari at 2023-07-02T11:26:13-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - c854bcd1 by Ben Gamari at 2023-07-02T11:26:13-04:00 testsuite: Add test for #23400 - - - - - c78163e7 by Ben Gamari at 2023-07-02T11:26:15-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 6fba21bc by Ben Bellick at 2023-07-02T11:26:19-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 4abf520b by Moisés Ackerman at 2023-07-02T11:26:25-04:00 Add failing test case for #23492 - - - - - 961805ed by Moisés Ackerman at 2023-07-02T11:26:25-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - efa1bd0f by Moisés Ackerman at 2023-07-02T11:26:25-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 3d103a09 by Moisés Ackerman at 2023-07-02T11:26:25-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 28ed950b by Ryan Hendrickson at 2023-07-02T11:26:31-04:00 Add regression test for #23549 - - - - - 9197697d by Alexis King at 2023-07-02T11:26:42-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 109fcab0 by Bryan Richter at 2023-07-02T11:26:43-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 3db972c0 by Ben Gamari at 2023-07-02T11:26:43-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a98a2971 by Ben Gamari at 2023-07-02T11:26:44-04:00 testsuite: Update documentation - - - - - c4386ba6 by Gregory Gerasev at 2023-07-02T11:26:48-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - da5e810c by Dave Barton at 2023-07-02T11:26:52-04:00 Fix some broken links and typos - - - - - 68671f15 by Ben Gamari at 2023-07-02T11:26:52-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c37163c14f4d73452c6f70202641c7bdd121a06f...68671f1514b0ebd003ca337f1b264c6c2662f40b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c37163c14f4d73452c6f70202641c7bdd121a06f...68671f1514b0ebd003ca337f1b264c6c2662f40b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:29:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:29:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a197ce3af03_2e0e5b47540242078@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 51cf29d3 by Torsten Schmits at 2023-07-02T11:28:33-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 2ea7bfe5 by Ben Gamari at 2023-07-02T11:28:34-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6b1c07f5 by Ben Gamari at 2023-07-02T11:28:34-04:00 testsuite: Add test for #23400 - - - - - 34a218ff by Ben Gamari at 2023-07-02T11:28:36-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 14c7ed73 by Ben Bellick at 2023-07-02T11:28:40-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - c86d4cdf by Moisés Ackerman at 2023-07-02T11:28:46-04:00 Add failing test case for #23492 - - - - - b22a1422 by Moisés Ackerman at 2023-07-02T11:28:46-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - cb6f21c2 by Moisés Ackerman at 2023-07-02T11:28:46-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - d12e7923 by Moisés Ackerman at 2023-07-02T11:28:46-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - f219af77 by Ryan Hendrickson at 2023-07-02T11:28:52-04:00 Add regression test for #23549 - - - - - e1332b91 by Alexis King at 2023-07-02T11:29:03-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 2c34fc2a by Bryan Richter at 2023-07-02T11:29:04-04:00 Add missing void prototypes to rts functions See #23561. - - - - - e7cc542a by Ben Gamari at 2023-07-02T11:29:04-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 1ca98386 by Ben Gamari at 2023-07-02T11:29:05-04:00 testsuite: Update documentation - - - - - cd11e13f by Gregory Gerasev at 2023-07-02T11:29:09-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 98c2b0fe by Dave Barton at 2023-07-02T11:29:13-04:00 Fix some broken links and typos - - - - - 0294d03a by Ben Gamari at 2023-07-02T11:29:13-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68671f1514b0ebd003ca337f1b264c6c2662f40b...0294d03a27a75adfcacc07090bbe69f9b8855878 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68671f1514b0ebd003ca337f1b264c6c2662f40b...0294d03a27a75adfcacc07090bbe69f9b8855878 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:31:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:31:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19862ed35b_2e0e5b474f0242269@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9ec8ea99 by Torsten Schmits at 2023-07-02T11:31:02-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - aeb97704 by Ben Gamari at 2023-07-02T11:31:03-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 1ff7f20d by Ben Gamari at 2023-07-02T11:31:03-04:00 testsuite: Add test for #23400 - - - - - 7630ad5b by Ben Gamari at 2023-07-02T11:31:05-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 813a5365 by Ben Bellick at 2023-07-02T11:31:10-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - e6654061 by Moisés Ackerman at 2023-07-02T11:31:15-04:00 Add failing test case for #23492 - - - - - 6e799a72 by Moisés Ackerman at 2023-07-02T11:31:15-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - ffe2127a by Moisés Ackerman at 2023-07-02T11:31:15-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - f916b8ed by Moisés Ackerman at 2023-07-02T11:31:15-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - a1d102a0 by Ryan Hendrickson at 2023-07-02T11:31:21-04:00 Add regression test for #23549 - - - - - 8f39e4c0 by Alexis King at 2023-07-02T11:31:32-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 4736d356 by Bryan Richter at 2023-07-02T11:31:33-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 3d68db6a by Ben Gamari at 2023-07-02T11:31:33-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - a664a058 by Ben Gamari at 2023-07-02T11:31:33-04:00 testsuite: Update documentation - - - - - e17df267 by Gregory Gerasev at 2023-07-02T11:31:38-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 402b6e4e by Dave Barton at 2023-07-02T11:31:42-04:00 Fix some broken links and typos - - - - - 017caf7f by Ben Gamari at 2023-07-02T11:31:42-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0294d03a27a75adfcacc07090bbe69f9b8855878...017caf7f5de1efb84838345ca33fbe4825858923 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0294d03a27a75adfcacc07090bbe69f9b8855878...017caf7f5de1efb84838345ca33fbe4825858923 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:34:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:34:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a198ef7f693_2e0e5b475f424261@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c4de8a58 by Torsten Schmits at 2023-07-02T11:33:22-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - bd3dd6c2 by Ben Gamari at 2023-07-02T11:33:23-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ff97e42a by Ben Gamari at 2023-07-02T11:33:23-04:00 testsuite: Add test for #23400 - - - - - 312b5374 by Ben Gamari at 2023-07-02T11:33:25-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - d4a95100 by Ben Bellick at 2023-07-02T11:33:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 177277af by Moisés Ackerman at 2023-07-02T11:33:35-04:00 Add failing test case for #23492 - - - - - 7d3f82ec by Moisés Ackerman at 2023-07-02T11:33:35-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 48a38d82 by Moisés Ackerman at 2023-07-02T11:33:35-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 16f40628 by Moisés Ackerman at 2023-07-02T11:33:35-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - f87889c8 by Ryan Hendrickson at 2023-07-02T11:33:41-04:00 Add regression test for #23549 - - - - - 3f6deae4 by Alexis King at 2023-07-02T11:33:52-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 9869651a by Bryan Richter at 2023-07-02T11:33:52-04:00 Add missing void prototypes to rts functions See #23561. - - - - - ef948366 by Ben Gamari at 2023-07-02T11:33:53-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 5d4c0d34 by Ben Gamari at 2023-07-02T11:33:53-04:00 testsuite: Update documentation - - - - - f3b0caac by Gregory Gerasev at 2023-07-02T11:33:58-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 394064fc by Dave Barton at 2023-07-02T11:34:02-04:00 Fix some broken links and typos - - - - - 38c6ed98 by Ben Gamari at 2023-07-02T11:34:02-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/017caf7f5de1efb84838345ca33fbe4825858923...38c6ed98c2fe22b8e8dd37648d218741f5f1b1d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/017caf7f5de1efb84838345ca33fbe4825858923...38c6ed98c2fe22b8e8dd37648d218741f5f1b1d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:37:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:37:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a199a6b1df3_2e0e5b4752c243091@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: aceaa72a by Torsten Schmits at 2023-07-02T11:36:19-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - ccc1170e by Ben Gamari at 2023-07-02T11:36:20-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 371d7bb8 by Ben Gamari at 2023-07-02T11:36:20-04:00 testsuite: Add test for #23400 - - - - - d191461c by Ben Gamari at 2023-07-02T11:36:21-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a998f91c by Ben Bellick at 2023-07-02T11:36:26-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - bb8c3cfc by Moisés Ackerman at 2023-07-02T11:36:32-04:00 Add failing test case for #23492 - - - - - f5da26e9 by Moisés Ackerman at 2023-07-02T11:36:32-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 25db6782 by Moisés Ackerman at 2023-07-02T11:36:32-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - d8461ad6 by Moisés Ackerman at 2023-07-02T11:36:32-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - ffbe94e7 by Ryan Hendrickson at 2023-07-02T11:36:38-04:00 Add regression test for #23549 - - - - - e81ce604 by Alexis King at 2023-07-02T11:36:49-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - a838ef62 by Bryan Richter at 2023-07-02T11:36:50-04:00 Add missing void prototypes to rts functions See #23561. - - - - - b21817da by Ben Gamari at 2023-07-02T11:36:50-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - c5c570fb by Ben Gamari at 2023-07-02T11:36:51-04:00 testsuite: Update documentation - - - - - 4e6cb127 by Gregory Gerasev at 2023-07-02T11:36:55-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - a981f7dc by Dave Barton at 2023-07-02T11:37:01-04:00 Fix some broken links and typos - - - - - 4a9e7baf by Ben Gamari at 2023-07-02T11:37:01-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38c6ed98c2fe22b8e8dd37648d218741f5f1b1d1...4a9e7baf77415ef1a02870f7fb46161fafe16e02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38c6ed98c2fe22b8e8dd37648d218741f5f1b1d1...4a9e7baf77415ef1a02870f7fb46161fafe16e02 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:39:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:39:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19a2f93104_2e0e5b475cc24327@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 16d332aa by Torsten Schmits at 2023-07-02T11:38:42-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 1052f602 by Ben Gamari at 2023-07-02T11:38:43-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 83a9453f by Ben Gamari at 2023-07-02T11:38:43-04:00 testsuite: Add test for #23400 - - - - - a0dca05a by Ben Gamari at 2023-07-02T11:38:45-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 64428da8 by Ben Bellick at 2023-07-02T11:38:50-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - eb438475 by Moisés Ackerman at 2023-07-02T11:38:55-04:00 Add failing test case for #23492 - - - - - 911193af by Moisés Ackerman at 2023-07-02T11:38:55-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c6ddf5fe by Moisés Ackerman at 2023-07-02T11:38:55-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - cb935a62 by Moisés Ackerman at 2023-07-02T11:38:55-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 2f27c29c by Ryan Hendrickson at 2023-07-02T11:39:01-04:00 Add regression test for #23549 - - - - - 3240dc70 by Alexis King at 2023-07-02T11:39:12-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 0abcf9d6 by Bryan Richter at 2023-07-02T11:39:13-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 34a7f751 by Ben Gamari at 2023-07-02T11:39:13-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9cce7dc3 by Ben Gamari at 2023-07-02T11:39:14-04:00 testsuite: Update documentation - - - - - a07967ba by Gregory Gerasev at 2023-07-02T11:39:18-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 02d9f5b7 by Dave Barton at 2023-07-02T11:39:22-04:00 Fix some broken links and typos - - - - - a152a4b7 by Ben Gamari at 2023-07-02T11:39:22-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a9e7baf77415ef1a02870f7fb46161fafe16e02...a152a4b7bdf1d73a7bc7676ce4e3dfd05aeaa1de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a9e7baf77415ef1a02870f7fb46161fafe16e02...a152a4b7bdf1d73a7bc7676ce4e3dfd05aeaa1de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:41:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:41:43 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19ab73a834_2e0e5b47518243422@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b3fe4df2 by Torsten Schmits at 2023-07-02T11:40:58-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 6b1153c3 by Ben Gamari at 2023-07-02T11:40:59-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - f3792222 by Ben Gamari at 2023-07-02T11:40:59-04:00 testsuite: Add test for #23400 - - - - - 0a395936 by Ben Gamari at 2023-07-02T11:41:01-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 4cc9117b by Ben Bellick at 2023-07-02T11:41:06-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 5256c735 by Moisés Ackerman at 2023-07-02T11:41:11-04:00 Add failing test case for #23492 - - - - - fe2f6e32 by Moisés Ackerman at 2023-07-02T11:41:11-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c28743f1 by Moisés Ackerman at 2023-07-02T11:41:12-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 40485eff by Moisés Ackerman at 2023-07-02T11:41:12-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 693e7f08 by Ryan Hendrickson at 2023-07-02T11:41:17-04:00 Add regression test for #23549 - - - - - a4ee5c21 by Alexis King at 2023-07-02T11:41:28-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 096fec5e by Bryan Richter at 2023-07-02T11:41:29-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 4dc403ea by Ben Gamari at 2023-07-02T11:41:29-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d40449b1 by Ben Gamari at 2023-07-02T11:41:30-04:00 testsuite: Update documentation - - - - - 0cf4c960 by Gregory Gerasev at 2023-07-02T11:41:34-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - c534829d by Dave Barton at 2023-07-02T11:41:38-04:00 Fix some broken links and typos - - - - - 819ef9b4 by Ben Gamari at 2023-07-02T11:41:38-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a152a4b7bdf1d73a7bc7676ce4e3dfd05aeaa1de...819ef9b4eda85baa5ffb244983b108c22a300031 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a152a4b7bdf1d73a7bc7676ce4e3dfd05aeaa1de...819ef9b4eda85baa5ffb244983b108c22a300031 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:43:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:43:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19b3fd98d_2e0e5b475902436f2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 205addf9 by Torsten Schmits at 2023-07-02T11:43:14-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 5d4f524c by Ben Gamari at 2023-07-02T11:43:15-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - d3452d73 by Ben Gamari at 2023-07-02T11:43:15-04:00 testsuite: Add test for #23400 - - - - - b8040882 by Ben Gamari at 2023-07-02T11:43:17-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 2061b533 by Ben Bellick at 2023-07-02T11:43:21-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 3b852611 by Moisés Ackerman at 2023-07-02T11:43:27-04:00 Add failing test case for #23492 - - - - - 95d8752f by Moisés Ackerman at 2023-07-02T11:43:27-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - e9325203 by Moisés Ackerman at 2023-07-02T11:43:27-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 9a711ff2 by Moisés Ackerman at 2023-07-02T11:43:27-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - f4da0f81 by Ryan Hendrickson at 2023-07-02T11:43:34-04:00 Add regression test for #23549 - - - - - 46d262d5 by Alexis King at 2023-07-02T11:43:44-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 41073948 by Bryan Richter at 2023-07-02T11:43:45-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 431a4209 by Ben Gamari at 2023-07-02T11:43:45-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - d904b195 by Ben Gamari at 2023-07-02T11:43:45-04:00 testsuite: Update documentation - - - - - bcfab81c by Gregory Gerasev at 2023-07-02T11:43:50-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - e459c08a by Dave Barton at 2023-07-02T11:43:54-04:00 Fix some broken links and typos - - - - - 0f23d7d4 by Ben Gamari at 2023-07-02T11:43:54-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/819ef9b4eda85baa5ffb244983b108c22a300031...0f23d7d4bb864ea65a88941792cede1eb176d58a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/819ef9b4eda85baa5ffb244983b108c22a300031...0f23d7d4bb864ea65a88941792cede1eb176d58a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:46:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:46:16 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19bc8c099b_2e0e5b475f4243830@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3bb35f14 by Torsten Schmits at 2023-07-02T11:45:30-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - a497fae9 by Ben Gamari at 2023-07-02T11:45:31-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 9d90a9ad by Ben Gamari at 2023-07-02T11:45:31-04:00 testsuite: Add test for #23400 - - - - - f5c087e5 by Ben Gamari at 2023-07-02T11:45:33-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 58cc78fe by Ben Bellick at 2023-07-02T11:45:38-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - b0344d55 by Moisés Ackerman at 2023-07-02T11:45:45-04:00 Add failing test case for #23492 - - - - - 409a2e10 by Moisés Ackerman at 2023-07-02T11:45:45-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c77df9cd by Moisés Ackerman at 2023-07-02T11:45:46-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 23c00b75 by Moisés Ackerman at 2023-07-02T11:45:46-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 2e961a05 by Ryan Hendrickson at 2023-07-02T11:45:51-04:00 Add regression test for #23549 - - - - - a0de9ca7 by Alexis King at 2023-07-02T11:46:02-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 9702835d by Bryan Richter at 2023-07-02T11:46:03-04:00 Add missing void prototypes to rts functions See #23561. - - - - - e7d2ce2c by Ben Gamari at 2023-07-02T11:46:03-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 83a68b26 by Ben Gamari at 2023-07-02T11:46:04-04:00 testsuite: Update documentation - - - - - 443eaa45 by Gregory Gerasev at 2023-07-02T11:46:08-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 01219f71 by Dave Barton at 2023-07-02T11:46:12-04:00 Fix some broken links and typos - - - - - 2717b47c by Ben Gamari at 2023-07-02T11:46:12-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f23d7d4bb864ea65a88941792cede1eb176d58a...2717b47c7b8b4f294c9f4f31a11909e25978b11e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f23d7d4bb864ea65a88941792cede1eb176d58a...2717b47c7b8b4f294c9f4f31a11909e25978b11e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:48:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:48:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19c52180bc_2e0e5b4752c244084@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 176a0a77 by Torsten Schmits at 2023-07-02T11:47:49-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 47056b3f by Ben Gamari at 2023-07-02T11:47:50-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 4fd4aae3 by Ben Gamari at 2023-07-02T11:47:50-04:00 testsuite: Add test for #23400 - - - - - c4007474 by Ben Gamari at 2023-07-02T11:47:52-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 7a7c30e2 by Ben Bellick at 2023-07-02T11:47:57-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 8d297e94 by Moisés Ackerman at 2023-07-02T11:48:02-04:00 Add failing test case for #23492 - - - - - 5debe698 by Moisés Ackerman at 2023-07-02T11:48:02-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - a5c0e59a by Moisés Ackerman at 2023-07-02T11:48:02-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 03b0a59d by Moisés Ackerman at 2023-07-02T11:48:02-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 71a5fd1f by Ryan Hendrickson at 2023-07-02T11:48:08-04:00 Add regression test for #23549 - - - - - 3ba1558b by Alexis King at 2023-07-02T11:48:19-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 7757755c by Bryan Richter at 2023-07-02T11:48:19-04:00 Add missing void prototypes to rts functions See #23561. - - - - - c49a01b0 by Ben Gamari at 2023-07-02T11:48:20-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 8123726a by Ben Gamari at 2023-07-02T11:48:20-04:00 testsuite: Update documentation - - - - - 3e855955 by Gregory Gerasev at 2023-07-02T11:48:25-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - f7aca450 by Dave Barton at 2023-07-02T11:48:28-04:00 Fix some broken links and typos - - - - - 2a13870c by Ben Gamari at 2023-07-02T11:48:29-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2717b47c7b8b4f294c9f4f31a11909e25978b11e...2a13870c498bdf73c49322ad6dc8ef9e5e8646d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2717b47c7b8b4f294c9f4f31a11909e25978b11e...2a13870c498bdf73c49322ad6dc8ef9e5e8646d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:50:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:50:54 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19cdeeb2ea_2e0e5b475e02462fe@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b839819a by Torsten Schmits at 2023-07-02T11:50:10-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 0e49c0bd by Ben Gamari at 2023-07-02T11:50:11-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - ca1d237d by Ben Gamari at 2023-07-02T11:50:11-04:00 testsuite: Add test for #23400 - - - - - 9e2a9bd2 by Ben Gamari at 2023-07-02T11:50:13-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - cdbb066d by Ben Bellick at 2023-07-02T11:50:18-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 23f69875 by Moisés Ackerman at 2023-07-02T11:50:23-04:00 Add failing test case for #23492 - - - - - 9b802ef8 by Moisés Ackerman at 2023-07-02T11:50:23-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - ccd573a6 by Moisés Ackerman at 2023-07-02T11:50:23-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd6a3bc2 by Moisés Ackerman at 2023-07-02T11:50:23-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 9737d2db by Ryan Hendrickson at 2023-07-02T11:50:29-04:00 Add regression test for #23549 - - - - - 4abc9091 by Alexis King at 2023-07-02T11:50:40-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 2843c41b by Bryan Richter at 2023-07-02T11:50:41-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 73bcf265 by Ben Gamari at 2023-07-02T11:50:41-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 75b8a76a by Ben Gamari at 2023-07-02T11:50:41-04:00 testsuite: Update documentation - - - - - b3eb7155 by Gregory Gerasev at 2023-07-02T11:50:46-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 32ea6928 by Dave Barton at 2023-07-02T11:50:50-04:00 Fix some broken links and typos - - - - - dea5e010 by Ben Gamari at 2023-07-02T11:50:50-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a13870c498bdf73c49322ad6dc8ef9e5e8646d4...dea5e0106e8eeefc17c1223ff8669e073a45b873 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a13870c498bdf73c49322ad6dc8ef9e5e8646d4...dea5e0106e8eeefc17c1223ff8669e073a45b873 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:53:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:53:10 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19d669fc7f_2e0e5b4752c24647f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f5aaaac4 by Torsten Schmits at 2023-07-02T11:52:25-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 7788b649 by Ben Gamari at 2023-07-02T11:52:26-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6ee2a5b5 by Ben Gamari at 2023-07-02T11:52:26-04:00 testsuite: Add test for #23400 - - - - - 94d9efaa by Ben Gamari at 2023-07-02T11:52:28-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - e6583b07 by Ben Bellick at 2023-07-02T11:52:33-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 87f324f2 by Moisés Ackerman at 2023-07-02T11:52:38-04:00 Add failing test case for #23492 - - - - - 48d0aba2 by Moisés Ackerman at 2023-07-02T11:52:38-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 731af6a4 by Moisés Ackerman at 2023-07-02T11:52:38-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 56487d73 by Moisés Ackerman at 2023-07-02T11:52:38-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 8cc1bbc9 by Ryan Hendrickson at 2023-07-02T11:52:45-04:00 Add regression test for #23549 - - - - - ed574ec6 by Alexis King at 2023-07-02T11:52:55-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - fbed14ee by Bryan Richter at 2023-07-02T11:52:56-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 150320e7 by Ben Gamari at 2023-07-02T11:52:56-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - fca440e8 by Ben Gamari at 2023-07-02T11:52:57-04:00 testsuite: Update documentation - - - - - be5cf81a by Gregory Gerasev at 2023-07-02T11:53:01-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 74b49d88 by Dave Barton at 2023-07-02T11:53:05-04:00 Fix some broken links and typos - - - - - 923fe0e5 by Ben Gamari at 2023-07-02T11:53:06-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dea5e0106e8eeefc17c1223ff8669e073a45b873...923fe0e550344e74cf046e2af92bff851591be3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dea5e0106e8eeefc17c1223ff8669e073a45b873...923fe0e550344e74cf046e2af92bff851591be3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:55:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:55:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19df11cd74_2e0e5b47590246628@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cfc19e8b by Torsten Schmits at 2023-07-02T11:54:44-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 0fd6ea40 by Ben Gamari at 2023-07-02T11:54:45-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 2beaa24b by Ben Gamari at 2023-07-02T11:54:45-04:00 testsuite: Add test for #23400 - - - - - b534f002 by Ben Gamari at 2023-07-02T11:54:47-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 79392b1d by Ben Bellick at 2023-07-02T11:54:51-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 3a615e62 by Moisés Ackerman at 2023-07-02T11:54:57-04:00 Add failing test case for #23492 - - - - - 0d092931 by Moisés Ackerman at 2023-07-02T11:54:57-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 78ba1c67 by Moisés Ackerman at 2023-07-02T11:54:57-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - cff13afa by Moisés Ackerman at 2023-07-02T11:54:57-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 58e24f53 by Ryan Hendrickson at 2023-07-02T11:55:03-04:00 Add regression test for #23549 - - - - - d418ea82 by Alexis King at 2023-07-02T11:55:14-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - c30647ae by Bryan Richter at 2023-07-02T11:55:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 12d2613c by Ben Gamari at 2023-07-02T11:55:15-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - affbabb7 by Ben Gamari at 2023-07-02T11:55:16-04:00 testsuite: Update documentation - - - - - a3b91315 by Gregory Gerasev at 2023-07-02T11:55:20-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 5fc620d8 by Dave Barton at 2023-07-02T11:55:24-04:00 Fix some broken links and typos - - - - - 4d02681b by Ben Gamari at 2023-07-02T11:55:24-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/923fe0e550344e74cf046e2af92bff851591be3f...4d02681be0b286066c52472f9884143072266038 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/923fe0e550344e74cf046e2af92bff851591be3f...4d02681be0b286066c52472f9884143072266038 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 15:57:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 11:57:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19e7877e64_2e0e5b4752c2468a7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d34b9895 by Torsten Schmits at 2023-07-02T11:56:59-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - a792dccb by Ben Gamari at 2023-07-02T11:57:00-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 1bd5a8dc by Ben Gamari at 2023-07-02T11:57:00-04:00 testsuite: Add test for #23400 - - - - - 826e59f2 by Ben Gamari at 2023-07-02T11:57:02-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 11a23619 by Ben Bellick at 2023-07-02T11:57:06-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 5d787d2a by Moisés Ackerman at 2023-07-02T11:57:12-04:00 Add failing test case for #23492 - - - - - e391d0a6 by Moisés Ackerman at 2023-07-02T11:57:12-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 1271e206 by Moisés Ackerman at 2023-07-02T11:57:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 73830e5f by Moisés Ackerman at 2023-07-02T11:57:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 793e82fe by Ryan Hendrickson at 2023-07-02T11:57:18-04:00 Add regression test for #23549 - - - - - 6f583227 by Alexis King at 2023-07-02T11:57:29-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - f5729e9f by Bryan Richter at 2023-07-02T11:57:30-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 63ee7c78 by Ben Gamari at 2023-07-02T11:57:30-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - fe6aceb7 by Ben Gamari at 2023-07-02T11:57:31-04:00 testsuite: Update documentation - - - - - 419b284e by Gregory Gerasev at 2023-07-02T11:57:35-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 892abc38 by Dave Barton at 2023-07-02T11:57:39-04:00 Fix some broken links and typos - - - - - 577d7709 by Ben Gamari at 2023-07-02T11:57:40-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d02681be0b286066c52472f9884143072266038...577d77093160f996e4db1bb64e764c969865024d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d02681be0b286066c52472f9884143072266038...577d77093160f996e4db1bb64e764c969865024d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:00:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:00:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19f042fa02_2e0e5b47518247065@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5dd73322 by Torsten Schmits at 2023-07-02T11:59:18-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 80bb2b47 by Ben Gamari at 2023-07-02T11:59:19-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 758b4779 by Ben Gamari at 2023-07-02T11:59:19-04:00 testsuite: Add test for #23400 - - - - - b42e5329 by Ben Gamari at 2023-07-02T11:59:21-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - ebbad9af by Ben Bellick at 2023-07-02T11:59:26-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 88f2b01e by Moisés Ackerman at 2023-07-02T11:59:31-04:00 Add failing test case for #23492 - - - - - 601f490a by Moisés Ackerman at 2023-07-02T11:59:31-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 8a052bee by Moisés Ackerman at 2023-07-02T11:59:31-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - c4f91ab4 by Moisés Ackerman at 2023-07-02T11:59:31-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - d49cefca by Ryan Hendrickson at 2023-07-02T11:59:38-04:00 Add regression test for #23549 - - - - - cc2cc6f3 by Alexis King at 2023-07-02T11:59:48-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 8b007173 by Bryan Richter at 2023-07-02T11:59:49-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 70dacae2 by Ben Gamari at 2023-07-02T11:59:49-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 1207d267 by Ben Gamari at 2023-07-02T11:59:50-04:00 testsuite: Update documentation - - - - - e2bf1197 by Gregory Gerasev at 2023-07-02T11:59:54-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 5aeb0646 by Dave Barton at 2023-07-02T11:59:58-04:00 Fix some broken links and typos - - - - - f212881b by Ben Gamari at 2023-07-02T11:59:59-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/577d77093160f996e4db1bb64e764c969865024d...f212881b006598ee4088293a850550f0491f472c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/577d77093160f996e4db1bb64e764c969865024d...f212881b006598ee4088293a850550f0491f472c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:02:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:02:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a19f8fd9dfe_2e0e5b475cc247245@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f683964c by Torsten Schmits at 2023-07-02T12:01:38-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - e27b7ce1 by Ben Gamari at 2023-07-02T12:01:40-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - a3265243 by Ben Gamari at 2023-07-02T12:01:40-04:00 testsuite: Add test for #23400 - - - - - ab490363 by Ben Gamari at 2023-07-02T12:01:41-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 4dccec64 by Ben Bellick at 2023-07-02T12:01:46-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - c1ea9196 by Moisés Ackerman at 2023-07-02T12:01:52-04:00 Add failing test case for #23492 - - - - - d0c9f4c3 by Moisés Ackerman at 2023-07-02T12:01:52-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3864202b by Moisés Ackerman at 2023-07-02T12:01:52-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 53339ff3 by Moisés Ackerman at 2023-07-02T12:01:52-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - afffdf06 by Ryan Hendrickson at 2023-07-02T12:01:58-04:00 Add regression test for #23549 - - - - - 0aba8c0e by Alexis King at 2023-07-02T12:02:09-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 688f79b2 by Bryan Richter at 2023-07-02T12:02:09-04:00 Add missing void prototypes to rts functions See #23561. - - - - - ae9ea306 by Ben Gamari at 2023-07-02T12:02:10-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 08734490 by Ben Gamari at 2023-07-02T12:02:10-04:00 testsuite: Update documentation - - - - - 478c92a9 by Gregory Gerasev at 2023-07-02T12:02:15-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 19b4d1a2 by Dave Barton at 2023-07-02T12:02:18-04:00 Fix some broken links and typos - - - - - 5be5b7d0 by Ben Gamari at 2023-07-02T12:02:19-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f212881b006598ee4088293a850550f0491f472c...5be5b7d0b7625f120e579d5041311e45d5ebc29c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f212881b006598ee4088293a850550f0491f472c...5be5b7d0b7625f120e579d5041311e45d5ebc29c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:04:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:04:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a015e4405_2e0e5b475f42474f2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 60ba583d by Torsten Schmits at 2023-07-02T12:03:53-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fddd0818 by Ben Gamari at 2023-07-02T12:03:54-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 963d4938 by Ben Gamari at 2023-07-02T12:03:54-04:00 testsuite: Add test for #23400 - - - - - 39e023bc by Ben Gamari at 2023-07-02T12:03:56-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 565e900f by Ben Bellick at 2023-07-02T12:04:00-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - e840b7cb by Moisés Ackerman at 2023-07-02T12:04:06-04:00 Add failing test case for #23492 - - - - - 745eec8a by Moisés Ackerman at 2023-07-02T12:04:06-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - c920d82e by Moisés Ackerman at 2023-07-02T12:04:06-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - ccf15fb4 by Moisés Ackerman at 2023-07-02T12:04:06-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - e5adc377 by Ryan Hendrickson at 2023-07-02T12:04:12-04:00 Add regression test for #23549 - - - - - f0d35d92 by Alexis King at 2023-07-02T12:04:23-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 462316a4 by Bryan Richter at 2023-07-02T12:04:24-04:00 Add missing void prototypes to rts functions See #23561. - - - - - e61e49ca by Ben Gamari at 2023-07-02T12:04:24-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 14e34a32 by Ben Gamari at 2023-07-02T12:04:24-04:00 testsuite: Update documentation - - - - - 6d6c8e7a by Gregory Gerasev at 2023-07-02T12:04:29-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 037d64ee by Dave Barton at 2023-07-02T12:04:33-04:00 Fix some broken links and typos - - - - - e5aa58a2 by Ben Gamari at 2023-07-02T12:04:33-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5be5b7d0b7625f120e579d5041311e45d5ebc29c...e5aa58a27810f58e06def40376810e27d3a9c3bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5be5b7d0b7625f120e579d5041311e45d5ebc29c...e5aa58a27810f58e06def40376810e27d3a9c3bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:06:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:06:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a09fa96e5_2e0e5b475f424761d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1fd4399d by Torsten Schmits at 2023-07-02T12:06:10-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d57c8240 by Ben Gamari at 2023-07-02T12:06:11-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 14fa1227 by Ben Gamari at 2023-07-02T12:06:11-04:00 testsuite: Add test for #23400 - - - - - fdef892b by Ben Gamari at 2023-07-02T12:06:13-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 928c427c by Ben Bellick at 2023-07-02T12:06:18-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - c69885c5 by Moisés Ackerman at 2023-07-02T12:06:23-04:00 Add failing test case for #23492 - - - - - 601ef985 by Moisés Ackerman at 2023-07-02T12:06:23-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - e2ae9ba8 by Moisés Ackerman at 2023-07-02T12:06:23-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 45de03bd by Moisés Ackerman at 2023-07-02T12:06:23-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - d890bf43 by Ryan Hendrickson at 2023-07-02T12:06:29-04:00 Add regression test for #23549 - - - - - 17b57664 by Alexis King at 2023-07-02T12:06:40-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - d2b6fc08 by Bryan Richter at 2023-07-02T12:06:41-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 54b5bd4a by Ben Gamari at 2023-07-02T12:06:41-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 52033b21 by Ben Gamari at 2023-07-02T12:06:41-04:00 testsuite: Update documentation - - - - - d6288f90 by Gregory Gerasev at 2023-07-02T12:06:46-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 5fccc8cc by Dave Barton at 2023-07-02T12:06:50-04:00 Fix some broken links and typos - - - - - 03b5dc84 by Ben Gamari at 2023-07-02T12:06:50-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5aa58a27810f58e06def40376810e27d3a9c3bb...03b5dc849c2f64d91c5f74cca0bc739ae090db04 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5aa58a27810f58e06def40376810e27d3a9c3bb...03b5dc849c2f64d91c5f74cca0bc739ae090db04 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:09:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:09:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a12717d30_2e0e5b4751824783a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 93a861be by Torsten Schmits at 2023-07-02T12:08:26-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 8dbee45a by Ben Gamari at 2023-07-02T12:08:27-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 4a30b10c by Ben Gamari at 2023-07-02T12:08:27-04:00 testsuite: Add test for #23400 - - - - - 49c8600f by Ben Gamari at 2023-07-02T12:08:29-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 2a862830 by Ben Bellick at 2023-07-02T12:08:34-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - cca46127 by Moisés Ackerman at 2023-07-02T12:08:39-04:00 Add failing test case for #23492 - - - - - 14a470bc by Moisés Ackerman at 2023-07-02T12:08:39-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - dab0e94b by Moisés Ackerman at 2023-07-02T12:08:39-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 5ddc916e by Moisés Ackerman at 2023-07-02T12:08:39-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - aebbfece by Ryan Hendrickson at 2023-07-02T12:08:45-04:00 Add regression test for #23549 - - - - - b07eacaa by Alexis King at 2023-07-02T12:08:56-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 136825dc by Bryan Richter at 2023-07-02T12:08:56-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 2c1cf73e by Ben Gamari at 2023-07-02T12:08:57-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 901db533 by Ben Gamari at 2023-07-02T12:08:57-04:00 testsuite: Update documentation - - - - - 4a5bfc2d by Gregory Gerasev at 2023-07-02T12:09:02-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - d063bb65 by Dave Barton at 2023-07-02T12:09:06-04:00 Fix some broken links and typos - - - - - c7ee92a1 by Ben Gamari at 2023-07-02T12:09:06-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03b5dc849c2f64d91c5f74cca0bc739ae090db04...c7ee92a1467928c6cb6f9891c8dfaaaaaad473a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03b5dc849c2f64d91c5f74cca0bc739ae090db04...c7ee92a1467928c6cb6f9891c8dfaaaaaad473a4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:11:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:11:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a1b1b0668_2e0e5b4750424802d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 90705df2 by Torsten Schmits at 2023-07-02T12:10:42-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 6b80de33 by Ben Gamari at 2023-07-02T12:10:43-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - dc7331c3 by Ben Gamari at 2023-07-02T12:10:43-04:00 testsuite: Add test for #23400 - - - - - 15239885 by Ben Gamari at 2023-07-02T12:10:45-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 9c8b94d3 by Ben Bellick at 2023-07-02T12:10:49-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - ef8973ab by Moisés Ackerman at 2023-07-02T12:10:55-04:00 Add failing test case for #23492 - - - - - a5284b31 by Moisés Ackerman at 2023-07-02T12:10:55-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - fbce5225 by Moisés Ackerman at 2023-07-02T12:10:55-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - ab5c6887 by Moisés Ackerman at 2023-07-02T12:10:55-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 1264c50e by Ryan Hendrickson at 2023-07-02T12:11:01-04:00 Add regression test for #23549 - - - - - f4b2726b by Alexis King at 2023-07-02T12:11:12-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 23ce97ea by Bryan Richter at 2023-07-02T12:11:13-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6b50fed9 by Ben Gamari at 2023-07-02T12:11:13-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 29bf42ee by Ben Gamari at 2023-07-02T12:11:14-04:00 testsuite: Update documentation - - - - - 3443895d by Gregory Gerasev at 2023-07-02T12:11:19-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 33789692 by Dave Barton at 2023-07-02T12:11:22-04:00 Fix some broken links and typos - - - - - 3d76104d by Ben Gamari at 2023-07-02T12:11:23-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7ee92a1467928c6cb6f9891c8dfaaaaaad473a4...3d76104d1f45b8c0f1837325ce3790e0efb0074c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7ee92a1467928c6cb6f9891c8dfaaaaaad473a4...3d76104d1f45b8c0f1837325ce3790e0efb0074c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:13:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:13:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a239766ea_2e0e5b475cc2490ed@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5c49a7fa by Torsten Schmits at 2023-07-02T12:12:59-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - bf03f93a by Ben Gamari at 2023-07-02T12:13:01-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 58b78355 by Ben Gamari at 2023-07-02T12:13:01-04:00 testsuite: Add test for #23400 - - - - - 9348a183 by Ben Gamari at 2023-07-02T12:13:03-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 710d9a3c by Ben Bellick at 2023-07-02T12:13:07-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - afffdba0 by Moisés Ackerman at 2023-07-02T12:13:13-04:00 Add failing test case for #23492 - - - - - 731f6e8c by Moisés Ackerman at 2023-07-02T12:13:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - ddeccf8d by Moisés Ackerman at 2023-07-02T12:13:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 8e802c8e by Moisés Ackerman at 2023-07-02T12:13:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 15d5dbc3 by Ryan Hendrickson at 2023-07-02T12:13:19-04:00 Add regression test for #23549 - - - - - 439cf274 by Alexis King at 2023-07-02T12:13:30-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 0ca66627 by Bryan Richter at 2023-07-02T12:13:30-04:00 Add missing void prototypes to rts functions See #23561. - - - - - e2fe6390 by Ben Gamari at 2023-07-02T12:13:31-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - f87acb97 by Ben Gamari at 2023-07-02T12:13:31-04:00 testsuite: Update documentation - - - - - 6678f261 by Gregory Gerasev at 2023-07-02T12:13:36-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - ff54103c by Dave Barton at 2023-07-02T12:13:40-04:00 Fix some broken links and typos - - - - - 922c88a0 by Ben Gamari at 2023-07-02T12:13:40-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d76104d1f45b8c0f1837325ce3790e0efb0074c...922c88a0b532f801925bf01c0953d4cedd3812e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d76104d1f45b8c0f1837325ce3790e0efb0074c...922c88a0b532f801925bf01c0953d4cedd3812e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:16:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:16:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a2c4dd6ec_2e0e5b47504249257@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a2080b59 by Torsten Schmits at 2023-07-02T12:15:15-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - b7483a61 by Ben Gamari at 2023-07-02T12:15:16-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 73047642 by Ben Gamari at 2023-07-02T12:15:16-04:00 testsuite: Add test for #23400 - - - - - b1778d1a by Ben Gamari at 2023-07-02T12:15:18-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 3d8582b4 by Ben Bellick at 2023-07-02T12:15:22-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 7218aa57 by Moisés Ackerman at 2023-07-02T12:15:28-04:00 Add failing test case for #23492 - - - - - f8a7ae4d by Moisés Ackerman at 2023-07-02T12:15:28-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 6fe00228 by Moisés Ackerman at 2023-07-02T12:15:28-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 0db187be by Moisés Ackerman at 2023-07-02T12:15:28-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - fcf19a87 by Ryan Hendrickson at 2023-07-02T12:15:34-04:00 Add regression test for #23549 - - - - - b14de1f5 by Alexis King at 2023-07-02T12:15:50-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 67e42ea2 by Bryan Richter at 2023-07-02T12:15:50-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 7e397a70 by Ben Gamari at 2023-07-02T12:15:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - e281898d by Ben Gamari at 2023-07-02T12:15:51-04:00 testsuite: Update documentation - - - - - 7dd398f6 by Gregory Gerasev at 2023-07-02T12:15:56-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 1efc77c6 by Dave Barton at 2023-07-02T12:16:00-04:00 Fix some broken links and typos - - - - - c21f2abf by Ben Gamari at 2023-07-02T12:16:00-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/922c88a0b532f801925bf01c0953d4cedd3812e5...c21f2abf873dde35449e07abe97f79621c81cd84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/922c88a0b532f801925bf01c0953d4cedd3812e5...c21f2abf873dde35449e07abe97f79621c81cd84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:18:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:18:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a34e344b0_2e0e5b475b82494b5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 41716fda by Torsten Schmits at 2023-07-02T12:17:37-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - ba72480e by Ben Gamari at 2023-07-02T12:17:38-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - c4342099 by Ben Gamari at 2023-07-02T12:17:38-04:00 testsuite: Add test for #23400 - - - - - 5f3fe3f1 by Ben Gamari at 2023-07-02T12:17:40-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 5973e05a by Ben Bellick at 2023-07-02T12:17:45-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - e9808909 by Moisés Ackerman at 2023-07-02T12:17:50-04:00 Add failing test case for #23492 - - - - - 463fe6b2 by Moisés Ackerman at 2023-07-02T12:17:50-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3aaa8a52 by Moisés Ackerman at 2023-07-02T12:17:50-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 82fb8a60 by Moisés Ackerman at 2023-07-02T12:17:50-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - c0cd3594 by Ryan Hendrickson at 2023-07-02T12:17:56-04:00 Add regression test for #23549 - - - - - f27539f2 by Alexis King at 2023-07-02T12:18:07-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 20a0b929 by Bryan Richter at 2023-07-02T12:18:08-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 544f1684 by Ben Gamari at 2023-07-02T12:18:08-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aef59903 by Ben Gamari at 2023-07-02T12:18:08-04:00 testsuite: Update documentation - - - - - d7c7662f by Gregory Gerasev at 2023-07-02T12:18:13-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - de47e49e by Dave Barton at 2023-07-02T12:18:17-04:00 Fix some broken links and typos - - - - - 098e7f06 by Ben Gamari at 2023-07-02T12:18:17-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c21f2abf873dde35449e07abe97f79621c81cd84...098e7f060b56190ecac81f06db5f77df08054c57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c21f2abf873dde35449e07abe97f79621c81cd84...098e7f060b56190ecac81f06db5f77df08054c57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:20:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:20:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a3d5cb74e_2e0e5b475b82496b6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 889c7fad by Torsten Schmits at 2023-07-02T12:19:52-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - f91aaaf6 by Ben Gamari at 2023-07-02T12:19:53-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 0f8832a2 by Ben Gamari at 2023-07-02T12:19:53-04:00 testsuite: Add test for #23400 - - - - - cb4fc285 by Ben Gamari at 2023-07-02T12:19:55-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - cedf36b2 by Ben Bellick at 2023-07-02T12:19:59-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - bc8e520c by Moisés Ackerman at 2023-07-02T12:20:06-04:00 Add failing test case for #23492 - - - - - 6fb9bdef by Moisés Ackerman at 2023-07-02T12:20:06-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - b1b4ff7b by Moisés Ackerman at 2023-07-02T12:20:06-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - ccdf9d7a by Moisés Ackerman at 2023-07-02T12:20:06-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - a38f0967 by Ryan Hendrickson at 2023-07-02T12:20:12-04:00 Add regression test for #23549 - - - - - 67e40277 by Alexis King at 2023-07-02T12:20:23-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 6f335b04 by Bryan Richter at 2023-07-02T12:20:23-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 12b5677c by Ben Gamari at 2023-07-02T12:20:24-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 410cc1ca by Ben Gamari at 2023-07-02T12:20:24-04:00 testsuite: Update documentation - - - - - dfcf4ab3 by Gregory Gerasev at 2023-07-02T12:20:29-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4e7b5d8b by Dave Barton at 2023-07-02T12:20:33-04:00 Fix some broken links and typos - - - - - 95a8a63d by Ben Gamari at 2023-07-02T12:20:33-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/098e7f060b56190ecac81f06db5f77df08054c57...95a8a63d669ad542c8799aa28d093e391986bd62 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/098e7f060b56190ecac81f06db5f77df08054c57...95a8a63d669ad542c8799aa28d093e391986bd62 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:22:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:22:54 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a45ee959e_2e0e5b47590249831@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2b21ca80 by Torsten Schmits at 2023-07-02T12:22:10-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fe3f2374 by Ben Gamari at 2023-07-02T12:22:11-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 511e17a7 by Ben Gamari at 2023-07-02T12:22:11-04:00 testsuite: Add test for #23400 - - - - - c615b905 by Ben Gamari at 2023-07-02T12:22:13-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 8c35926c by Ben Bellick at 2023-07-02T12:22:18-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - a2925fff by Moisés Ackerman at 2023-07-02T12:22:23-04:00 Add failing test case for #23492 - - - - - 63dc49cd by Moisés Ackerman at 2023-07-02T12:22:23-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - f96fd825 by Moisés Ackerman at 2023-07-02T12:22:23-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 9872aff9 by Moisés Ackerman at 2023-07-02T12:22:24-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 398b679d by Ryan Hendrickson at 2023-07-02T12:22:29-04:00 Add regression test for #23549 - - - - - ee13fccf by Alexis King at 2023-07-02T12:22:40-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - fb5a29f9 by Bryan Richter at 2023-07-02T12:22:41-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 2c0ac500 by Ben Gamari at 2023-07-02T12:22:41-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 35261b08 by Ben Gamari at 2023-07-02T12:22:42-04:00 testsuite: Update documentation - - - - - 59363f76 by Gregory Gerasev at 2023-07-02T12:22:46-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 42e34504 by Dave Barton at 2023-07-02T12:22:50-04:00 Fix some broken links and typos - - - - - a2251a85 by Ben Gamari at 2023-07-02T12:22:50-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95a8a63d669ad542c8799aa28d093e391986bd62...a2251a855614e84206899f7b0272cf9cc745d661 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95a8a63d669ad542c8799aa28d093e391986bd62...a2251a855614e84206899f7b0272cf9cc745d661 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:25:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:25:13 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a4e92c8cd_2e0e5b475b825005c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b5b753c2 by Torsten Schmits at 2023-07-02T12:24:26-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - d984d40e by Ben Gamari at 2023-07-02T12:24:27-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - cc10fab9 by Ben Gamari at 2023-07-02T12:24:27-04:00 testsuite: Add test for #23400 - - - - - 7212c8e7 by Ben Gamari at 2023-07-02T12:24:29-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - bc22da7f by Ben Bellick at 2023-07-02T12:24:33-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 0a4095aa by Moisés Ackerman at 2023-07-02T12:24:40-04:00 Add failing test case for #23492 - - - - - 464237ed by Moisés Ackerman at 2023-07-02T12:24:40-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 94869f32 by Moisés Ackerman at 2023-07-02T12:24:40-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - ee6f8bf3 by Moisés Ackerman at 2023-07-02T12:24:40-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 91c9cf91 by Ryan Hendrickson at 2023-07-02T12:24:47-04:00 Add regression test for #23549 - - - - - 9ee76f01 by Alexis King at 2023-07-02T12:24:57-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 0b947279 by Bryan Richter at 2023-07-02T12:24:58-04:00 Add missing void prototypes to rts functions See #23561. - - - - - bc2ea7fb by Ben Gamari at 2023-07-02T12:24:58-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 0f6aaac8 by Ben Gamari at 2023-07-02T12:24:59-04:00 testsuite: Update documentation - - - - - 913e0d36 by Gregory Gerasev at 2023-07-02T12:25:04-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 93e78413 by Dave Barton at 2023-07-02T12:25:08-04:00 Fix some broken links and typos - - - - - 8d1bf849 by Ben Gamari at 2023-07-02T12:25:09-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a2251a855614e84206899f7b0272cf9cc745d661...8d1bf8499a0fee02cd35b70dbba31f5f33a844ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a2251a855614e84206899f7b0272cf9cc745d661...8d1bf8499a0fee02cd35b70dbba31f5f33a844ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:28:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:28:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a5a71568d_2e0e5b475cc25027b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2d897a58 by Torsten Schmits at 2023-07-02T12:27:37-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 378aafb5 by Ben Gamari at 2023-07-02T12:27:38-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 5bb9b61f by Ben Gamari at 2023-07-02T12:27:38-04:00 testsuite: Add test for #23400 - - - - - 10731ac1 by Ben Gamari at 2023-07-02T12:27:40-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - b45c99e5 by Ben Bellick at 2023-07-02T12:27:44-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 92084c1b by Moisés Ackerman at 2023-07-02T12:27:50-04:00 Add failing test case for #23492 - - - - - 3c65addf by Moisés Ackerman at 2023-07-02T12:27:51-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 57ee59c8 by Moisés Ackerman at 2023-07-02T12:27:51-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 4f7916e2 by Moisés Ackerman at 2023-07-02T12:27:51-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - fd8794c4 by Ryan Hendrickson at 2023-07-02T12:27:56-04:00 Add regression test for #23549 - - - - - 8bba1e77 by Alexis King at 2023-07-02T12:28:07-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 50f010d2 by Bryan Richter at 2023-07-02T12:28:08-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 20362e29 by Ben Gamari at 2023-07-02T12:28:08-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 8bc75fb7 by Ben Gamari at 2023-07-02T12:28:09-04:00 testsuite: Update documentation - - - - - 651ec9aa by Gregory Gerasev at 2023-07-02T12:28:14-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 97e7653d by Dave Barton at 2023-07-02T12:28:18-04:00 Fix some broken links and typos - - - - - 0da8b128 by Ben Gamari at 2023-07-02T12:28:18-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d1bf8499a0fee02cd35b70dbba31f5f33a844ae...0da8b1285f889240e1241b604765acd7c78a3fed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d1bf8499a0fee02cd35b70dbba31f5f33a844ae...0da8b1285f889240e1241b604765acd7c78a3fed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:30:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:30:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a636a1afb_2e0e5b475cc2504c3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ebfff0f1 by Torsten Schmits at 2023-07-02T12:30:01-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - c59bbb4a by Ben Gamari at 2023-07-02T12:30:02-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - b6329a35 by Ben Gamari at 2023-07-02T12:30:02-04:00 testsuite: Add test for #23400 - - - - - c4cf82a8 by Ben Gamari at 2023-07-02T12:30:04-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 1da934d3 by Ben Bellick at 2023-07-02T12:30:09-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 43a20e50 by Moisés Ackerman at 2023-07-02T12:30:14-04:00 Add failing test case for #23492 - - - - - b7956ae2 by Moisés Ackerman at 2023-07-02T12:30:14-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 65838e48 by Moisés Ackerman at 2023-07-02T12:30:14-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 4ba97d19 by Moisés Ackerman at 2023-07-02T12:30:14-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 6a766096 by Ryan Hendrickson at 2023-07-02T12:30:21-04:00 Add regression test for #23549 - - - - - 9c3c4b7e by Alexis King at 2023-07-02T12:30:32-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 6221c14c by Bryan Richter at 2023-07-02T12:30:33-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 191ab432 by Ben Gamari at 2023-07-02T12:30:33-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 1f2d20e8 by Ben Gamari at 2023-07-02T12:30:33-04:00 testsuite: Update documentation - - - - - 50d7d7a8 by Gregory Gerasev at 2023-07-02T12:30:38-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - c8692aa7 by Dave Barton at 2023-07-02T12:30:42-04:00 Fix some broken links and typos - - - - - 4c984a90 by Ben Gamari at 2023-07-02T12:30:42-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0da8b1285f889240e1241b604765acd7c78a3fed...4c984a90fec60f23745520320d7e19b6b1e18342 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0da8b1285f889240e1241b604765acd7c78a3fed...4c984a90fec60f23745520320d7e19b6b1e18342 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:33:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:33:04 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a6c0961ce_2e0e5b474f02506a6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: dfb5419f by Torsten Schmits at 2023-07-02T12:32:16-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 6f652ae4 by Ben Gamari at 2023-07-02T12:32:17-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - dd1659df by Ben Gamari at 2023-07-02T12:32:17-04:00 testsuite: Add test for #23400 - - - - - c3bf3c7e by Ben Gamari at 2023-07-02T12:32:19-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 838d64a3 by Ben Bellick at 2023-07-02T12:32:23-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - da99b74c by Moisés Ackerman at 2023-07-02T12:32:29-04:00 Add failing test case for #23492 - - - - - d595060b by Moisés Ackerman at 2023-07-02T12:32:29-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - b8b9140f by Moisés Ackerman at 2023-07-02T12:32:29-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 58c7ed73 by Moisés Ackerman at 2023-07-02T12:32:29-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 730f43c9 by Ryan Hendrickson at 2023-07-02T12:32:35-04:00 Add regression test for #23549 - - - - - 7e4de40c by Alexis King at 2023-07-02T12:32:46-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 4af4f490 by Bryan Richter at 2023-07-02T12:32:46-04:00 Add missing void prototypes to rts functions See #23561. - - - - - b0152758 by Ben Gamari at 2023-07-02T12:32:47-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 6c611160 by Ben Gamari at 2023-07-02T12:32:47-04:00 testsuite: Update documentation - - - - - aa1c2fe4 by Gregory Gerasev at 2023-07-02T12:32:52-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 3a776b55 by Dave Barton at 2023-07-02T12:32:58-04:00 Fix some broken links and typos - - - - - ed6eee35 by Ben Gamari at 2023-07-02T12:32:58-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c984a90fec60f23745520320d7e19b6b1e18342...ed6eee35fbeb286ac9496f13f65404781d8cafd0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4c984a90fec60f23745520320d7e19b6b1e18342...ed6eee35fbeb286ac9496f13f65404781d8cafd0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:35:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:35:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a746afc53_2e0e5b475cc250810@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: eb1001fb by Torsten Schmits at 2023-07-02T12:34:32-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 30933a64 by Ben Gamari at 2023-07-02T12:34:33-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 7cf87c59 by Ben Gamari at 2023-07-02T12:34:33-04:00 testsuite: Add test for #23400 - - - - - 1fb25e52 by Ben Gamari at 2023-07-02T12:34:35-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 6d673a38 by Ben Bellick at 2023-07-02T12:34:40-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 61a26fd7 by Moisés Ackerman at 2023-07-02T12:34:45-04:00 Add failing test case for #23492 - - - - - c2118b7b by Moisés Ackerman at 2023-07-02T12:34:45-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - f298671b by Moisés Ackerman at 2023-07-02T12:34:45-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - d85e9c15 by Moisés Ackerman at 2023-07-02T12:34:45-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - cd8e03f5 by Ryan Hendrickson at 2023-07-02T12:34:51-04:00 Add regression test for #23549 - - - - - dcf53924 by Alexis King at 2023-07-02T12:35:02-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - a5efbd92 by Bryan Richter at 2023-07-02T12:35:03-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 798e99fc by Ben Gamari at 2023-07-02T12:35:03-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 36bc1ed7 by Ben Gamari at 2023-07-02T12:35:04-04:00 testsuite: Update documentation - - - - - 58a40593 by Gregory Gerasev at 2023-07-02T12:35:08-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 54f46526 by Dave Barton at 2023-07-02T12:35:12-04:00 Fix some broken links and typos - - - - - b29d888b by Ben Gamari at 2023-07-02T12:35:12-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed6eee35fbeb286ac9496f13f65404781d8cafd0...b29d888bd74fae601663c567902586feeace4048 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed6eee35fbeb286ac9496f13f65404781d8cafd0...b29d888bd74fae601663c567902586feeace4048 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:37:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:37:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a7cb51663_2e0e5b4750425109b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a661ca9c by Torsten Schmits at 2023-07-02T12:36:46-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - aea6253c by Ben Gamari at 2023-07-02T12:36:47-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - b7eb53f3 by Ben Gamari at 2023-07-02T12:36:47-04:00 testsuite: Add test for #23400 - - - - - 24aee221 by Ben Gamari at 2023-07-02T12:36:49-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - e4399d9f by Ben Bellick at 2023-07-02T12:36:54-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 01aba86a by Moisés Ackerman at 2023-07-02T12:36:59-04:00 Add failing test case for #23492 - - - - - 85e5fe80 by Moisés Ackerman at 2023-07-02T12:36:59-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - d8957880 by Moisés Ackerman at 2023-07-02T12:36:59-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - cfb9a537 by Moisés Ackerman at 2023-07-02T12:36:59-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - b29b29c5 by Ryan Hendrickson at 2023-07-02T12:37:05-04:00 Add regression test for #23549 - - - - - f5802ebc by Alexis King at 2023-07-02T12:37:16-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 1a0db0b5 by Bryan Richter at 2023-07-02T12:37:17-04:00 Add missing void prototypes to rts functions See #23561. - - - - - aebed411 by Ben Gamari at 2023-07-02T12:37:17-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9e5e9185 by Ben Gamari at 2023-07-02T12:37:18-04:00 testsuite: Update documentation - - - - - d5402af9 by Gregory Gerasev at 2023-07-02T12:37:23-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 9900b9c5 by Dave Barton at 2023-07-02T12:37:26-04:00 Fix some broken links and typos - - - - - 67e757e1 by Ben Gamari at 2023-07-02T12:37:27-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b29d888bd74fae601663c567902586feeace4048...67e757e1cced15c68ce4da3b0696c2b62a6e08ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b29d888bd74fae601663c567902586feeace4048...67e757e1cced15c68ce4da3b0696c2b62a6e08ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:39:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:39:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a852c7ca1_2e0e5b47518251220@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 96da879b by Torsten Schmits at 2023-07-02T12:39:02-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - beb5f3e6 by Ben Gamari at 2023-07-02T12:39:03-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - e6007b47 by Ben Gamari at 2023-07-02T12:39:03-04:00 testsuite: Add test for #23400 - - - - - 4161b05f by Ben Gamari at 2023-07-02T12:39:05-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 1c76edf8 by Ben Bellick at 2023-07-02T12:39:09-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 5b1f7e06 by Moisés Ackerman at 2023-07-02T12:39:15-04:00 Add failing test case for #23492 - - - - - 0f7bd7f0 by Moisés Ackerman at 2023-07-02T12:39:15-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - de460bc8 by Moisés Ackerman at 2023-07-02T12:39:15-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 6f23e021 by Moisés Ackerman at 2023-07-02T12:39:15-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 1f84d3e4 by Ryan Hendrickson at 2023-07-02T12:39:21-04:00 Add regression test for #23549 - - - - - 9d127f12 by Alexis King at 2023-07-02T12:39:32-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 6f2da34a by Bryan Richter at 2023-07-02T12:39:33-04:00 Add missing void prototypes to rts functions See #23561. - - - - - c693b82c by Ben Gamari at 2023-07-02T12:39:33-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 8fcbb732 by Ben Gamari at 2023-07-02T12:39:33-04:00 testsuite: Update documentation - - - - - 5bf3ee19 by Gregory Gerasev at 2023-07-02T12:39:38-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - e8619588 by Dave Barton at 2023-07-02T12:39:42-04:00 Fix some broken links and typos - - - - - 901d003c by Ben Gamari at 2023-07-02T12:39:42-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67e757e1cced15c68ce4da3b0696c2b62a6e08ef...901d003ca153d62e1a53d673de7c705e5f701147 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67e757e1cced15c68ce4da3b0696c2b62a6e08ef...901d003ca153d62e1a53d673de7c705e5f701147 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:42:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:42:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a8e0709_2e0e5b475f4253442@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5b0ffc31 by Torsten Schmits at 2023-07-02T12:41:21-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 533388be by Ben Gamari at 2023-07-02T12:41:22-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 62ac2396 by Ben Gamari at 2023-07-02T12:41:22-04:00 testsuite: Add test for #23400 - - - - - 04d81d58 by Ben Gamari at 2023-07-02T12:41:24-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - ba5e9281 by Ben Bellick at 2023-07-02T12:41:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 42e30744 by Moisés Ackerman at 2023-07-02T12:41:35-04:00 Add failing test case for #23492 - - - - - 5ad31b6d by Moisés Ackerman at 2023-07-02T12:41:35-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 55776fdf by Moisés Ackerman at 2023-07-02T12:41:35-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 4477de47 by Moisés Ackerman at 2023-07-02T12:41:35-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - fb7e8bd9 by Ryan Hendrickson at 2023-07-02T12:41:41-04:00 Add regression test for #23549 - - - - - c1e8b820 by Alexis King at 2023-07-02T12:41:51-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 3e4e4372 by Bryan Richter at 2023-07-02T12:41:52-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 8a0cc88d by Ben Gamari at 2023-07-02T12:41:52-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 288c95c4 by Ben Gamari at 2023-07-02T12:41:53-04:00 testsuite: Update documentation - - - - - 68f7ba47 by Gregory Gerasev at 2023-07-02T12:41:58-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 138f539a by Dave Barton at 2023-07-02T12:42:02-04:00 Fix some broken links and typos - - - - - 21dc52c2 by Ben Gamari at 2023-07-02T12:42:02-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/901d003ca153d62e1a53d673de7c705e5f701147...21dc52c2f767550463f82e471022318bf5d64a3e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/901d003ca153d62e1a53d673de7c705e5f701147...21dc52c2f767550463f82e471022318bf5d64a3e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:44:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:44:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a9678b926_2e0e5b47504253675@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5f7f79b6 by Torsten Schmits at 2023-07-02T12:43:38-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - c6e962e7 by Ben Gamari at 2023-07-02T12:43:39-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - a84fa2c5 by Ben Gamari at 2023-07-02T12:43:39-04:00 testsuite: Add test for #23400 - - - - - 56436f23 by Ben Gamari at 2023-07-02T12:43:41-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - c5d0e396 by Ben Bellick at 2023-07-02T12:43:46-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 11e6e238 by Moisés Ackerman at 2023-07-02T12:43:51-04:00 Add failing test case for #23492 - - - - - 945238a6 by Moisés Ackerman at 2023-07-02T12:43:52-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 61bf5c99 by Moisés Ackerman at 2023-07-02T12:43:52-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 5ed3d2cc by Moisés Ackerman at 2023-07-02T12:43:52-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 82613f61 by Ryan Hendrickson at 2023-07-02T12:43:58-04:00 Add regression test for #23549 - - - - - 5cc42378 by Alexis King at 2023-07-02T12:44:08-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - ff563f93 by Bryan Richter at 2023-07-02T12:44:09-04:00 Add missing void prototypes to rts functions See #23561. - - - - - bfff5bd5 by Ben Gamari at 2023-07-02T12:44:09-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 793e03ac by Ben Gamari at 2023-07-02T12:44:10-04:00 testsuite: Update documentation - - - - - f75dae93 by Gregory Gerasev at 2023-07-02T12:44:14-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - c6affd96 by Dave Barton at 2023-07-02T12:44:18-04:00 Fix some broken links and typos - - - - - d301dcf2 by Ben Gamari at 2023-07-02T12:44:19-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21dc52c2f767550463f82e471022318bf5d64a3e...d301dcf22307396ea3b836a81b4532eb9c250f91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21dc52c2f767550463f82e471022318bf5d64a3e...d301dcf22307396ea3b836a81b4532eb9c250f91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:46:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:46:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1a9f5ae705_2e0e5b475902538aa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 017954bb by Torsten Schmits at 2023-07-02T12:46:01-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - a0f6e297 by Ben Gamari at 2023-07-02T12:46:02-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 33cf3a75 by Ben Gamari at 2023-07-02T12:46:02-04:00 testsuite: Add test for #23400 - - - - - 7cf3177f by Ben Gamari at 2023-07-02T12:46:04-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 36d835b6 by Ben Bellick at 2023-07-02T12:46:09-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - b15f5e1f by Moisés Ackerman at 2023-07-02T12:46:14-04:00 Add failing test case for #23492 - - - - - f83535e1 by Moisés Ackerman at 2023-07-02T12:46:14-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - df0ea8b8 by Moisés Ackerman at 2023-07-02T12:46:14-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 45ff9ad5 by Moisés Ackerman at 2023-07-02T12:46:14-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 8b43135c by Ryan Hendrickson at 2023-07-02T12:46:20-04:00 Add regression test for #23549 - - - - - b14a18fd by Alexis King at 2023-07-02T12:46:31-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - a1587406 by Bryan Richter at 2023-07-02T12:46:31-04:00 Add missing void prototypes to rts functions See #23561. - - - - - ccb40ed8 by Ben Gamari at 2023-07-02T12:46:32-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 4f9b6492 by Ben Gamari at 2023-07-02T12:46:32-04:00 testsuite: Update documentation - - - - - e8ee1de8 by Gregory Gerasev at 2023-07-02T12:46:37-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 9cdf5ade by Dave Barton at 2023-07-02T12:46:41-04:00 Fix some broken links and typos - - - - - b61002df by Ben Gamari at 2023-07-02T12:46:41-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d301dcf22307396ea3b836a81b4532eb9c250f91...b61002dfec55cc67e5cb0d9712c9de1d92cffca9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d301dcf22307396ea3b836a81b4532eb9c250f91...b61002dfec55cc67e5cb0d9712c9de1d92cffca9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 16:49:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 12:49:01 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1aa7d23f09_2e0e5b475402540d0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 35620992 by Torsten Schmits at 2023-07-02T12:48:16-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 47a3e000 by Ben Gamari at 2023-07-02T12:48:17-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 52aa3179 by Ben Gamari at 2023-07-02T12:48:17-04:00 testsuite: Add test for #23400 - - - - - ef0ddfba by Ben Gamari at 2023-07-02T12:48:19-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - d44dd512 by Ben Bellick at 2023-07-02T12:48:24-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6652e4c1 by Moisés Ackerman at 2023-07-02T12:48:29-04:00 Add failing test case for #23492 - - - - - 65eb6265 by Moisés Ackerman at 2023-07-02T12:48:29-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3be81154 by Moisés Ackerman at 2023-07-02T12:48:29-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - f3a19e98 by Moisés Ackerman at 2023-07-02T12:48:29-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0bb825ac by Ryan Hendrickson at 2023-07-02T12:48:35-04:00 Add regression test for #23549 - - - - - 387ddf2a by Alexis King at 2023-07-02T12:48:46-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - af9a8f79 by Bryan Richter at 2023-07-02T12:48:47-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 32cac00f by Ben Gamari at 2023-07-02T12:48:47-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - b0ee2acb by Ben Gamari at 2023-07-02T12:48:47-04:00 testsuite: Update documentation - - - - - 3d5b6226 by Gregory Gerasev at 2023-07-02T12:48:52-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 5880e86c by Dave Barton at 2023-07-02T12:48:56-04:00 Fix some broken links and typos - - - - - 9dbc0f0b by Ben Gamari at 2023-07-02T12:48:56-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b61002dfec55cc67e5cb0d9712c9de1d92cffca9...9dbc0f0b5c21ad44d1c34b7cc390d9f92aaee462 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b61002dfec55cc67e5cb0d9712c9de1d92cffca9...9dbc0f0b5c21ad44d1c34b7cc390d9f92aaee462 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 17:27:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 13:27:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1b38137b8b_2e0e5b475b8258557@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3d2a7203 by Torsten Schmits at 2023-07-02T13:26:42-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - a35ae2bf by Ben Gamari at 2023-07-02T13:26:43-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 8648e6ea by Ben Gamari at 2023-07-02T13:26:43-04:00 testsuite: Add test for #23400 - - - - - 7e139b5d by Ben Gamari at 2023-07-02T13:26:45-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 7078ed3a by Ben Bellick at 2023-07-02T13:26:50-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 063af48e by Moisés Ackerman at 2023-07-02T13:26:55-04:00 Add failing test case for #23492 - - - - - 435fa526 by Moisés Ackerman at 2023-07-02T13:26:55-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 627e5f72 by Moisés Ackerman at 2023-07-02T13:26:55-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - f199f4ab by Moisés Ackerman at 2023-07-02T13:26:55-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 297bb142 by Ryan Hendrickson at 2023-07-02T13:27:01-04:00 Add regression test for #23549 - - - - - b6555a22 by Alexis King at 2023-07-02T13:27:13-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - e7dbe9f0 by Bryan Richter at 2023-07-02T13:27:14-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 32daa67b by Ben Gamari at 2023-07-02T13:27:14-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 4484fad4 by Ben Gamari at 2023-07-02T13:27:15-04:00 testsuite: Update documentation - - - - - 836e4e2d by Gregory Gerasev at 2023-07-02T13:27:19-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 6f77bb49 by Dave Barton at 2023-07-02T13:27:23-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9dbc0f0b5c21ad44d1c34b7cc390d9f92aaee462...6f77bb49769967fa1e9df6c42bd374a9d65c3d47 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9dbc0f0b5c21ad44d1c34b7cc390d9f92aaee462...6f77bb49769967fa1e9df6c42bd374a9d65c3d47 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 17:29:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 13:29:49 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1b40d37bd_2e0e5b47504270724@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7e18baf9 by Torsten Schmits at 2023-07-02T13:29:00-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 2c06e13c by Ben Gamari at 2023-07-02T13:29:01-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 0a6b3926 by Ben Gamari at 2023-07-02T13:29:01-04:00 testsuite: Add test for #23400 - - - - - affa8c59 by Ben Gamari at 2023-07-02T13:29:03-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 4d507fee by Ben Bellick at 2023-07-02T13:29:08-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 915a32dd by Moisés Ackerman at 2023-07-02T13:29:13-04:00 Add failing test case for #23492 - - - - - a9d87120 by Moisés Ackerman at 2023-07-02T13:29:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 8fd10ef2 by Moisés Ackerman at 2023-07-02T13:29:14-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - 1d466de9 by Moisés Ackerman at 2023-07-02T13:29:14-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - e20bc66f by Ryan Hendrickson at 2023-07-02T13:29:20-04:00 Add regression test for #23549 - - - - - c974b62f by Alexis King at 2023-07-02T13:29:31-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 70c55a2f by Bryan Richter at 2023-07-02T13:29:31-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 749b7a75 by Ben Gamari at 2023-07-02T13:29:32-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - ae546853 by Ben Gamari at 2023-07-02T13:29:32-04:00 testsuite: Update documentation - - - - - 77407285 by Gregory Gerasev at 2023-07-02T13:29:37-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - cafea376 by Dave Barton at 2023-07-02T13:29:41-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f77bb49769967fa1e9df6c42bd374a9d65c3d47...cafea37659f66a4f05d0fbaafecaf3b54a4c03af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f77bb49769967fa1e9df6c42bd374a9d65c3d47...cafea37659f66a4f05d0fbaafecaf3b54a4c03af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 17:32:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 13:32:09 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1b499e4278_2e0e5b475cc2830c3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fe44a59b by Torsten Schmits at 2023-07-02T13:31:24-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 43a08369 by Ben Gamari at 2023-07-02T13:31:25-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 219a19d0 by Ben Gamari at 2023-07-02T13:31:25-04:00 testsuite: Add test for #23400 - - - - - ec963824 by Ben Gamari at 2023-07-02T13:31:27-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 5f930365 by Ben Bellick at 2023-07-02T13:31:31-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - f21eb7f9 by Moisés Ackerman at 2023-07-02T13:31:37-04:00 Add failing test case for #23492 - - - - - 4d79e2b8 by Moisés Ackerman at 2023-07-02T13:31:37-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - e362d3ce by Moisés Ackerman at 2023-07-02T13:31:37-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - a3cd2eb7 by Moisés Ackerman at 2023-07-02T13:31:37-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - c776a39a by Ryan Hendrickson at 2023-07-02T13:31:43-04:00 Add regression test for #23549 - - - - - 45400439 by Alexis King at 2023-07-02T13:31:54-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - c3293d0f by Bryan Richter at 2023-07-02T13:31:55-04:00 Add missing void prototypes to rts functions See #23561. - - - - - c7b6b10d by Ben Gamari at 2023-07-02T13:31:55-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 15331104 by Ben Gamari at 2023-07-02T13:31:56-04:00 testsuite: Update documentation - - - - - fdd4c53f by Gregory Gerasev at 2023-07-02T13:32:00-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 2234fb1f by Dave Barton at 2023-07-02T13:32:04-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cafea37659f66a4f05d0fbaafecaf3b54a4c03af...2234fb1f43a52045d1f61c8418a5a186c932a94c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cafea37659f66a4f05d0fbaafecaf3b54a4c03af...2234fb1f43a52045d1f61c8418a5a186c932a94c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 17:34:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 13:34:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1b52638d5_2e0e5b475f4297246@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 23172ba2 by Torsten Schmits at 2023-07-02T13:33:44-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fc9696e0 by Ben Gamari at 2023-07-02T13:33:45-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 6085754a by Ben Gamari at 2023-07-02T13:33:45-04:00 testsuite: Add test for #23400 - - - - - bb759a96 by Ben Gamari at 2023-07-02T13:33:47-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - f7e873fc by Ben Bellick at 2023-07-02T13:33:51-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 5cfc11e9 by Moisés Ackerman at 2023-07-02T13:33:57-04:00 Add failing test case for #23492 - - - - - 21490ca4 by Moisés Ackerman at 2023-07-02T13:33:57-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 43d245a0 by Moisés Ackerman at 2023-07-02T13:33:57-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - d47c3f35 by Moisés Ackerman at 2023-07-02T13:33:57-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 62127ae8 by Ryan Hendrickson at 2023-07-02T13:34:03-04:00 Add regression test for #23549 - - - - - 57b3db05 by Alexis King at 2023-07-02T13:34:14-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - cb8beeb0 by Bryan Richter at 2023-07-02T13:34:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 84811dab by Ben Gamari at 2023-07-02T13:34:15-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 5f5683ef by Ben Gamari at 2023-07-02T13:34:15-04:00 testsuite: Update documentation - - - - - d30a5cc0 by Gregory Gerasev at 2023-07-02T13:34:20-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 6043e23a by Dave Barton at 2023-07-02T13:34:24-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2234fb1f43a52045d1f61c8418a5a186c932a94c...6043e23a0518411246a6c07d8b80b81536ded7e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2234fb1f43a52045d1f61c8418a5a186c932a94c...6043e23a0518411246a6c07d8b80b81536ded7e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 17:36:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 13:36:48 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1b5b0d7fcb_2e0e5b474f0309463@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e377c16d by Torsten Schmits at 2023-07-02T13:36:03-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 60f14a17 by Ben Gamari at 2023-07-02T13:36:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 32483b5f by Ben Gamari at 2023-07-02T13:36:04-04:00 testsuite: Add test for #23400 - - - - - 6024ef16 by Ben Gamari at 2023-07-02T13:36:06-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 2a2db559 by Ben Bellick at 2023-07-02T13:36:11-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - b223939d by Moisés Ackerman at 2023-07-02T13:36:16-04:00 Add failing test case for #23492 - - - - - 70b61577 by Moisés Ackerman at 2023-07-02T13:36:16-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 276b5d93 by Moisés Ackerman at 2023-07-02T13:36:16-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - c833c4eb by Moisés Ackerman at 2023-07-02T13:36:16-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0dd538f2 by Ryan Hendrickson at 2023-07-02T13:36:22-04:00 Add regression test for #23549 - - - - - 7a45f47b by Alexis King at 2023-07-02T13:36:33-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 0004069b by Bryan Richter at 2023-07-02T13:36:34-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 129d9982 by Ben Gamari at 2023-07-02T13:36:34-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - e1cba71a by Ben Gamari at 2023-07-02T13:36:34-04:00 testsuite: Update documentation - - - - - 44766637 by Gregory Gerasev at 2023-07-02T13:36:39-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - c1bd77c5 by Dave Barton at 2023-07-02T13:36:43-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6043e23a0518411246a6c07d8b80b81536ded7e4...c1bd77c5cb00efac8eba8c6ffef76c2b0160db32 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6043e23a0518411246a6c07d8b80b81536ded7e4...c1bd77c5cb00efac8eba8c6ffef76c2b0160db32 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 17:40:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 13:40:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1b682933f_2e0e5b4752c3407e9@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 25917da8 by Torsten Schmits at 2023-07-02T13:38:21-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 1c6270b2 by Ben Gamari at 2023-07-02T13:38:23-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 50c84538 by Ben Gamari at 2023-07-02T13:38:23-04:00 testsuite: Add test for #23400 - - - - - 3a932d7a by Ben Gamari at 2023-07-02T13:38:25-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 20a8f3f6 by Ben Bellick at 2023-07-02T13:38:30-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - b10aaac1 by Moisés Ackerman at 2023-07-02T13:38:35-04:00 Add failing test case for #23492 - - - - - 6399554a by Moisés Ackerman at 2023-07-02T13:38:35-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 41f90316 by Moisés Ackerman at 2023-07-02T13:38:35-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dce4a2ad by Moisés Ackerman at 2023-07-02T13:38:35-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 013db137 by Ryan Hendrickson at 2023-07-02T13:38:41-04:00 Add regression test for #23549 - - - - - 6d49b435 by Alexis King at 2023-07-02T13:38:52-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - bf8d7df7 by Bryan Richter at 2023-07-02T13:38:52-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 03b74acc by Ben Gamari at 2023-07-02T13:38:53-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - f705bf2a by Ben Gamari at 2023-07-02T13:38:53-04:00 testsuite: Update documentation - - - - - 19c472a3 by Gregory Gerasev at 2023-07-02T13:38:58-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 9b1b98f7 by Dave Barton at 2023-07-02T13:39:02-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1bd77c5cb00efac8eba8c6ffef76c2b0160db32...9b1b98f7dcd1cb2f80d34e5a6f607d794b74fbe7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1bd77c5cb00efac8eba8c6ffef76c2b0160db32...9b1b98f7dcd1cb2f80d34e5a6f607d794b74fbe7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 17:45:57 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 02 Jul 2023 13:45:57 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Improve a little bit the mixing of Ids and ClassIds Message-ID: <64a1b7d55deb6_2e0e5b475043443ac@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: aebda191 by Rodrigo Mesquita at 2023-07-02T18:45:45+01:00 Improve a little bit the mixing of Ids and ClassIds - - - - - 8 changed files: - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/HsToCore/Errors/Ppr.hs ===================================== @@ -72,7 +72,8 @@ instance Diagnostic DsMessage where case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas - pp_tys = pprQuotedList $ map idType vars + -- pp_tys = pprQuotedList $ map idType vars + pp_tys = empty in hang (text "Patterns of type" <+> pp_tys <+> text "not matched:") 4 ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -20,6 +20,8 @@ import GHC.Types.Id import GHC.Types.Name (Name) import qualified GHC.LanguageExtensions as LangExt +import Data.Equality.Graph (ClassId) + import GHC.Generics (Generic) newtype MinBound = MinBound Integer @@ -99,7 +101,7 @@ data DsMessage | DsNonExhaustivePatterns !(HsMatchContext GhcRn) !ExhaustivityCheckType !MaxUncoveredPatterns - [Id] + [ClassId] [Nabla] | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -75,6 +75,8 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Coerce +import Data.Equality.Graph (ClassId) + -- -- * Exported entry points to the checker -- @@ -104,9 +106,10 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do !missing <- getLdiNablas pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) - result <- unCA (checkPatBind pat_bind) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportPatBind ctxt [var] result + result0 <- unCA (checkPatBind pat_bind) missing + tracePm "}: " (ppr (cr_uncov result0)) + let (varid, cr_uncov') = representId var (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -165,18 +168,20 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars empty_case <- noCheckDs $ desugarEmptyCase var - result <- unCA (checkEmptyCase empty_case) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportEmptyCase ctxt vars result + result0 <- unCA (checkEmptyCase empty_case) missing + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + formatReportWarnings ReportEmptyCase ctxt varids result0{cr_uncov=cr_uncov'} return [] Just matches -> do matches <- {-# SCC "desugarMatches" #-} noCheckDs $ desugarMatches vars matches - result <- {-# SCC "checkMatchGroup" #-} + result0 <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing - tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result - return (NE.toList (ldiMatchGroup (cr_ret result))) + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} + return (NE.toList (ldiMatchGroup (cr_ret result0))) {- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -340,7 +345,7 @@ collectInMode ReportEmptyCase = cirbsEmptyCase -- | Given a 'FormatReportWarningsMode', this function will emit warnings -- for a 'CheckResult'. -formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult ann -> DsM () +formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult ann -> DsM () formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do cov_info <- collectInMode report_mode ann dflags <- getDynFlags @@ -348,7 +353,7 @@ formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do -- | Issue all the warnings -- (redundancy, inaccessibility, exhaustiveness, redundant bangs). -reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () +reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult CIRB -> DsM () reportWarnings dflags report_mode (DsMatchContext kind loc) vars CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss , cirb_red = redundant_rhss @@ -387,14 +392,13 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars maxPatterns = maxUncoveredPatterns dflags -getNFirstUncovered :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nablas -> DsM [Nabla] getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - let (vars', nabla') = representIds vars nabla -- they're already there, we're just getting the e-class ids back - front <- generateInhabitingPatterns mode vars' n nabla' + front <- generateInhabitingPatterns mode vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -429,9 +433,10 @@ addTyCs origin ev_vars m = do -- to be added for multiple scrutinees rather than just one. addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k -addCoreScrutTmCs (scr:scrs) (x:xs) k = - flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas -> - addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) +addCoreScrutTmCs (scr:scrs) (x0:xs) k = + flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> + let (x, nablas) = representId x0 nablas0 + in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -103,9 +103,10 @@ emptyRedSets :: RedSets emptyRedSets = RedSets mempty mempty mempty checkGrd :: PmGrd -> CheckAction RedSets -checkGrd grd = CA $ \inc -> case grd of +checkGrd grd = CA $ \inc0 -> case grd of -- let x = e: Refine with x ~ e - PmLet x e -> do + PmLet x0 e -> do + let (x, inc) = representId x0 inc0 -- romes: we could potentially do update the trees to use e-class ids here, -- or in pmcMatches matched <- addPhiCtNablas inc (PhiCoreCt x e) @@ -114,7 +115,8 @@ checkGrd grd = CA $ \inc -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ - PmBang x mb_info -> do + PmBang x0 mb_info -> do + let (x, inc) = representId x0 inc0 div <- addPhiCtNablas inc (PhiBotCt x) matched <- addPhiCtNablas inc (PhiNotBotCt x) -- See Note [Dead bang patterns] @@ -133,7 +135,9 @@ checkGrd grd = CA $ \inc -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x con tvs dicts args -> do + PmCon x0 con tvs dicts args0 -> do + let (x, inc1) = representId x0 inc0 + let (args, inc) = representIds args0 inc1 !div <- if isPmAltConMatchStrict con then addPhiCtNablas inc (PhiBotCt x) else pure mempty @@ -181,7 +185,8 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPhiCtNablas inc (PhiNotBotCt var) + let (varid, inc') = representId var inc + unc <- addPhiCtNablas inc' (PhiNotBotCt varid) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -328,6 +328,11 @@ desugarEmptyCase var = pure PmEmptyCase { pe_var = var } -- | Desugar the non-empty 'Match'es of a 'MatchGroup'. -- -- Returns a desugared guard tree of guard expressions. +-- +-- These e-graphs have an equivalence class for each match-id in the guard +-- expression, and are required in the subsequent passes of the PMC +-- +-- Furthermore, the match-ids in the PmGrd expressions are e-class ids from said e-graph desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) -> DsM (PmMatchGroup Pre) desugarMatches vars matches = ===================================== compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -12,7 +12,6 @@ import GHC.Prelude import GHC.Data.List.Infinite (Infinite (..)) import qualified GHC.Data.List.Infinite as Inf import GHC.Types.Basic -import GHC.Types.Id import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Builtin.Types @@ -42,7 +41,7 @@ import qualified Data.IntMap as IM -- -- When the set of refutable shapes contains more than 3 elements, the -- additional elements are indicated by "...". -pprUncovered :: Nabla -> [Id] -> SDoc +pprUncovered :: Nabla -> [ClassId] -> SDoc pprUncovered nabla vas | IM.null refuts = fsep vec -- there are no refutations | otherwise = hang (fsep vec) 4 $ @@ -53,10 +52,9 @@ pprUncovered nabla vas -- precedence | [_] <- vas = topPrec | otherwise = appPrec - (vas',nabla') = representIds vas nabla - ppr_action = mapM (pprPmVar init_prec) vas' - (vec, renamings) = runPmPpr nabla' ppr_action - refuts = prettifyRefuts nabla' renamings + ppr_action = mapM (pprPmVar init_prec) vas + (vec, renamings) = runPmPpr nabla ppr_action + refuts = prettifyRefuts nabla renamings -- | Output refutable shapes of a variable in the form of @var is not one of {2, -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -105,8 +106,6 @@ import qualified Data.Equality.Graph as EG import Data.Bifunctor (second) import Data.Function ((&)) import qualified Data.IntSet as IS -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) -- -- * Main exports @@ -571,20 +570,20 @@ where you can find the solution in a perhaps more digestible format. data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". - | PhiCoreCt !Id !CoreExpr + | PhiCoreCt !ClassId !CoreExpr -- ^ @PhiCoreCt x e@ encodes "x ~ e", equating @x@ with the 'CoreExpr' @e at . - | PhiConCt !Id !PmAltCon ![TyVar] ![PredType] ![Id] + | PhiConCt !ClassId !PmAltCon ![TyVar] ![PredType] ![ClassId] -- ^ @PhiConCt x K tvs dicts ys@ encodes @K \@tvs dicts ys <- x@, matching @x@ -- against the 'PmAltCon' application @K \@tvs dicts ys@, binding @tvs@, -- @dicts@ and possibly unlifted fields @ys@ in the process. -- See Note [Strict fields and variables of unlifted type]. - | PhiNotConCt !Id !PmAltCon + | PhiNotConCt !ClassId !PmAltCon -- ^ @PhiNotConCt x K@ encodes "x ≁ K", asserting that @x@ can't be headed -- by @K at . - | PhiBotCt !Id + | PhiBotCt !ClassId -- ^ @PhiBotCt x@ encodes "x ~ ⊥", equating @x@ to ⊥. -- by @K at . - | PhiNotBotCt !Id + | PhiNotBotCt !ClassId -- ^ @PhiNotBotCt x y@ encodes "x ≁ ⊥", asserting that @x@ can't be ⊥. instance Outputable PhiCt where @@ -674,31 +673,25 @@ nameTyCt pred_ty = do -- 'addTyCts' before, through 'addPhiCts'. addPhiTmCt :: Nabla -> PhiCt -> MaybeT DsM Nabla addPhiTmCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition -addPhiTmCt nabla (PhiCoreCt x e) = let (xid, nabla') = representId x nabla - in addCoreCt nabla' xid e +addPhiTmCt nabla (PhiCoreCt x e) = addCoreCt nabla x e addPhiTmCt nabla (PhiConCt x con tvs dicts args) = do -- Case (1) of Note [Strict fields and variables of unlifted type] -- PhiConCt correspond to the higher-level φ constraints from the paper with -- bindings semantics. It disperses into lower-level δ constraints that the -- 'add*Ct' functions correspond to. nabla1 <- addTyCts nabla (listToBag dicts) - let (xid, nabla2) = representId x nabla1 - let (args_ids, nabla3) = representIds args nabla2 -- romes: here we could have something like (merge (add K arg_ids) x) -- or actually that should be done by addConCt? - nabla4 <- addConCt nabla3 xid con tvs args_ids - foldlM addNotBotCt nabla4 (filterUnliftedFields con (zip args_ids args)) -addPhiTmCt nabla (PhiNotConCt x con) = let (xid, nabla') = representId x nabla - in addNotConCt nabla' xid con -addPhiTmCt nabla (PhiBotCt x) = let (xid, nabla') = representId x nabla - in addBotCt nabla' xid -addPhiTmCt nabla (PhiNotBotCt x) = let (xid, nabla') = representId x nabla - in addNotBotCt nabla' xid - -filterUnliftedFields :: PmAltCon -> [(ClassId,Id)] -> [ClassId] -filterUnliftedFields con args = - [ arg_id | ((arg_id,arg), bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) - , isBanged bang || definitelyUnliftedType (idType arg) ] + nabla2 <- addConCt nabla1 x con tvs args + foldlM addNotBotCt nabla2 (filterUnliftedFields nabla2 con args) +addPhiTmCt nabla (PhiNotConCt x con) = addNotConCt nabla x con +addPhiTmCt nabla (PhiBotCt x) = addBotCt nabla x +addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x + +filterUnliftedFields :: Nabla -> PmAltCon -> [ClassId] -> [ClassId] +filterUnliftedFields nabla con args = + [ arg_id | (arg_id, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || definitelyUnliftedType (eclassType arg_id nabla) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about @@ -900,6 +893,7 @@ addCoreCt nabla x e = do where -- Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. + -- ROMES:TODO: Consider CoreExprF instead of CoreExpr already here? core_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon -- RM: Could this be done better with e-graphs? The whole newtype stuff @@ -924,18 +918,18 @@ addCoreCt nabla x e = do <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args | otherwise - = do - nabla' <- get - if + = equate_with_similar_expr x e + -- nabla' <- get + -- if -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') + -- ROMES:TODO: Can we fix this more easily with e-graphs? + -- x| Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') -- We don't consider DataCons flexible variables - -> modifyT (\nabla -> let (yid, nabla') = representId y nabla - in addVarCt nabla' x yid) - | otherwise + -- -> modifyT (\nabla -> addVarCt nabla' x y) + -- x| otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! - -> equate_with_similar_expr x e + -- -> equate_with_similar_expr x e where expr_ty = exprType e expr_in_scope = mkInScopeSet (exprFreeVars e) @@ -960,10 +954,9 @@ addCoreCt nabla x e = do bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) - xid <- StateT $ \nabla -> pure $ representId x nabla - core_expr xid e - pure xid + x <- StateT $ \nabla -> lift (mkPmMatchId (exprType e) nabla) + core_expr x e + pure x -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -1480,7 +1473,6 @@ instCompleteSet fuel nabla xid cs = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where vi = lookupVarInfo (nabla_tm_st nabla) xid - x = vi_id vi sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1504,8 +1496,8 @@ instCompleteSet fuel nabla xid cs let recur_not_con = do nabla' <- addNotConCt nabla xid (PmAltConLike con) go nabla' cons - (nabla <$ instCon fuel nabla x con) -- return the original nabla, not the - -- refined one! + (nabla <$ instCon fuel nabla xid con) -- return the original nabla, not the + -- refined one! <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. @@ -1566,11 +1558,11 @@ compareConLikeTestability (RealDataCon a) (RealDataCon b) = mconcat -- adding the proper constructor constraint. -- -- See Note [Instantiating a ConLike]. -instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla -instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do +instCon :: Int -> Nabla -> ClassId -> ConLike -> MaybeT DsM Nabla +instCon fuel nabla0 at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do let hdr what = "instCon " ++ show fuel ++ " " ++ what env <- dsGetFamInstEnvs - let match_ty = idType x + let match_ty = eclassType x nabla0 tracePm (hdr "{") $ ppr con <+> text "... <-" <+> ppr x <+> dcolon <+> ppr match_ty norm_match_ty <- normaliseSourceTypeWHNF ty_st match_ty @@ -1588,24 +1580,23 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma let gammas = substTheta sigma_ex (eqSpecPreds eq_spec ++ thetas) -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys - arg_ids <- mapM mkPmId field_tys' - let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids + (arg_ids, nabla1) <- runStateT (mapM (StateT @Nabla . mkPmMatchId) field_tys') nabla0 tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) ] -- (5) Finally add the new constructor constraint runMaybeT $ do -- Case (2) of Note [Strict fields and variables of unlifted type] let alt = PmAltConLike con - let branching_factor = length $ filterUnliftedFields alt (zip arg_class_ids arg_ids) + let branching_factor = length $ filterUnliftedFields nabla1 alt arg_ids let ct = PhiConCt x alt ex_tvs gammas arg_ids - nabla1 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ - addPhiTmCt nabla' ct + nabla2 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ + addPhiTmCt nabla1 ct -- See Note [Fuel for the inhabitation test] let new_fuel | branching_factor <= 1 = fuel @@ -1617,17 +1608,17 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) , ppr branching_factor , ppr new_fuel ] - nabla2 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla1) $ - inhabitationTest new_fuel (nabla_ty_st nabla') nabla1 - lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla2) - pure nabla2 + nabla3 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla2) $ + inhabitationTest new_fuel (nabla_ty_st nabla1) nabla2 + lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla3) + pure nabla3 Nothing -> do tracePm (hdr "(match_ty not instance of res_ty) }") empty - pure (Just nabla) -- Matching against match_ty failed. Inhabited! + pure (Just nabla0) -- Matching against match_ty failed. Inhabited! -- See Note [Instantiating a ConLike]. -- | @matchConLikeResTy _ _ ty K@ tries to match @ty@ against the result @@ -2036,12 +2027,11 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do - y <- lift $ mkPmId arg_ty - let (yid,nabla') = representId y nabla + (y,nabla') <- lift $ mkPmMatchId arg_ty nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] - instantiate_newtype_chain yid nabla'' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [y] + instantiate_newtype_chain y nabla'' dcs instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] @@ -2052,7 +2042,7 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do = generateInhabitingPatterns mode xs n nabla instantiate_cons x ty xs n nabla (cl:cls) = do -- The following line is where we call out to the inhabitationTest! - mb_nabla <- runMaybeT $ instCon 4 nabla (eclassMatchId x nabla) cl + mb_nabla <- runMaybeT $ instCon 4 nabla x cl tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (eclassType x nabla) , ppr ty , ppr cl @@ -2155,5 +2145,13 @@ eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) eclassType :: ClassId -> Nabla -> Type eclassType cid = idType . eclassMatchId cid - -- ROMES:TODO: When exactly to rebuild? + +-- | Generate a fresh class for matching, returning the class-id as the match-id +mkPmMatchId :: Type -> Nabla -> DsM (ClassId, Nabla) +mkPmMatchId ty (MkNabla tyst ts at TmSt{ts_facts = egr}) = do + x <- mkPmId ty -- romes:Todo: for now, we still use mkPmId to get an Id for emptyVarInfo, but we want to get rid of this too + let (xid, egr') = EG.newEClass (emptyVarInfo x) egr + return (xid, MkNabla tyst ts{ts_facts=egr'}) +{-# NOINLINE mkPmMatchId #-} -- We'll CPR deeply, that should be enough + ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -88,7 +88,7 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second) +import Data.Bifunctor (second, bimap) -- import GHC.Driver.Ppr @@ -318,7 +318,6 @@ emptyVarInfo x -- | @lookupVarInfo tms x@ tells what we know about 'x' --- romes:TODO: This will have a different type. I don't know what yet. -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? --- romes:TodO should return VarInfo rather than Maybe VarInfo lookupVarInfo :: TmState -> ClassId -> VarInfo lookupVarInfo (TmSt eg _) x -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. @@ -834,14 +833,15 @@ type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) instance Show VarInfo where show = showPprUnsafe . ppr -representId :: Id -> Nabla -> (ClassId, Nabla) +representId :: Id -> Nablas -> (ClassId, Nablas) -- Will need to justify this well -representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) +representId x (MkNablas nbs) = bimap (fromJust . headMaybe) MkNablas $ unzipBag $ mapBag go nbs where + go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) -representIds :: [Id] -> Nabla -> ([ClassId], Nabla) -representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs +representIds :: [Id] -> Nablas -> ([ClassId], Nablas) +representIds xs nablas = swap $ mapAccumL (\acc x -> swap $ representId x acc) nablas xs -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aebda191e9aa022eaabfde2ea6e18b7a524c7c2d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aebda191e9aa022eaabfde2ea6e18b7a524c7c2d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 18:08:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 02 Jul 2023 14:08:21 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a1bd1553ad7_3cb823474f08702e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8c8abc71 by Torsten Schmits at 2023-07-02T14:06:23-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 1f9671b4 by Ben Gamari at 2023-07-02T14:06:24-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 04d394aa by Ben Gamari at 2023-07-02T14:06:24-04:00 testsuite: Add test for #23400 - - - - - 16b43f57 by Ben Gamari at 2023-07-02T14:06:26-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 264cee38 by Ben Bellick at 2023-07-02T14:06:30-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - a512ea9d by Moisés Ackerman at 2023-07-02T14:06:36-04:00 Add failing test case for #23492 - - - - - e2ee05e8 by Moisés Ackerman at 2023-07-02T14:06:36-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3595067b by Moisés Ackerman at 2023-07-02T14:06:36-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - bdbdc86e by Moisés Ackerman at 2023-07-02T14:06:36-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 20e199e1 by Ryan Hendrickson at 2023-07-02T14:06:42-04:00 Add regression test for #23549 - - - - - 31a9fb75 by Alexis King at 2023-07-02T14:06:53-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 4fe714ba by Bryan Richter at 2023-07-02T14:06:53-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 9cbe87c0 by Ben Gamari at 2023-07-02T14:06:54-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 5f971833 by Ben Gamari at 2023-07-02T14:06:54-04:00 testsuite: Update documentation - - - - - 36843cea by Gregory Gerasev at 2023-07-02T14:06:59-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 43ca1f42 by Dave Barton at 2023-07-02T14:07:02-04:00 Fix some broken links and typos - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b1b98f7dcd1cb2f80d34e5a6f607d794b74fbe7...43ca1f4293e3215eb765630d616cb451250d8fd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b1b98f7dcd1cb2f80d34e5a6f607d794b74fbe7...43ca1f4293e3215eb765630d616cb451250d8fd5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 18:15:03 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 02 Jul 2023 14:15:03 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 2 commits: Drop SDFM module Message-ID: <64a1bea7af4f8_3cb8234764488880@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: b9692294 by Rodrigo Mesquita at 2023-07-02T19:14:24+01:00 Drop SDFM module - - - - - e5805849 by Rodrigo Mesquita at 2023-07-02T19:14:47+01:00 fixup! Add e-graphs submodule (hegg) - - - - - 6 changed files: - compiler/GHC/HsToCore/Pmc.hs - − compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in - libraries/hegg - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -108,7 +108,9 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result0 <- unCA (checkPatBind pat_bind) missing tracePm "}: " (ppr (cr_uncov result0)) - let (varid, cr_uncov') = representId var (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas + let (varid, cr_uncov') = representId var (cr_uncov result0) formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () ===================================== compiler/GHC/Types/Unique/SDFM.hs deleted ===================================== @@ -1,122 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ApplicativeDo #-} -{-# OPTIONS_GHC -Wall #-} - --- | Like a 'UniqDFM', but maintains equivalence classes of keys sharing the --- same entry. See 'UniqSDFM'. -module GHC.Types.Unique.SDFM ( - -- * Unique-keyed, /shared/, deterministic mappings - UniqSDFM, - - emptyUSDFM, - lookupUSDFM, - equateUSDFM, addToUSDFM, - traverseUSDFM - ) where - -import GHC.Prelude - -import GHC.Types.Unique -import GHC.Types.Unique.DFM -import GHC.Utils.Outputable - --- | Either @Indirect x@, meaning the value is represented by that of @x@, or --- an @Entry@ containing containing the actual value it represents. -data Shared key ele - = Indirect !key - | Entry !ele - --- | A 'UniqDFM' whose domain is /sets/ of 'Unique's, each of which share a --- common value of type @ele at . --- Every such set (\"equivalence class\") has a distinct representative --- 'Unique'. Supports merging the entries of multiple such sets in a union-find --- like fashion. --- --- An accurate model is that of @[(Set key, Maybe ele)]@: A finite mapping from --- sets of @key at s to possibly absent entries @ele@, where the sets don't overlap. --- Example: --- @ --- m = [({u1,u3}, Just ele1), ({u2}, Just ele2), ({u4,u7}, Nothing)] --- @ --- On this model we support the following main operations: --- --- * @'lookupUSDFM' m u3 == Just ele1@, @'lookupUSDFM' m u4 == Nothing@, --- @'lookupUSDFM' m u5 == Nothing at . --- * @'equateUSDFM' m u1 u3@ is a no-op, but --- @'equateUSDFM' m u1 u2@ merges @{u1,u3}@ and @{u2}@ to point to --- @Just ele2@ and returns the old entry of @{u1,u3}@, @Just ele1 at . --- * @'addToUSDFM' m u3 ele4@ sets the entry of @{u1,u3}@ to @Just ele4 at . --- --- As well as a few means for traversal/conversion to list. -newtype UniqSDFM key ele - = USDFM { unUSDFM :: UniqDFM key (Shared key ele) } - -emptyUSDFM :: UniqSDFM key ele -emptyUSDFM = USDFM emptyUDFM - -lookupReprAndEntryUSDFM :: Uniquable key => UniqSDFM key ele -> key -> (key, Maybe ele) -lookupReprAndEntryUSDFM (USDFM env) = go - where - go x = case lookupUDFM env x of - Nothing -> (x, Nothing) - Just (Indirect y) -> go y - Just (Entry ele) -> (x, Just ele) - --- | @lookupSUDFM env x@ looks up an entry for @x@, looking through all --- 'Indirect's until it finds a shared 'Entry'. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 == Just ele1 --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u4 == Nothing --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Nothing)] u2 == Nothing -lookupUSDFM :: Uniquable key => UniqSDFM key ele -> key -> Maybe ele -lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) - --- | @equateUSDFM env x y@ makes @x@ and @y@ point to the same entry, --- thereby merging @x@'s class with @y@'s. --- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be --- chosen as the new entry and @x@'s old entry will be returned. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> equateUSDFM [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) --- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) --- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) --- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) --- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? -equateUSDFM - :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) -equateUSDFM usdfm@(USDFM env) x y = - case (lu x, lu y) of - ((x', _) , (y', _)) - | getUnique x' == getUnique y' -> (Nothing, usdfm) -- nothing to do - ((x', _) , (y', Nothing)) -> (Nothing, set_indirect y' x') - ((x', mb_ex), (y', _)) -> (mb_ex, set_indirect x' y') - where - lu = lookupReprAndEntryUSDFM usdfm - set_indirect a b = USDFM $ addToUDFM env a (Indirect b) - --- | @addToUSDFM env x a@ sets the entry @x@ is associated with to @a@, --- thereby modifying its whole equivalence class. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> addToUSDFM [] u1 ele1 == [({u1}, Just ele1)] --- >>> addToUSDFM [({u1,u3}, Just ele1)] u3 ele2 == [({u1,u3}, Just ele2)] -addToUSDFM :: Uniquable key => UniqSDFM key ele -> key -> ele -> UniqSDFM key ele -addToUSDFM usdfm@(USDFM env) x v = - USDFM $ addToUDFM env (fst (lookupReprAndEntryUSDFM usdfm x)) (Entry v) - -traverseUSDFM :: forall key a b f. Applicative f => (a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b) -traverseUSDFM f = fmap (USDFM . listToUDFM_Directly) . traverse g . udfmToList . unUSDFM - where - g :: (Unique, Shared key a) -> f (Unique, Shared key b) - g (u, Indirect y) = pure (u,Indirect y) - g (u, Entry a) = do - a' <- f a - pure (u,Entry a') - -instance (Outputable key, Outputable ele) => Outputable (Shared key ele) where - ppr (Indirect x) = ppr x - ppr (Entry a) = ppr a - -instance (Outputable key, Outputable ele) => Outputable (UniqSDFM key ele) where - ppr (USDFM env) = ppr env ===================================== compiler/ghc.cabal.in ===================================== @@ -818,7 +818,6 @@ Library GHC.Types.Unique.FM GHC.Types.Unique.Map GHC.Types.Unique.MemoFun - GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit d2862ab93d0420841aae3b8436f27301814d61a0 +Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -248,7 +248,6 @@ GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Map -GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -255,7 +255,6 @@ GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Map -GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aebda191e9aa022eaabfde2ea6e18b7a524c7c2d...e5805849e7ab19349845054565274c1e54051b00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aebda191e9aa022eaabfde2ea6e18b7a524c7c2d...e5805849e7ab19349845054565274c1e54051b00 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 19:14:22 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 02 Jul 2023 15:14:22 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] tWeaks Message-ID: <64a1cc8e60f93_3cb82347554951fe@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: e04bab20 by Rodrigo Mesquita at 2023-07-02T20:14:17+01:00 tWeaks - - - - - 3 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Solver.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -7,6 +7,11 @@ module GHC.Core.Equality where +-- ROMES:TODO: +-- I think, for the particular usages of Core e-graphs, we can do much better +-- than this for equality. +-- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) + import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -110,6 +110,14 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do tracePm "}: " (ppr (cr_uncov result0)) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas + -- DESIGN:TODO: However, if we represent the variables while desugaring, we + -- would no longer need representId to represent VarF in the e-class, and can + -- instead do newEClass. This would further reduce allocations. + -- The reason why we can't do that currently is that on checkPatBind we'll + -- representIds, and when we represent them again in the next line, we want + -- them to match the ones we represented during checkPatBind. If we made + -- empty-eclasses, the representId on the next line wouldn't match the match + -- ids we defined in checkPatBind. let (varid, cr_uncov') = representId var (cr_uncov result0) formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -838,7 +838,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so case equate env x y of -- Add the constraints we had for x to y - -- See Note [Joining e-classes PMC] todo mention from joinA + -- See Note (TODO) Joining e-classes PMC] todo mention from joinA -- Now, here's a really tricky bit (TODO Write note, is it the one above?) -- Bc the joinA operation is unlawful, and because the makeA operation for -- expressions is also unlawful (sets the type to ()::(), mostly out of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e04bab20ab8cfcfdf2df8d557bd0af21ddb37b8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e04bab20ab8cfcfdf2df8d557bd0af21ddb37b8c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 21:41:19 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 02 Jul 2023 17:41:19 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Wibble: remove unused field Message-ID: <64a1eeff9fbe_3cb8234752c11822c@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: fe7f28f1 by Simon Peyton Jones at 2023-07-02T22:40:39+01:00 Wibble: remove unused field - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Env.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -630,7 +630,7 @@ setInScopeFromE. --------------------- zapSubstEnv :: SimplEnv -> SimplEnv -zapSubstEnv env@(SimplEnv { seMode = mode, seCallDepth = n }) +zapSubstEnv env@(SimplEnv { seCallDepth = n }) = env { seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv , seCallDepth = n+1 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe7f28f1c55115ec3b2289dd60e55372c8e14d5d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe7f28f1c55115ec3b2289dd60e55372c8e14d5d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 22:23:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 02 Jul 2023 18:23:49 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 2 commits: OK? Message-ID: <64a1f8f5b1c11_3cb8234755411926f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 0204d906 by Rodrigo Mesquita at 2023-07-02T23:23:01+01:00 OK? - - - - - ebaf87dc by Rodrigo Mesquita at 2023-07-02T23:23:31+01:00 Update submodule hegg - - - - - 0 changed files: Changes: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e04bab20ab8cfcfdf2df8d557bd0af21ddb37b8c...ebaf87dc732ac437b5f452c425456abe1895fdda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e04bab20ab8cfcfdf2df8d557bd0af21ddb37b8c...ebaf87dc732ac437b5f452c425456abe1895fdda You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 2 22:31:07 2023 From: gitlab at gitlab.haskell.org (Brandon Chinn (@brandonchinn178)) Date: Sun, 02 Jul 2023 18:31:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/full-version-macro-docs Message-ID: <64a1faab31e55_3cb8234752c119681@gitlab.mail> Brandon Chinn pushed new branch wip/full-version-macro-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/full-version-macro-docs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 00:34:51 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 02 Jul 2023 20:34:51 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 15 commits: Add e-graphs submodule (hegg) Message-ID: <64a217aaf153f_3cb823475b813127@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 435b3d8b by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Add e-graphs submodule (hegg) - - - - - b9753941 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Create Core.Equality module This module defines CoreExprF -- the base functor of CoreExpr, and equality and ordering operations on the debruijnized CoreExprF. Furthermore, it provides a function to represent a CoreExpr in an e-graph. This is a requirement to represent, reason about equality, and manipulate CoreExprs in e-graphs. E-graphs are going to be used in the pattern match checker (#19272), and potentially for type family rewriting (#TODO) -- amongst other oportunities that are unlocked by having them available. - - - - - f2423412 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Question - - - - - 0a7c6086 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Was going great until I started needing to thread ClassIds together with Ids. Ret-think this. - - - - - 584927f3 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 A solution with more lookups - - - - - de53fb4c by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Fixes to Pmc.Ppr module - - - - - 8d388828 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Wow, a lot (stage1) is working actually, without PMC errprs - - - - - ca3ef188 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 We're still not there yet. - - - - - 37e057e2 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 WiP - - - - - 940b9d44 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Add instances for debugging - - - - - d30c27f5 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Things that were broken due to unlawfulness of e-graph instances - - - - - 71836c72 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Scuffed merging without effects to salvage some information that might get lost in merging that happens outside of addVarCt - - - - - 88a82772 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Improve a little bit the mixing of Ids and ClassIds - - - - - 5b375081 by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 Drop SDFM module - - - - - 9d2039ee by Rodrigo Mesquita at 2023-07-03T01:34:10+01:00 tWeaks - - - - - 23 changed files: - .gitmodules - + compiler/GHC/Core/Equality.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/TyThing/Ppr.hs-boot - − compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/hegg - packages - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== .gitmodules ===================================== @@ -117,3 +117,6 @@ [submodule "utils/hpc"] path = utils/hpc url = https://gitlab.haskell.org/hpc/hpc-bin.git +[submodule "libraries/hegg"] + path = libraries/hegg + url = https://github.com/alt-romes/hegg.git ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -0,0 +1,384 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} + +module GHC.Core.Equality where + +-- ROMES:TODO: +-- I think, for the particular usages of Core e-graphs, we can do much better +-- than this for equality. +-- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) + +import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) +import GHC.Prelude + +import GHC.Core +import GHC.Core.TyCo.Rep +import GHC.Core.Map.Type +import GHC.Core.Map.Expr +import GHC.Types.Var +import GHC.Types.Literal +import GHC.Types.Tickish +import Unsafe.Coerce (unsafeCoerce) + +import Control.Monad.Trans.State.Strict (state) +import Data.Equality.Graph as EG +import Data.Equality.Analysis +import qualified Data.Equality.Graph.Monad as EGM +import Data.Equality.Utils (Fix(..)) + +import GHC.Utils.Misc (all2) +import GHC.Utils.Outputable +import GHC.Core.Coercion (coercionType) + +-- Important to note the binders are also represented by $a$ +-- This is because in the e-graph we will represent binders with the +-- equivalence class id of things equivalent to it. +-- +-- Unfortunately type binders are still not correctly accounted for. +-- Perhaps it'd really be better to make DeBruijn work over these types + +data AltF b a + = AltF AltCon [b] a + deriving (Functor, Foldable, Traversable) + +data BindF b a + = NonRecF b a + | RecF [(b, a)] + deriving (Functor, Foldable, Traversable) + +data ExprF b a + = VarF Id + | LitF Literal + | AppF a a + | LamF b a + | LetF (BindF b a) a + | CaseF a b Type [AltF b a] + + | CastF a CoercionR + | TickF CoreTickish a + | TypeF Type + | CoercionF Coercion + deriving (Functor, Foldable, Traversable) + +type CoreExprF + = ExprF CoreBndr +type CoreAltF + = AltF CoreBndr +type CoreBindF + = BindF CoreBndr + +newtype DeBruijnF f a = DF (DeBruijn (f a)) + deriving (Functor, Foldable, Traversable) + +eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where + go :: CoreExprF a -> CoreExprF a -> Bool + go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) + go (LitF lit1) (LitF lit2) = lit1 == lit2 + go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) + -- See Note [Alpha-equality for Coercion arguments] + go (CoercionF {}) (CoercionF {}) = True + go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 + go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 + go (TickF n1 e1) (TickF n2 e2) + = eqDeBruijnTickish (D env1 n1) (D env2 n2) + && e1 == e2 + + go (LamF b1 e1) (LamF b2 e2) + = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) + && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) + && e1 == e2 + + go (LetF abs e1) (LetF bbs e2) + = D env1 abs == D env2 bbs + && e1 == e2 + + go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) + | null a1 -- See Note [Empty case alternatives] + = null a2 && e1 == e2 && D env1 t1 == D env2 t2 + | otherwise + = e1 == e2 && D env1 a1 == D env2 a2 + + go _ _ = False + +-- ROMES:TODO: This one can be derived automatically, but perhaps it's better +-- to be explicit here? We don't even really require the DeBruijn context here +eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where + go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) + = rhs1 == rhs2 + go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) + = lit1 == lit2 && rhs1 == rhs2 + go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) + = dc1 == dc2 && + rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') + go _ _ = False + +-- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +fromCoreExpr :: CoreExpr -> Fix CoreExprF +fromCoreExpr = unsafeCoerce + +toCoreExpr :: CoreExpr -> Fix CoreExprF +toCoreExpr = unsafeCoerce + +-- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +-- +-- Always represent Ids, at least for now. We're seemingly using inexistent ids +-- ROMES:TODO: do this all inside EGraphM instead +representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreExpr + -> EGraph a (DeBruijnF CoreExprF) + -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBCoreExpr (D cmenv expr) eg0 = case expr of + Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 + Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 + Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 + Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 + Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (CastF eid co))) eg1 + App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 + (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 + in add (Node $ DF (D cmenv (AppF fid aid))) eg2 + Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (TickF n eid))) eg1 + Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 + in add (Node $ DF (D cmenv (LamF b eid))) eg1 + Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 + (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 + in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 + Let (Rec (unzip -> (bs,rs))) e -> + let cmenv' = extendCMEs cmenv bs + (bsids, eg1) = EGM.runEGraphM eg0 $ + traverse (state . representDBCoreExpr . D cmenv') rs + (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 + in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 + Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 + (as', eg2) = EGM.runEGraphM eg1 $ + traverse (state . representDBAltExpr . D (extendCME cmenv b)) as + in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 + +representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreAlt + -> EGraph a (DeBruijnF CoreExprF) + -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBAltExpr (D cm (Alt cons bs a)) eg0 = + let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 + in (AltF cons bs ai, eg1) + +instance Eq a => Eq (DeBruijn (CoreAltF a)) where + (==) = eqDeBruijnAltF + +instance Eq a => Eq (DeBruijn (CoreExprF a)) where + (==) = eqDeBruijnExprF + +instance Eq a => Eq (DeBruijnF CoreExprF a) where + (==) (DF a) (DF b) = eqDeBruijnExprF a b + +instance Eq a => Eq (DeBruijnF CoreAltF a) where + (==) (DF a) (DF b) = eqDeBruijnAltF a b + +deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +instance Ord a => Ord (DeBruijn (CoreExprF a)) where + -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. + -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? + -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. + -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? + -- So I think that just works... + -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... + compare a b + = case a of + D cma (VarF va) + -> case b of + D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) + _ -> LT + D _ (LitF la) + -> case b of + D _ VarF{} -> GT + D _ (LitF lb) -> la `compare` lb + _ -> LT + D _ (AppF af aarg) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 2#) then + LT + else + case b of + D _ (AppF bf barg) + -> case compare af bf of + LT -> LT + EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. + -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... + GT -> GT + _ -> GT + D _ (LamF _abind abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 3#) then + LT + else + case b of + D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') + -> compare abody bbody + _ -> GT + D cma (LetF as abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 4#) then + LT + else + case b of + D cmb (LetF bs bbody) + -> case compare (D cma as) (D cmb bs) of + LT -> LT + EQ -> compare abody bbody + GT -> GT + _ -> GT + D cma (CaseF cax _cabind catype caalt) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 5#) then + GT + else + case b of + D cmb (CaseF cbx _cbbind cbtype cbalt) + -> case compare cax cbx of + LT -> LT + -- ROMES:TODO: Consider changing order of comparisons to a more efficient one + EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of + LT -> LT + EQ -> D cma caalt `compare` D cmb cbalt + GT -> GT + GT -> GT + _ -> LT + D cma (CastF cax caco) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 6#) then + GT + else + case b of + D cmb (CastF cbx cbco) + -> case compare cax cbx of + LT -> LT + EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) + GT -> GT + _ -> LT + D cma (TickF tatickish tax) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 7#) then + GT + else + case b of + D cmb (TickF tbtickish tbx) + -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of + LT -> LT + EQ -> tax `compare` tbx + GT -> GT + _ -> LT + D cma (TypeF at) + -> case b of + D _ CoercionF{} -> LT + D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) + _ -> GT + D cma (CoercionF aco) + -> case b of + D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) + _ -> GT + +instance Eq a => Eq (DeBruijn (CoreBindF a)) where + D cma a == D cmb b = go a b where + go (NonRecF _v1 r1) (NonRecF _v2 r2) + = r1 == r2 -- See Note [Alpha-equality for let-bindings] + + go (RecF ps1) (RecF ps2) + = + -- See Note [Alpha-equality for let-bindings] + all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) + (D cmb (varType b2))) + bs1 bs2 + && rs1 == rs2 + where + (bs1,rs1) = unzip ps1 + (bs2,rs2) = unzip ps2 + + go _ _ = False + + +instance Ord a => Ord (DeBruijn (CoreBindF a)) where + compare a b + = case a of + D _cma (NonRecF _ab ax) + -> case b of + D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. + -> ax `compare` bx + _ -> LT + D _cma (RecF as) + -> case b of + D _cmb (RecF bs) -> compare (map snd as) (map snd bs) + _ -> GT + + +instance Ord a => Ord (DeBruijn (CoreAltF a)) where + compare a b + = case a of + D _cma (AltF ac _abs arhs) + -> case b of + D _cmb (AltF bc _bbs brhs) + -> case compare ac bc of + LT -> LT + EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. + arhs `compare` brhs + GT -> GT + +cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering +cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where + go (Breakpoint lext lid lids) (Breakpoint rext rid rids) + = case compare lid rid of + LT -> LT + EQ -> case compare (D env1 lids) (D env2 rids) of + LT -> LT + EQ -> compare lext rext + GT -> GT + GT -> GT + go l r = compare l r + +cmpDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Ordering +cmpDeBruijnType d1@(D _ t1) d2@(D _ t2) + = if eqDeBruijnType d1 d2 + then EQ + -- ROMES:TODO: Is this OK? + else compare (showPprUnsafe t1) (showPprUnsafe t2) + +cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering +cmpDeBruijnCoercion (D env1 co1) (D env2 co2) + = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) + +-- instances for debugging purposes +instance Show a => Show (DeBruijnF CoreExprF a) where + show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id + show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit + show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b + show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a + show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a + show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts + + show (DF (D _ (CastF _a _cor) )) = "CastF" + show (DF (D _ (TickF _cotick _a))) = "Tick" + show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t) + show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co + + +instance Show a => Show (BindF CoreBndr a) where + show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a + show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs) + +instance Show a => Show (AltF CoreBndr a) where + show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a + + ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -18,6 +18,8 @@ module GHC.Core.Map.Expr ( CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, -- * Alpha equality eqDeBruijnExpr, eqCoreExpr, + -- ** Exports for CoreExprF instances + eqDeBruijnTickish, eqDeBruijnVar, -- * 'TrieMap' class reexports TrieMap(..), insertTM, deleteTM, lkDFreeVar, xtDFreeVar, ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveTraversable #-} module GHC.Core.Map.Type ( -- * Re-export generic interface @@ -16,12 +17,13 @@ module GHC.Core.Map.Type ( LooseTypeMap, -- ** With explicit scoping CmEnv, lookupCME, extendTypeMapWithScope, lookupTypeMapWithScope, - mkDeBruijnContext, extendCME, extendCMEs, emptyCME, + mkDeBruijnContext, extendCME, extendCMEs, emptyCME, sizeCME, -- * Utilities for use by friends only TypeMapG, CoercionMapG, DeBruijn(..), deBruijnize, eqDeBruijnType, eqDeBruijnVar, + cmpDeBruijnVar, BndrMap, xtBndr, lkBndr, VarMap, xtVar, lkVar, lkDFreeVar, xtDFreeVar, @@ -282,6 +284,9 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) = instance Eq (DeBruijn Var) where (==) = eqDeBruijnVar +instance Ord (DeBruijn Var) where + compare = cmpDeBruijnVar + eqDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Bool eqDeBruijnVar (D env1 v1) (D env2 v2) = case (lookupCME env1 v1, lookupCME env2 v2) of @@ -289,6 +294,13 @@ eqDeBruijnVar (D env1 v1) (D env2 v2) = (Nothing, Nothing) -> v1 == v2 _ -> False +cmpDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Ordering +cmpDeBruijnVar (D env1 v1) (D env2 v2) = + case (lookupCME env1 v1, lookupCME env2 v2) of + (Just b1, Just b2) -> compare b1 b2 + (Nothing, Nothing) -> compare v1 v2 + (z,w) -> compare z w -- Compare Maybes on whether they're Just or Nothing + instance {-# OVERLAPPING #-} Outputable a => Outputable (TypeMapG a) where ppr m = text "TypeMap elts" <+> ppr (foldTM (:) m []) @@ -505,6 +517,10 @@ extendCMEs env vs = foldl' extendCME env vs lookupCME :: CmEnv -> Var -> Maybe BoundVar lookupCME (CME { cme_env = env }) v = lookupVarEnv env v +-- | \(O(1)\). Number of elements in the CmEnv. +sizeCME :: CmEnv -> Int +sizeCME CME{cme_next=next} = next + -- | @DeBruijn a@ represents @a@ modulo alpha-renaming. This is achieved -- by equipping the value with a 'CmEnv', which tracks an on-the-fly deBruijn -- numbering. This allows us to define an 'Eq' instance for @DeBruijn a@, even @@ -512,6 +528,7 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v -- export the constructor. Make a helper function if you find yourself -- needing it. data DeBruijn a = D CmEnv a + deriving (Functor, Foldable, Traversable) -- romes:TODO: for internal use only! -- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no -- bound binders (an empty 'CmEnv'). This is usually what you want if there @@ -525,6 +542,15 @@ instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where D env xs == D env' xs' _ == _ = False +instance Ord (DeBruijn a) => Ord (DeBruijn [a]) where + D _ [] `compare` D _ [] = EQ + D env (x:xs) `compare` D env' (x':xs') = case D env x `compare` D env' x' of + LT -> LT + EQ -> D env xs `compare` D env' xs' + GT -> GT + D _ [] `compare` D _ (_:_) = LT + D _ (_:_) `compare` D _ [] = GT + instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where D _ Nothing == D _ Nothing = True D env (Just x) == D env' (Just x') = D env x == D env' x' ===================================== compiler/GHC/HsToCore/Errors/Ppr.hs ===================================== @@ -72,7 +72,8 @@ instance Diagnostic DsMessage where case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas - pp_tys = pprQuotedList $ map idType vars + -- pp_tys = pprQuotedList $ map idType vars + pp_tys = empty in hang (text "Patterns of type" <+> pp_tys <+> text "not matched:") 4 ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -20,6 +20,8 @@ import GHC.Types.Id import GHC.Types.Name (Name) import qualified GHC.LanguageExtensions as LangExt +import Data.Equality.Graph (ClassId) + import GHC.Generics (Generic) newtype MinBound = MinBound Integer @@ -99,7 +101,7 @@ data DsMessage | DsNonExhaustivePatterns !(HsMatchContext GhcRn) !ExhaustivityCheckType !MaxUncoveredPatterns - [Id] + [ClassId] [Nabla] | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -75,6 +75,8 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Coerce +import Data.Equality.Graph (ClassId) + -- -- * Exported entry points to the checker -- @@ -104,9 +106,20 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do !missing <- getLdiNablas pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) - result <- unCA (checkPatBind pat_bind) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportPatBind ctxt [var] result + result0 <- unCA (checkPatBind pat_bind) missing + tracePm "}: " (ppr (cr_uncov result0)) + -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas + -- DESIGN:TODO: However, if we represent the variables while desugaring, we + -- would no longer need representId to represent VarF in the e-class, and can + -- instead do newEClass. This would further reduce allocations. + -- The reason why we can't do that currently is that on checkPatBind we'll + -- representIds, and when we represent them again in the next line, we want + -- them to match the ones we represented during checkPatBind. If we made + -- empty-eclasses, the representId on the next line wouldn't match the match + -- ids we defined in checkPatBind. + let (varid, cr_uncov') = representId var (cr_uncov result0) + formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -165,18 +178,20 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars empty_case <- noCheckDs $ desugarEmptyCase var - result <- unCA (checkEmptyCase empty_case) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportEmptyCase ctxt vars result + result0 <- unCA (checkEmptyCase empty_case) missing + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + formatReportWarnings ReportEmptyCase ctxt varids result0{cr_uncov=cr_uncov'} return [] Just matches -> do matches <- {-# SCC "desugarMatches" #-} noCheckDs $ desugarMatches vars matches - result <- {-# SCC "checkMatchGroup" #-} + result0 <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing - tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result - return (NE.toList (ldiMatchGroup (cr_ret result))) + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} + return (NE.toList (ldiMatchGroup (cr_ret result0))) {- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -340,7 +355,7 @@ collectInMode ReportEmptyCase = cirbsEmptyCase -- | Given a 'FormatReportWarningsMode', this function will emit warnings -- for a 'CheckResult'. -formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult ann -> DsM () +formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult ann -> DsM () formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do cov_info <- collectInMode report_mode ann dflags <- getDynFlags @@ -348,7 +363,7 @@ formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do -- | Issue all the warnings -- (redundancy, inaccessibility, exhaustiveness, redundant bangs). -reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () +reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult CIRB -> DsM () reportWarnings dflags report_mode (DsMatchContext kind loc) vars CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss , cirb_red = redundant_rhss @@ -387,7 +402,7 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars maxPatterns = maxUncoveredPatterns dflags -getNFirstUncovered :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nablas -> DsM [Nabla] getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] @@ -428,9 +443,10 @@ addTyCs origin ev_vars m = do -- to be added for multiple scrutinees rather than just one. addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k -addCoreScrutTmCs (scr:scrs) (x:xs) k = - flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas -> - addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) +addCoreScrutTmCs (scr:scrs) (x0:xs) k = + flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> + let (x, nablas) = representId x0 nablas0 + in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -103,16 +103,20 @@ emptyRedSets :: RedSets emptyRedSets = RedSets mempty mempty mempty checkGrd :: PmGrd -> CheckAction RedSets -checkGrd grd = CA $ \inc -> case grd of +checkGrd grd = CA $ \inc0 -> case grd of -- let x = e: Refine with x ~ e - PmLet x e -> do + PmLet x0 e -> do + let (x, inc) = representId x0 inc0 + -- romes: we could potentially do update the trees to use e-class ids here, + -- or in pmcMatches matched <- addPhiCtNablas inc (PhiCoreCt x e) tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ - PmBang x mb_info -> do + PmBang x0 mb_info -> do + let (x, inc) = representId x0 inc0 div <- addPhiCtNablas inc (PhiBotCt x) matched <- addPhiCtNablas inc (PhiNotBotCt x) -- See Note [Dead bang patterns] @@ -131,7 +135,9 @@ checkGrd grd = CA $ \inc -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x con tvs dicts args -> do + PmCon x0 con tvs dicts args0 -> do + let (x, inc1) = representId x0 inc0 + let (args, inc) = representIds args0 inc1 !div <- if isPmAltConMatchStrict con then addPhiCtNablas inc (PhiBotCt x) else pure mempty @@ -179,10 +185,11 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPhiCtNablas inc (PhiNotBotCt var) + let (varid, inc') = representId var inc + unc <- addPhiCtNablas inc' (PhiNotBotCt varid) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } -checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) +checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) checkPatBind = coerce checkGRHS {- Note [Checking EmptyCase] ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -326,6 +326,13 @@ desugarEmptyCase :: Id -> DsM PmEmptyCase desugarEmptyCase var = pure PmEmptyCase { pe_var = var } -- | Desugar the non-empty 'Match'es of a 'MatchGroup'. +-- +-- Returns a desugared guard tree of guard expressions. +-- +-- These e-graphs have an equivalence class for each match-id in the guard +-- expression, and are required in the subsequent passes of the PMC +-- +-- Furthermore, the match-ids in the PmGrd expressions are e-class ids from said e-graph desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) -> DsM (PmMatchGroup Pre) desugarMatches vars matches = ===================================== compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -12,9 +12,6 @@ import GHC.Prelude import GHC.Data.List.Infinite (Infinite (..)) import qualified GHC.Data.List.Infinite as Inf import GHC.Types.Basic -import GHC.Types.Id -import GHC.Types.Var.Env -import GHC.Types.Unique.DFM import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Builtin.Types @@ -27,6 +24,10 @@ import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import GHC.HsToCore.Pmc.Types +import Data.Equality.Graph (ClassId) +import Data.IntMap (IntMap) +import qualified Data.IntMap as IM + -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its -- components and refutable shapes associated to any mentioned variables. -- @@ -40,11 +41,11 @@ import GHC.HsToCore.Pmc.Types -- -- When the set of refutable shapes contains more than 3 elements, the -- additional elements are indicated by "...". -pprUncovered :: Nabla -> [Id] -> SDoc +pprUncovered :: Nabla -> [ClassId] -> SDoc pprUncovered nabla vas - | isNullUDFM refuts = fsep vec -- there are no refutations - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map (pprRefutableShapes . snd) (udfmToList refuts)) + | IM.null refuts = fsep vec -- there are no refutations + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map (pprRefutableShapes . snd) (IM.toList refuts)) where init_prec -- No outer parentheses when it's a unary pattern by assuming lowest @@ -96,35 +97,37 @@ substitution to the vectors before printing them out (see function `pprOne' in -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Nabla -> DIdEnv (Id, SDoc) -> DIdEnv (SDoc, [PmAltCon]) -prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList +prettifyRefuts :: Nabla -> IntMap (ClassId, SDoc) -> IntMap (SDoc, [PmAltCon]) +prettifyRefuts nabla = IM.mapWithKey attach_refuts where - attach_refuts (u, (x, sdoc)) = (u, (sdoc, lookupRefuts nabla x)) + -- RM: why map with key? + attach_refuts :: ClassId -> (ClassId, SDoc) -> (SDoc, [PmAltCon]) + attach_refuts _u (x, sdoc) = (sdoc, lookupRefuts nabla x) -type PmPprM a = RWS Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) a +type PmPprM a = RWS Nabla () (IntMap (ClassId, SDoc), Infinite SDoc) a -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: Infinite SDoc nameList = map text ["p","q","r","s","t"] Inf.++ flip Inf.unfoldr (0 :: Int) (\ u -> (text ('t':show u), u+1)) -runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc)) -runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of +runPmPpr :: Nabla -> PmPprM a -> (a, IntMap (ClassId, SDoc)) +runPmPpr nabla m = case runRWS m nabla (IM.empty, nameList) of (a, (renamings, _), _) -> (a, renamings) -- | Allocates a new, clean name for the given 'Id' if it doesn't already have -- one. -getCleanName :: Id -> PmPprM SDoc +getCleanName :: ClassId -> PmPprM SDoc getCleanName x = do (renamings, name_supply) <- get let Inf clean_name name_supply' = name_supply - case lookupDVarEnv renamings x of + case IM.lookup x renamings of Just (_, nm) -> pure nm Nothing -> do - put (extendDVarEnv renamings x (x, clean_name), name_supply') + put (IM.insert x (x, clean_name) renamings, name_supply') pure clean_name -checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached +checkRefuts :: ClassId -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached checkRefuts x = do nabla <- ask case lookupRefuts nabla x of @@ -134,20 +137,20 @@ checkRefuts x = do -- | Pretty print a variable, but remember to prettify the names of the variables -- that refer to neg-literals. The ones that cannot be shown are printed as -- underscores. -pprPmVar :: PprPrec -> Id -> PmPprM SDoc +pprPmVar :: PprPrec -> ClassId -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of Just (PACA alt _tvs args) -> pprPmAltCon prec alt args Nothing -> fromMaybe underscore <$> checkRefuts x -pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc +pprPmAltCon :: PprPrec -> PmAltCon -> [ClassId] -> PmPprM SDoc pprPmAltCon _prec (PmAltLit l) _ = pure (ppr l) pprPmAltCon prec (PmAltConLike cl) args = do nabla <- ask pprConLike nabla prec cl args -pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc +pprConLike :: Nabla -> PprPrec -> ConLike -> [ClassId] -> PmPprM SDoc pprConLike nabla _prec cl args | Just pm_expr_list <- pmExprAsList nabla (PmAltConLike cl) args = case pm_expr_list of @@ -174,8 +177,8 @@ pprConLike _nabla prec cl args -- | The result of 'pmExprAsList'. data PmExprList - = NilTerminated [Id] - | WcVarTerminated (NonEmpty Id) Id + = NilTerminated [ClassId] + | WcVarTerminated (NonEmpty ClassId) ClassId -- | Extract a list of 'Id's out of a sequence of cons cells, optionally -- terminated by a wildcard variable instead of @[]@. Some examples: @@ -186,7 +189,7 @@ data PmExprList -- ending in a wildcard variable x (of list type). Should be pretty-printed as -- (1:2:_). -- * @pmExprAsList [] == Just ('NilTerminated' [])@ -pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList +pmExprAsList :: Nabla -> PmAltCon -> [ClassId] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -1,4 +1,6 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -49,18 +51,17 @@ import GHC.Data.Bag import GHC.Types.CompleteMatch import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) import GHC.Types.Var.Env -import GHC.Types.Var.Set import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type +import GHC.Core.Equality import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) import GHC.Core.Utils (exprType) @@ -99,6 +100,13 @@ import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) +import Data.Equality.Graph (ClassId) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.Bifunctor (second) +import Data.Function ((&)) +import qualified Data.IntSet as IS + -- -- * Main exports -- @@ -556,23 +564,26 @@ where you can find the solution in a perhaps more digestible format. -- | A high-level pattern-match constraint. Corresponds to φ from Figure 3 of -- the LYG paper. +-- ROMES:TODO: Ultimately, all these Ids could be replaced by e-class ids which +-- are generated during desugaring, but there are some details to it +-- (propagating the e-graphs in which these e-classes were created) data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". - | PhiCoreCt !Id !CoreExpr + | PhiCoreCt !ClassId !CoreExpr -- ^ @PhiCoreCt x e@ encodes "x ~ e", equating @x@ with the 'CoreExpr' @e at . - | PhiConCt !Id !PmAltCon ![TyVar] ![PredType] ![Id] + | PhiConCt !ClassId !PmAltCon ![TyVar] ![PredType] ![ClassId] -- ^ @PhiConCt x K tvs dicts ys@ encodes @K \@tvs dicts ys <- x@, matching @x@ -- against the 'PmAltCon' application @K \@tvs dicts ys@, binding @tvs@, -- @dicts@ and possibly unlifted fields @ys@ in the process. -- See Note [Strict fields and variables of unlifted type]. - | PhiNotConCt !Id !PmAltCon + | PhiNotConCt !ClassId !PmAltCon -- ^ @PhiNotConCt x K@ encodes "x ≁ K", asserting that @x@ can't be headed -- by @K at . - | PhiBotCt !Id + | PhiBotCt !ClassId -- ^ @PhiBotCt x@ encodes "x ~ ⊥", equating @x@ to ⊥. -- by @K at . - | PhiNotBotCt !Id + | PhiNotBotCt !ClassId -- ^ @PhiNotBotCt x y@ encodes "x ≁ ⊥", asserting that @x@ can't be ⊥. instance Outputable PhiCt where @@ -668,68 +679,71 @@ addPhiTmCt nabla (PhiConCt x con tvs dicts args) = do -- PhiConCt correspond to the higher-level φ constraints from the paper with -- bindings semantics. It disperses into lower-level δ constraints that the -- 'add*Ct' functions correspond to. - nabla' <- addTyCts nabla (listToBag dicts) - nabla'' <- addConCt nabla' x con tvs args - foldlM addNotBotCt nabla'' (filterUnliftedFields con args) + nabla1 <- addTyCts nabla (listToBag dicts) + -- romes: here we could have something like (merge (add K arg_ids) x) + -- or actually that should be done by addConCt? + nabla2 <- addConCt nabla1 x con tvs args + foldlM addNotBotCt nabla2 (filterUnliftedFields nabla2 con args) addPhiTmCt nabla (PhiNotConCt x con) = addNotConCt nabla x con addPhiTmCt nabla (PhiBotCt x) = addBotCt nabla x addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x -filterUnliftedFields :: PmAltCon -> [Id] -> [Id] -filterUnliftedFields con args = - [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) - , isBanged bang || definitelyUnliftedType (idType arg) ] +filterUnliftedFields :: Nabla -> PmAltCon -> [ClassId] -> [ClassId] +filterUnliftedFields nabla con args = + [ arg_id | (arg_id, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || definitelyUnliftedType (eclassType arg_id nabla) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about -- ⊥. -addBotCt :: Nabla -> Id -> MaybeT DsM Nabla -addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do - MaybeBot -- We add x ~ ⊥ - | definitelyUnliftedType (idType x) - -- Case (3) in Note [Strict fields and variables of unlifted type] - -> mzero -- unlifted vars can never be ⊥ - | otherwise - -> do - let vi' = vi{ vi_bot = IsBot } - pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } +addBotCt :: Nabla -> ClassId -> MaybeT DsM Nabla +addBotCt nabla x = updateVarInfo x go nabla + where + go :: VarInfo -> MaybeT DsM VarInfo + go vi at VI { vi_bot = bot } + = case bot of + IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! + IsBot -> return vi -- There already is x ~ ⊥. Nothing left to do + MaybeBot -- We add x ~ ⊥ + | definitelyUnliftedType (eclassType x nabla) + -- Case (3) in Note [Strict fields and variables of unlifted type] + -> mzero -- unlifted vars can never be ⊥ + | otherwise + -> do + return vi{ vi_bot = IsBot } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". -addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addNotBotCt :: Nabla -> ClassId -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + let (yid, vi at VI { vi_bot = bot }) = lookupVarInfoNT ts x case bot of IsBot -> mzero -- There was x ~ ⊥. Contradiction! IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} - pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } + pure $ markDirty yid + $ nabla{nabla_tm_st = ts{ ts_facts = env & _class yid . _data .~ vi'}} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if -- that leads to a contradiction. -- See Note [TmState invariants]. -addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla +addNotConCt :: Nabla -> ClassId -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla x nalt = do (mb_mark_dirty, nabla') <- trvVarInfo go nabla x pure $ case mb_mark_dirty of - Just x -> markDirty x nabla' - Nothing -> nabla' + True -> markDirty x nabla' + False -> nabla' where -- Update `x`'s 'VarInfo' entry. Fail ('MaybeT') if contradiction, -- otherwise return updated entry and `Just x'` if `x` should be marked dirty, -- where `x'` is the representative of `x`. - go :: VarInfo -> MaybeT DsM (Maybe Id, VarInfo) - go vi@(VI x' pos neg _ rcm) = do + go :: VarInfo -> MaybeT DsM (Bool, VarInfo) + go vi@(VI _x' pos neg _ rcm) = do -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -748,12 +762,12 @@ addNotConCt nabla x nalt = do pure $ case mb_rcm' of -- If nalt could be removed from a COMPLETE set, we'll get back Just and -- have to mark x dirty, by returning Just x'. - Just rcm' -> (Just x', vi'{ vi_rcm = rcm' }) + Just rcm' -> (True, vi'{ vi_rcm = rcm' }) -- Otherwise, nalt didn't occur in any residual COMPLETE set and we -- don't have to mark it dirty. So we return Nothing, which in the case -- above would have compromised precision. -- See Note [Shortcutting the inhabitation test], grep for T17836. - Nothing -> (Nothing, vi') + Nothing -> (False, vi') hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -767,8 +781,9 @@ hasRequiredTheta _ = False -- have on @x@, reject (@Nothing@) otherwise. -- -- See Note [TmState invariants]. -addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla -addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do +addConCt :: Nabla -> ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> MaybeT DsM Nabla +addConCt nabla at MkNabla{ nabla_tm_st = ts } x alt tvs args = do + -- ROMES:TODO: Also looks like a function on varinfo (adjust) let vi@(VI _ pos neg bot _) = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) @@ -788,7 +803,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{nabla_tm_st = ts{ts_facts = ts_facts ts & _class x ._data .~ vi{vi_pos = pos', vi_bot = bot'}}} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -816,12 +831,23 @@ equateTys ts us = -- @nabla@ has integrated the knowledge from the equality constraint. -- -- See Note [TmState invariants]. -addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +addVarCt :: Nabla -> ClassId -> ClassId -> MaybeT DsM Nabla +-- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = - case equateUSDFM env x y of - (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes + -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so + case equate env x y of -- Add the constraints we had for x to y - (Just vi_x, env') -> do + -- See Note (TODO) Joining e-classes PMC] todo mention from joinA + -- Now, here's a really tricky bit (TODO Write note, is it the one above?) + -- Bc the joinA operation is unlawful, and because the makeA operation for + -- expressions is also unlawful (sets the type to ()::(), mostly out of + -- laziness, we could reconstruct the type if we wanted), + -- Then we must make sure that when we're "completing the joinA manually", + -- We *also update the type* (WTF1). + -- This is because every e-class should always have a match-var first, which will always have a type, and it should appear on "the left" + -- We also rebuild here, we did just merge two things. TODO: Where and when exactly should we merge? + (vi_x, EG.rebuild -> env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -829,6 +855,22 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- Do the same for negative info let add_neg nabla nalt = addNotConCt nabla y nalt foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) + where + -- @equate env x y@ makes @x@ and @y@ point to the same entry, + -- thereby merging @x@'s class with @y@'s. + -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be + -- chosen as the new entry and @x@'s old entry will be returned. + -- + -- Examples in terms of the model (see 'UniqSDFM'): + -- >>> equate [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) + -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) + equate :: TmEGraph -> ClassId -> ClassId -> (VarInfo, TmEGraph) + equate eg x y = let (_, eg') = EG.merge x y eg + in (eg ^. _class x ._data, eg') + -- Note: lookup in @eg@, not @eg'@, because we want to return x's data before the merge. + -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -842,7 +884,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- for other literals. See 'coreExprAsPmLit'. -- * Finally, if we have @let x = e@ and we already have seen @let y = e@, we -- want to record @x ~ y at . -addCoreCt :: Nabla -> Id -> CoreExpr -> MaybeT DsM Nabla +addCoreCt :: Nabla -> ClassId -> CoreExpr -> MaybeT DsM Nabla addCoreCt nabla x e = do simpl_opts <- initSimpleOpts <$> getDynFlags let e' = simpleOptExpr simpl_opts e @@ -851,8 +893,10 @@ addCoreCt nabla x e = do where -- Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. - core_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () + -- ROMES:TODO: Consider CoreExprF instead of CoreExpr already here? + core_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon + -- RM: Could this be done better with e-graphs? The whole newtype stuff -- This is the right thing for casts involving data family instances and -- their representation TyCon, though (which are not visible in source -- syntax). See Note [COMPLETE sets on data families] @@ -873,14 +917,19 @@ addCoreCt nabla x e = do | Just (in_scope, _empty_floats@[], dc, _arg_tys, args) <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args - -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe x - -- We don't consider DataCons flexible variables - = modifyT (\nabla -> addVarCt nabla x y) | otherwise - -- Any other expression. Try to find other uses of a semantically - -- equivalent expression and represent them by the same variable! = equate_with_similar_expr x e + -- nabla' <- get + -- if + -- See Note [Detecting pattern synonym applications in expressions] + -- ROMES:TODO: Can we fix this more easily with e-graphs? + -- x| Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') + -- We don't consider DataCons flexible variables + -- -> modifyT (\nabla -> addVarCt nabla' x y) + -- x| otherwise + -- Any other expression. Try to find other uses of a semantically + -- equivalent expression and represent them by the same variable! + -- -> equate_with_similar_expr x e where expr_ty = exprType e expr_in_scope = mkInScopeSet (exprFreeVars e) @@ -894,15 +943,18 @@ addCoreCt nabla x e = do -- see if we already encountered a constraint @let y = e'@ with @e'@ -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . - equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () - equate_with_similar_expr x e = do - rep <- StateT $ \nabla -> lift (representCoreExpr nabla e) + equate_with_similar_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () + equate_with_similar_expr _x e = do + rep <- StateT $ \nabla -> pure (representCoreExpr nabla e) -- Note that @rep == x@ if we encountered @e@ for the first time. + + -- ROMES:TODO: I don't think we need to do the following anymore, represent should directly do so in the right e-class (if rebuilt) modifyT (\nabla -> addVarCt nabla x rep) + -- ROMES:TODO: When to rebuild? - bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id + bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) + x <- StateT $ \nabla -> lift (mkPmMatchId (exprType e) nabla) core_expr x e pure x @@ -913,7 +965,7 @@ addCoreCt nabla x e = do -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ -- 4. @x ~ K as ys@ -- This is quite similar to PmCheck.pmConCts. - data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () + data_con_app :: ClassId -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () data_con_app x in_scope dc args = do let dc_ex_tvs = dataConExTyCoVars dc arty = dataConSourceArity dc @@ -936,13 +988,13 @@ addCoreCt nabla x e = do -- Adds a literal constraint, i.e. @x ~ 42 at . -- Also we assume that literal expressions won't diverge, so this -- will add a @x ~/ ⊥@ constraint. - pm_lit :: Id -> PmLit -> StateT Nabla (MaybeT DsM) () + pm_lit :: ClassId -> PmLit -> StateT Nabla (MaybeT DsM) () pm_lit x lit = do modifyT $ \nabla -> addNotBotCt nabla x pm_alt_con_app x (PmAltLit lit) [] [] -- Adds the given constructor application as a solution for @x at . - pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Nabla (MaybeT DsM) () + pm_alt_con_app :: ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> StateT Nabla (MaybeT DsM) () pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args -- | Like 'modify', but with an effectful modifier action @@ -953,24 +1005,18 @@ modifyT f = StateT $ fmap ((,) ()) . f -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) -representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps key = pure (rep, nabla) - | otherwise = do - rep <- mkPmId (exprType e) - let reps' = extendCoreMap reps key rep - let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } - pure (rep, nabla') - where - key = makeDictsCoherent e - -- Use a key in which dictionaries for the same type become equal. - -- See Note [Unique dictionaries in the TmOracle CoreMap] +representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = + second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + -- Use a key in which dictionaries for the same type become equal. + -- See Note [Unique dictionaries in the TmOracle CoreMap] -- | Change out 'Id's which are uniquely determined by their type to a -- common value, so that different names for dictionaries of the same type -- are considered equal when building a 'CoreMap'. -- -- See Note [Unique dictionaries in the TmOracle CoreMap] +-- ROMES:TODO: I suppose this should be taken into account by the Eq instance of DeBruijnF CoreExprF -- if we do that there then we're sure that EG.represent takes that into account. makeDictsCoherent :: CoreExpr -> CoreExpr makeDictsCoherent var@(Var v) | let ty = idType v @@ -1059,6 +1105,7 @@ In the end, replacing dictionaries with an error value in the pattern-match checker was the most self-contained, although we might want to revisit once we implement a more robust approach to computing equality in the pattern-match checker (see #19272). +ROMES:TODO: I don't think e-graphs avoid this situation, because the names of the binders will still differ (although the Eq instance could take this into account?) -} {- Note [The Pos/Neg invariant] @@ -1271,22 +1318,23 @@ tyStateRefined :: TyState -> TyState -> Bool -- refinement of b or vice versa! tyStateRefined a b = ty_st_n a /= ty_st_n b -markDirty :: Id -> Nabla -> Nabla +markDirty :: ClassId -> Nabla -> Nabla markDirty x nabla at MkNabla{nabla_tm_st = ts at TmSt{ts_dirty = dirty} } = - nabla{ nabla_tm_st = ts{ ts_dirty = extendDVarSet dirty x } } + nabla{nabla_tm_st = ts{ ts_dirty = IS.insert x dirty }} -traverseDirty :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseDirty :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = - go (uniqDSetToList dirty) env + + go (IS.elems dirty) env where go [] env = pure ts{ts_facts=env} go (x:xs) !env = do - vi' <- f (lookupVarInfo ts x) - go xs (addToUSDFM env x vi') + vi' <- f x (lookupVarInfo ts x) + go xs (env & _class x._data .~ vi') -- Use 'over' or so instead? -traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseAll :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseUSDFM f env + env' <- (_iclasses.(\fab (i,cl) -> let mvi = fab (i,cl^._data) in (cl &) . (_data .~) <$> mvi)) (uncurry f) env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1308,31 +1356,34 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in ts' <- if tyStateRefined old_ty_st (nabla_ty_st nabla) then traverseAll test_one ts else traverseDirty test_one ts - pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} + pure nabla{ nabla_tm_st = ts'{ts_dirty=IS.empty}} where - nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } - test_one :: VarInfo -> MaybeT DsM VarInfo - test_one vi = - lift (varNeedsTesting old_ty_st nabla vi) >>= \case + nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=IS.empty} } + test_one :: ClassId -> VarInfo -> MaybeT DsM VarInfo + test_one cid vi = + lift (varNeedsTesting old_ty_st nabla cid vi) >>= \case True -> do -- lift $ tracePm "test_one" (ppr vi) -- No solution yet and needs testing -- We have to test with a Nabla where all dirty bits are cleared - instantiate (fuel-1) nabla_not_dirty vi - _ -> pure vi + instantiate (fuel-1) nabla_not_dirty (cid,vi) + _ -> return vi + +-- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to +-- upward merge, perhaps we can rid of it too -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. -varNeedsTesting :: TyState -> Nabla -> VarInfo -> DsM Bool -varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi - | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True -varNeedsTesting _ _ vi +varNeedsTesting :: TyState -> Nabla -> ClassId -> VarInfo -> DsM Bool +varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} cid _ + | IS.member cid (ts_dirty tm_st) = pure True +varNeedsTesting _ _ _ vi | notNull (vi_pos vi) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ _ -- Same type state => still inhabited | not (tyStateRefined old_ty_st new_ty_st) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ vi = do -- These normalisations are relatively expensive, but still better than having -- to perform a full inhabitation test (_, _, old_norm_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) @@ -1349,25 +1400,25 @@ varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do -- NB: Does /not/ filter each CompleteMatch with the oracle; members may -- remain that do not satisfy it. This lazy approach just -- avoids doing unnecessary work. -instantiate :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instantiate fuel nabla vi = {-# SCC "instantiate" #-} - (instBot fuel nabla vi <|> instCompleteSets fuel nabla vi) +instantiate :: Int -> Nabla -> (ClassId, VarInfo) -> MaybeT DsM VarInfo +instantiate fuel nabla (ci,vi) = {-# SCC "instantiate" #-} + (instBot fuel nabla (ci,vi) <|> instCompleteSets fuel nabla ci) -- | The \(⊢_{Bot}\) rule from the paper -instBot :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instBot _fuel nabla vi = {-# SCC "instBot" #-} do - _nabla' <- addBotCt nabla (vi_id vi) +instBot :: Int -> Nabla -> (ClassId,VarInfo) -> MaybeT DsM VarInfo +instBot _fuel nabla (cid,vi) = {-# SCC "instBot" #-} do + _nabla' <- addBotCt nabla cid pure vi -addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) -addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x - = trvVarInfo add_matches nabla x +addNormalisedTypeMatches :: Nabla -> ClassId -> DsM (ResidualCompleteMatches, Nabla) +addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } xid + = trvVarInfo add_matches nabla xid where add_matches vi at VI{ vi_rcm = rcm } -- important common case, shaving down allocations of PmSeriesG by -5% | isRcmInitialised rcm = pure (rcm, vi) add_matches vi at VI{ vi_rcm = rcm } = do - norm_res_ty <- normaliseSourceTypeWHNF ty_st (idType x) + norm_res_ty <- normaliseSourceTypeWHNF ty_st (eclassType xid nabla) env <- dsGetFamInstEnvs rcm' <- case splitReprTyConApp_maybe env norm_res_ty of Just (rep_tc, _args, _co) -> addTyConMatches rep_tc rcm @@ -1388,12 +1439,11 @@ splitReprTyConApp_maybe env ty = -- inhabitant, the whole thing is uninhabited. It returns the updated 'VarInfo' -- where all the attempted ConLike instantiations have been purged from the -- 'ResidualCompleteMatches', which functions as a cache. -instCompleteSets :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do - let x = vi_id vi - (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) - nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla) x) +instCompleteSets :: Int -> Nabla -> ClassId -> MaybeT DsM VarInfo +instCompleteSets fuel nabla cid = {-# SCC "instCompleteSets" #-} do + (rcm, nabla) <- lift (addNormalisedTypeMatches nabla cid) + nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla cid cls) nabla (getRcm rcm) + pure (lookupVarInfo (nabla_tm_st nabla) cid) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1411,18 +1461,18 @@ anyConLikeSolution p = any (go . paca_con) -- original Nabla, not a proper refinement! No positive information will be -- added, only negative information from failed instantiation attempts, -- entirely as an optimisation. -instCompleteSet :: Int -> Nabla -> Id -> CompleteMatch -> MaybeT DsM Nabla -instCompleteSet fuel nabla x cs - | anyConLikeSolution (`elementOfUniqDSet` (cmConLikes cs)) (vi_pos vi) +instCompleteSet :: Int -> Nabla -> ClassId -> CompleteMatch -> MaybeT DsM Nabla +instCompleteSet fuel nabla xid cs + | anyConLikeSolution (`elementOfUniqDSet` cmConLikes cs) (vi_pos vi) -- No need to instantiate a constructor of this COMPLETE set if we already -- have a solution! = pure nabla - | not (completeMatchAppliesAtType (varType x) cs) + | not (completeMatchAppliesAtType (eclassType xid nabla) cs) = pure nabla | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - vi = lookupVarInfo (nabla_tm_st nabla) x + vi = lookupVarInfo (nabla_tm_st nabla) xid sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1443,12 +1493,11 @@ instCompleteSet fuel nabla x cs | isDataConTriviallyInhabited dc = pure nabla go nabla (con:cons) = do - let x = vi_id vi let recur_not_con = do - nabla' <- addNotConCt nabla x (PmAltConLike con) + nabla' <- addNotConCt nabla xid (PmAltConLike con) go nabla' cons - (nabla <$ instCon fuel nabla x con) -- return the original nabla, not the - -- refined one! + (nabla <$ instCon fuel nabla xid con) -- return the original nabla, not the + -- refined one! <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. @@ -1509,11 +1558,11 @@ compareConLikeTestability (RealDataCon a) (RealDataCon b) = mconcat -- adding the proper constructor constraint. -- -- See Note [Instantiating a ConLike]. -instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla -instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do +instCon :: Int -> Nabla -> ClassId -> ConLike -> MaybeT DsM Nabla +instCon fuel nabla0 at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do let hdr what = "instCon " ++ show fuel ++ " " ++ what env <- dsGetFamInstEnvs - let match_ty = idType x + let match_ty = eclassType x nabla0 tracePm (hdr "{") $ ppr con <+> text "... <-" <+> ppr x <+> dcolon <+> ppr match_ty norm_match_ty <- normaliseSourceTypeWHNF ty_st match_ty @@ -1531,23 +1580,23 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma let gammas = substTheta sigma_ex (eqSpecPreds eq_spec ++ thetas) -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys - arg_ids <- mapM mkPmId field_tys' + (arg_ids, nabla1) <- runStateT (mapM (StateT @Nabla . mkPmMatchId) field_tys') nabla0 tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) ] -- (5) Finally add the new constructor constraint runMaybeT $ do -- Case (2) of Note [Strict fields and variables of unlifted type] let alt = PmAltConLike con - let branching_factor = length $ filterUnliftedFields alt arg_ids + let branching_factor = length $ filterUnliftedFields nabla1 alt arg_ids let ct = PhiConCt x alt ex_tvs gammas arg_ids - nabla1 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ - addPhiTmCt nabla ct + nabla2 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ + addPhiTmCt nabla1 ct -- See Note [Fuel for the inhabitation test] let new_fuel | branching_factor <= 1 = fuel @@ -1559,18 +1608,18 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) , ppr branching_factor , ppr new_fuel ] - nabla2 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla1) $ - inhabitationTest new_fuel (nabla_ty_st nabla) nabla1 - lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla2) - pure nabla2 + nabla3 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla2) $ + inhabitationTest new_fuel (nabla_ty_st nabla1) nabla2 + lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla3) + pure nabla3 Nothing -> do tracePm (hdr "(match_ty not instance of res_ty) }") empty - pure (Just nabla) -- Matching against match_ty failed. Inhabited! - -- See Note [Instantiating a ConLike]. + pure (Just nabla0) -- Matching against match_ty failed. Inhabited! + -- See Note [Instantiating a ConLike]. -- | @matchConLikeResTy _ _ ty K@ tries to match @ty@ against the result -- type of @K@, @res_ty at . It returns a substitution @s@ for @K@'s universal @@ -1905,13 +1954,15 @@ instance Outputable GenerateInhabitingPatternsMode where -- perhaps empty) refinements of @nabla@ that represent inhabited patterns. -- Negative information is only retained if literals are involved or for -- recursive GADTs. -generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nabla -> DsM [Nabla] +-- +-- The list of 'Id's @vs@ is the list of match-ids ? and they have all already been represented in the e-graph, we just represent them again to re-gain class id information +generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nabla -> DsM [Nabla] -- See Note [Why inhabitationTest doesn't call generateInhabitingPatterns] generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] -generateInhabitingPatterns mode (x:xs) n nabla = do +generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x + let VI _ pos neg _ _ = lookupVarInfo ts x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1941,15 +1992,15 @@ generateInhabitingPatterns mode (x:xs) n nabla = do -- Tries to instantiate a variable by possibly following the chain of -- newtypes and then instantiating to all ConLikes of the wrapped type's -- minimal residual COMPLETE set. - try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] + try_instantiate :: ClassId -> [ClassId] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (eclassType x nabla) mb_stuff <- runMaybeT $ instantiate_newtype_chain x nabla dcs case mb_stuff of Nothing -> pure [] - Just (y, newty_nabla) -> do - let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + Just (y, newty_nabla at MkNabla{nabla_tm_st=ts}) -> do + let vi = lookupVarInfo ts y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) @@ -1973,16 +2024,16 @@ generateInhabitingPatterns mode (x:xs) n nabla = do -- Instantiates a chain of newtypes, beginning at @x at . -- Turns @x nabla [T,U,V]@ to @(y, nabla')@, where @nabla'@ we has the fact -- @x ~ T (U (V y))@. - instantiate_newtype_chain :: Id -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (Id, Nabla) + instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do - y <- lift $ mkPmId arg_ty + (y,nabla') <- lift $ mkPmMatchId arg_ty nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla' <- addConCt nabla x (PmAltConLike (RealDataCon dc)) [] [y] - instantiate_newtype_chain y nabla' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [y] + instantiate_newtype_chain y nabla'' dcs - instantiate_cons :: Id -> Type -> [Id] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] + instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] instantiate_cons _ _ _ 0 _ _ = pure [] instantiate_cons _ ty xs n nabla _ @@ -1992,7 +2043,7 @@ generateInhabitingPatterns mode (x:xs) n nabla = do instantiate_cons x ty xs n nabla (cl:cls) = do -- The following line is where we call out to the inhabitationTest! mb_nabla <- runMaybeT $ instCon 4 nabla x cl - tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (idType x) + tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (eclassType x nabla) , ppr ty , ppr cl , ppr nabla @@ -2082,3 +2133,25 @@ Note that for -XEmptyCase, we don't want to emit a minimal cover. We arrange that by passing 'CaseSplitTopLevel' to 'generateInhabitingPatterns'. We detect the -XEmptyCase case in 'reportWarnings' by looking for 'ReportEmptyCase'. -} + +-- | Update the value of the analysis data of some e-class by its id. +updateVarInfo :: Functor f => ClassId -> (VarInfo -> f VarInfo) -> Nabla -> f Nabla +-- Update the data at class @xid@ using lenses and the monadic action @go@ +updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg + +eclassMatchId :: HasCallStack => ClassId -> Nabla -> Id +eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) + +eclassType :: ClassId -> Nabla -> Type +eclassType cid = idType . eclassMatchId cid + +-- ROMES:TODO: When exactly to rebuild? + +-- | Generate a fresh class for matching, returning the class-id as the match-id +mkPmMatchId :: Type -> Nabla -> DsM (ClassId, Nabla) +mkPmMatchId ty (MkNabla tyst ts at TmSt{ts_facts = egr}) = do + x <- mkPmId ty -- romes:Todo: for now, we still use mkPmId to get an Id for emptyVarInfo, but we want to get rid of this too + let (xid, egr') = EG.newEClass (emptyVarInfo x) egr + return (xid, MkNabla tyst ts{ts_facts=egr'}) +{-# NOINLINE mkPmMatchId #-} -- We'll CPR deeply, that should be enough + ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,7 +1,12 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | Domain types used in "GHC.HsToCore.Pmc.Solver". -- The ultimate goal is to define 'Nabla', which models normalised refinement @@ -10,12 +15,12 @@ module GHC.HsToCore.Pmc.Solver.Types ( -- * Normalised refinement types - BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TmEGraph, TyState(..), Nabla(..), Nablas(..), initNablas, lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, representIds, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -42,10 +47,9 @@ import GHC.Prelude import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id -import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Name +import GHC.Core.Equality import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Utils.Outputable @@ -58,7 +62,7 @@ import GHC.Core.TyCon import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -75,6 +79,17 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi +import Data.Tuple (swap) +import Data.Traversable (mapAccumL) +import Data.Functor.Compose +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph, ClassId) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.IntSet (IntSet) +import qualified Data.IntSet as IS (empty) +import Data.Bifunctor (second, bimap) + -- import GHC.Driver.Ppr -- @@ -131,21 +146,19 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt 0 emptyInert --- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These --- entries are possibly shared when we figure out that two variables must be --- equal, thus represent the same set of values. +-- | The term oracle state. Stores 'VarInfo' for encountered 'Id's and +-- 'CoreExpr's. These entries are possibly shared when we figure out that two +-- variables must be equal, thus represent the same set of values. -- -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(UniqSDFM Id VarInfo) - -- ^ Facts about term variables. Deterministic env, so that we generate - -- deterministic error messages. - , ts_reps :: !(CoreMap Id) - -- ^ An environment for looking up whether we already encountered semantically - -- equivalent expressions that we want to represent by the same 'Id' - -- representative. - , ts_dirty :: !DIdSet + { ts_facts :: !TmEGraph + -- ^ Facts about terms. + + -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know + -- which nodes to upward merge, perhaps we can get rid of it too. + , ts_dirty :: !IntSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } @@ -161,6 +174,8 @@ data VarInfo { vi_id :: !Id -- ^ The 'Id' in question. Important for adding new constraints relative to -- this 'VarInfo' when we don't easily have the 'Id' available. + -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? + -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all @@ -168,7 +183,7 @@ data VarInfo -- pattern matches involving pattern synonym -- case x of { Just y -> case x of PatSyn z -> ... } -- However, no more than one RealDataCon in the list, otherwise contradiction - -- because of generativity. + -- because of generativity (which would violate Invariant 1 from the paper). , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. @@ -206,7 +221,7 @@ data PmAltConApp = PACA { paca_con :: !PmAltCon , paca_tvs :: ![TyVar] - , paca_ids :: ![Id] + , paca_ids :: ![ClassId] } -- | See 'vi_bot'. @@ -227,7 +242,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -248,7 +263,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -300,9 +315,13 @@ emptyVarInfo x , vi_rcm = emptyRCM } -lookupVarInfo :: TmState -> Id -> VarInfo --- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) +-- | @lookupVarInfo tms x@ tells what we know about 'x' +--- romes:TODO: This will have a different type. I don't know what yet. +-- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? +lookupVarInfo :: TmState -> ClassId -> VarInfo +lookupVarInfo (TmSt eg _) x +-- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. + = eg ^._class x._data -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -314,27 +333,33 @@ lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +-- +-- RM: looks like we could get perhaps represent the newtypes in the e-graph instead and somehow simplify this? +lookupVarInfoNT :: TmState -> ClassId -> (ClassId, VarInfo) lookupVarInfoNT ts x = case lookupVarInfo ts x of VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y - res -> (x, res) + res -> (x, res) where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing -trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +-- romes: We could probably inline this +trvVarInfo :: forall f a. Functor f => (VarInfo -> f (a,VarInfo)) -> Nabla -> ClassId -> f (a,Nabla) trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) - where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) + = second (\g -> nabla{nabla_tm_st = ts{ts_facts=g}}) <$> updateAccum (_class x._data) f env + where + updateAccum :: forall f a s c. Functor f => Lens' s a -> (a -> f (c,a)) -> s -> f (c,s) + updateAccum lens g = getCompose . lens @(Compose f ((,) c)) (Compose . g) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' -lookupRefuts :: Nabla -> Id -> [PmAltCon] +-- ROMES:TODO: Document +-- | Lookup the refutable patterns, i.e. the pattern alt cons that certainly can't happen?? +-- ROMES:TODO: ClassId? +lookupRefuts :: Nabla -> ClassId -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = @@ -346,7 +371,7 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. -lookupSolution :: Nabla -> Id -> Maybe PmAltConApp +lookupSolution :: Nabla -> ClassId -> Maybe PmAltConApp lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of [] -> Nothing pos@(x:_) @@ -465,6 +490,7 @@ extendPmAltConSet (PACS cls lits) (PmAltConLike cl) extendPmAltConSet (PACS cls lits) (PmAltLit lit) = PACS cls (unionLists lits [lit]) +-- | The elements of a 'PmAltConSet' pmAltConSetElems :: PmAltConSet -> [PmAltCon] pmAltConSetElems (PACS cls lits) = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits @@ -789,7 +815,7 @@ instance Outputable PmLit where , (charPrimTy, primCharSuffix) , (floatPrimTy, primFloatSuffix) , (doublePrimTy, primDoubleSuffix) ] - suffix = fromMaybe empty (snd <$> find (eqType ty . fst) tbl) + suffix = maybe empty snd (find (eqType ty . fst) tbl) instance Outputable PmAltCon where ppr (PmAltConLike cl) = ppr cl @@ -797,3 +823,91 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show + +-- +-- * E-graphs to represent normalised refinment types +-- + +type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) +-- TODO delete orphans for showing TmEGraph for debugging reasons +instance Show VarInfo where + show = showPprUnsafe . ppr + +representId :: Id -> Nablas -> (ClassId, Nablas) +-- Will need to justify this well +representId x (MkNablas nbs) = bimap (fromJust . headMaybe) MkNablas $ unzipBag $ mapBag go nbs where + go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) + +representIds :: [Id] -> Nablas -> ([ClassId], Nablas) +representIds xs nablas = swap $ mapAccumL (\acc x -> swap $ representId x acc) nablas xs + +-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. +-- There ought to be a better way. +instance Eq VarInfo where + (==) a b = vi_id a == vi_id b +instance Analysis VarInfo (DeBruijnF CoreExprF) where + {-# INLINE makeA #-} + {-# INLINE joinA #-} + + -- When an e-class is created for a variable, we create an VarInfo from it. + -- It doesn't matter if this variable is bound or free, since it's the first + -- variable in this e-class (and all others would have to be equivalent to + -- it) + -- + -- Also, the Eq instance for DeBruijn Vars will ensure that two free + -- variables with the same Id are equal and so they will be represented in + -- the same e-class + makeA (DF (D _ (VarF x))) = emptyVarInfo x + makeA _ = emptyVarInfo unitDataConId -- ROMES:TODO: this is dummy information which should never be used, this is quite wrong :) + -- I think the reason we end up in this + -- situation is bc we first represent an expression and only then merge it with some Id. + -- we'd need a way to represent directly into an e-class then, to not trigger the new e-class. + + -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. + -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble + -- Hacks hacks hacks + -- Do some "obvious" things in this merge, despite keeping all the nuanced + -- joining operations in addVarCt. Some part of them will be redundant, but + -- if we don't do the simple things here we might end up losing information + -- when merging things through the e-graph outside of 'addVarCt' + +-- I think we really need effects, because the operation is only well-defined +-- since it can fail when it is conflicting +-- and that would allow us to do the merge procedure correcly here instead of in addVarCt +-- we may be able to have Analysis (Effect VarInfo) (...) + joinA a b = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b + , vi_pos = case (vi_pos a, vi_pos b) of + ([], []) -> [] + ([], x) -> x + (x, []) -> x + (_x, y) -> y -- keep right + , vi_neg = foldr (flip extendPmAltConSet) (vi_neg b) (pmAltConSetElems $ vi_neg a) + , vi_bot = case (vi_bot a, vi_bot b) of + (IsBot,IsBot) -> IsBot + (IsBot,IsNotBot) -> IsNotBot -- keep b, achhhhh + (IsBot,MaybeBot) -> IsBot + (IsNotBot,IsBot) -> IsBot -- keep b, achhhhh + (IsNotBot,IsNotBot) -> IsNotBot + (IsNotBot,MaybeBot) -> IsNotBot + (MaybeBot, IsBot) -> IsBot + (MaybeBot, IsNotBot) -> IsNotBot + (MaybeBot, MaybeBot) -> MaybeBot + , vi_rcm = case (vi_rcm a, vi_rcm b) of + (RCM Nothing Nothing,RCM a b) -> RCM a b + (RCM Nothing (Just a),RCM Nothing Nothing) -> RCM Nothing (Just a) + (RCM Nothing (Just _a),RCM Nothing (Just b)) -> RCM Nothing (Just b) -- keep right + (RCM Nothing (Just a),RCM (Just b) Nothing) -> RCM (Just b) (Just a) + (RCM Nothing (Just _a),RCM (Just b) (Just c)) -> RCM (Just b) (Just c) -- keep right + (RCM (Just a) Nothing,RCM Nothing Nothing) -> RCM (Just a) Nothing + (RCM (Just a) Nothing,RCM Nothing (Just b)) -> RCM (Just a) (Just b) + (RCM (Just _a) Nothing,RCM (Just b) Nothing) -> RCM (Just b) Nothing -- keep right + (RCM (Just _a) Nothing,RCM (Just b) (Just c)) -> RCM (Just b) (Just c) + (RCM (Just a) (Just b),RCM Nothing Nothing) -> RCM (Just a) (Just b) + (RCM (Just a) (Just _b),RCM Nothing (Just c)) -> RCM (Just a) (Just c) + (RCM (Just _a) (Just b),RCM (Just c) Nothing) -> RCM (Just c) (Just b) + (RCM (Just _a) (Just _b),RCM (Just c) (Just d)) -> RCM (Just c) (Just d) + -- we could also have _ _, (Just c) (Just d) -> (Just c, Just d) + } + ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Types.SrcLoc (SrcSpan) import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic -import {-# SOURCE #-} Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax.Expr import GHC.Unit.Module.Imported (ImportedModsVal) import GHC.Data.FastString (fsLit) import Language.Haskell.Syntax (LPat, LIdP) ===================================== compiler/GHC/Types/TyThing/Ppr.hs-boot ===================================== @@ -3,7 +3,7 @@ module GHC.Types.TyThing.Ppr ( pprTyThingInContext ) where -import {-# SOURCE #-} GHC.Iface.Type ( ShowSub ) +import GHC.Iface.Type ( ShowSub ) import GHC.Types.TyThing ( TyThing ) import GHC.Utils.Outputable ( SDoc ) ===================================== compiler/GHC/Types/Unique/SDFM.hs deleted ===================================== @@ -1,121 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ApplicativeDo #-} -{-# OPTIONS_GHC -Wall #-} - --- | Like a 'UniqDFM', but maintains equivalence classes of keys sharing the --- same entry. See 'UniqSDFM'. -module GHC.Types.Unique.SDFM ( - -- * Unique-keyed, /shared/, deterministic mappings - UniqSDFM, - - emptyUSDFM, - lookupUSDFM, - equateUSDFM, addToUSDFM, - traverseUSDFM - ) where - -import GHC.Prelude - -import GHC.Types.Unique -import GHC.Types.Unique.DFM -import GHC.Utils.Outputable - --- | Either @Indirect x@, meaning the value is represented by that of @x@, or --- an @Entry@ containing containing the actual value it represents. -data Shared key ele - = Indirect !key - | Entry !ele - --- | A 'UniqDFM' whose domain is /sets/ of 'Unique's, each of which share a --- common value of type @ele at . --- Every such set (\"equivalence class\") has a distinct representative --- 'Unique'. Supports merging the entries of multiple such sets in a union-find --- like fashion. --- --- An accurate model is that of @[(Set key, Maybe ele)]@: A finite mapping from --- sets of @key at s to possibly absent entries @ele@, where the sets don't overlap. --- Example: --- @ --- m = [({u1,u3}, Just ele1), ({u2}, Just ele2), ({u4,u7}, Nothing)] --- @ --- On this model we support the following main operations: --- --- * @'lookupUSDFM' m u3 == Just ele1@, @'lookupUSDFM' m u4 == Nothing@, --- @'lookupUSDFM' m u5 == Nothing at . --- * @'equateUSDFM' m u1 u3@ is a no-op, but --- @'equateUSDFM' m u1 u2@ merges @{u1,u3}@ and @{u2}@ to point to --- @Just ele2@ and returns the old entry of @{u1,u3}@, @Just ele1 at . --- * @'addToUSDFM' m u3 ele4@ sets the entry of @{u1,u3}@ to @Just ele4 at . --- --- As well as a few means for traversal/conversion to list. -newtype UniqSDFM key ele - = USDFM { unUSDFM :: UniqDFM key (Shared key ele) } - -emptyUSDFM :: UniqSDFM key ele -emptyUSDFM = USDFM emptyUDFM - -lookupReprAndEntryUSDFM :: Uniquable key => UniqSDFM key ele -> key -> (key, Maybe ele) -lookupReprAndEntryUSDFM (USDFM env) = go - where - go x = case lookupUDFM env x of - Nothing -> (x, Nothing) - Just (Indirect y) -> go y - Just (Entry ele) -> (x, Just ele) - --- | @lookupSUDFM env x@ looks up an entry for @x@, looking through all --- 'Indirect's until it finds a shared 'Entry'. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 == Just ele1 --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u4 == Nothing --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Nothing)] u2 == Nothing -lookupUSDFM :: Uniquable key => UniqSDFM key ele -> key -> Maybe ele -lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) - --- | @equateUSDFM env x y@ makes @x@ and @y@ point to the same entry, --- thereby merging @x@'s class with @y@'s. --- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be --- chosen as the new entry and @x@'s old entry will be returned. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> equateUSDFM [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) --- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) --- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) --- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) -equateUSDFM - :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) -equateUSDFM usdfm@(USDFM env) x y = - case (lu x, lu y) of - ((x', _) , (y', _)) - | getUnique x' == getUnique y' -> (Nothing, usdfm) -- nothing to do - ((x', _) , (y', Nothing)) -> (Nothing, set_indirect y' x') - ((x', mb_ex), (y', _)) -> (mb_ex, set_indirect x' y') - where - lu = lookupReprAndEntryUSDFM usdfm - set_indirect a b = USDFM $ addToUDFM env a (Indirect b) - --- | @addToUSDFM env x a@ sets the entry @x@ is associated with to @a@, --- thereby modifying its whole equivalence class. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> addToUSDFM [] u1 ele1 == [({u1}, Just ele1)] --- >>> addToUSDFM [({u1,u3}, Just ele1)] u3 ele2 == [({u1,u3}, Just ele2)] -addToUSDFM :: Uniquable key => UniqSDFM key ele -> key -> ele -> UniqSDFM key ele -addToUSDFM usdfm@(USDFM env) x v = - USDFM $ addToUDFM env (fst (lookupReprAndEntryUSDFM usdfm x)) (Entry v) - -traverseUSDFM :: forall key a b f. Applicative f => (a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b) -traverseUSDFM f = fmap (USDFM . listToUDFM_Directly) . traverse g . udfmToList . unUSDFM - where - g :: (Unique, Shared key a) -> f (Unique, Shared key b) - g (u, Indirect y) = pure (u,Indirect y) - g (u, Entry a) = do - a' <- f a - pure (u,Entry a') - -instance (Outputable key, Outputable ele) => Outputable (Shared key ele) where - ppr (Indirect x) = ppr x - ppr (Entry a) = ppr a - -instance (Outputable key, Outputable ele) => Outputable (UniqSDFM key ele) where - ppr (USDFM env) = ppr env ===================================== compiler/ghc.cabal.in ===================================== @@ -88,6 +88,7 @@ Library array >= 0.1 && < 0.6, filepath >= 1 && < 1.5, template-haskell == 2.20.*, + hegg, hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, @@ -299,6 +300,7 @@ Library GHC.Core.ConLike GHC.Core.DataCon GHC.Core.FamInstEnv + GHC.Core.Equality GHC.Core.FVs GHC.Core.InstEnv GHC.Core.Lint @@ -816,7 +818,6 @@ Library GHC.Types.Unique.FM GHC.Types.Unique.Map GHC.Types.Unique.MemoFun - GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var ===================================== hadrian/src/Packages.hs ===================================== @@ -6,7 +6,7 @@ module Packages ( compareSizes, compiler, containers, deepseq, deriveConstants, directory, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, - hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, + hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, @@ -37,8 +37,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs - , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl + , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline + , hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout @@ -53,7 +53,7 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -93,6 +93,7 @@ ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" haddock = util "haddock" haskeline = lib "haskeline" +hegg = lib "hegg" hsc2hs = util "hsc2hs" hp2ps = util "hp2ps" hpc = lib "hpc" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -162,6 +162,7 @@ toolTargets = [ binary , ghci , ghcPkg -- # executable -- , haddock -- # depends on ghc library + , hegg , hsc2hs -- # executable , hpc , hpcBin -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -89,6 +89,7 @@ stage0Packages = do , ghci , ghcPkg , haddock + , hegg , hsc2hs , hpc , hpcBin @@ -137,6 +138,7 @@ stage1Packages = do , ghcPkg , ghcPrim , haskeline + , hegg , hp2ps , hsc2hs , integerGmp ===================================== libraries/hegg ===================================== @@ -0,0 +1 @@ +Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 ===================================== packages ===================================== @@ -51,6 +51,7 @@ libraries/deepseq - - ssh://g libraries/directory - - ssh://git at github.com/haskell/directory.git libraries/filepath - - ssh://git at github.com/haskell/filepath.git libraries/haskeline - - https://github.com/judah/haskeline.git +libraries/hegg - - https://github.com/alt-romes/hegg.git libraries/hpc - - - libraries/mtl - - https://github.com/haskell/mtl.git libraries/parsec - - https://github.com/haskell/parsec.git ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -248,7 +248,6 @@ GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Map -GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -255,7 +255,6 @@ GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Map -GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebaf87dc732ac437b5f452c425456abe1895fdda...9d2039eecbf8e8ca071c63803640a3e32c05ee01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebaf87dc732ac437b5f452c425456abe1895fdda...9d2039eecbf8e8ca071c63803640a3e32c05ee01 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 03:52:04 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sun, 02 Jul 2023 23:52:04 -0400 Subject: [Git][ghc/ghc][wip/expand-do] add the argument location in error ctxt if it is the first argument of a >> or a >>= Message-ID: <64a245e410c01_3cb823821fd741408d@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: d1c9f376 by Apoorv Ingle at 2023-07-02T22:51:53-05:00 add the argument location in error ctxt if it is the first argument of a >> or a >>= - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -357,11 +357,11 @@ tcApp rn_expr exp_res_ty ; let perhaps_add_res_ty_ctxt thing_inside | insideExpansion fun_ctxt , VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ <- fun_ctxt - = do traceTc "tcApp" (vcat [text "VACall stmt", ppr rn_fun, ppr fun_ctxt]) + = do traceTc "tcApp" (vcat [text "VACall stmt", ppr loc, ppr rn_fun, ppr fun_ctxt]) setSrcSpanA loc $ addStmtCtxt stmt thing_inside | insideExpansion fun_ctxt , XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun - = do traceTc "tcApp" (vcat [text "VAExpansion stmt", ppr rn_fun, ppr fun_ctxt]) + = do traceTc "tcApp" (vcat [text "VAExpansion stmt", ppr loc, ppr rn_fun, ppr fun_ctxt]) setSrcSpanA loc $ addStmtCtxt stmt thing_inside | insideExpansion fun_ctxt = do traceTc "tcApp" (vcat [text "insideExpansion", ppr rn_fun, ppr fun_ctxt]) @@ -734,20 +734,24 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside setSrcSpanA arg_loc $ addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside - VACall fun _ _ | not in_generated_code && (is_then_fun fun || is_bind_fun fun) - -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..." + VACall fun arg_no _ | not in_generated_code && (is_then_fun fun || is_bind_fun fun) + -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..." if the arg_no is > 1 -- We have already set the context "In the stmt" - thing_inside + if arg_no == 1 -- this arg location needs to be added + then setSrcSpanA arg_loc $ + addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated + thing_inside + else thing_inside VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ -> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .." setSrcSpanA loc $ addStmtCtxt stmt $ thing_inside - VAExpansion (HsDo _ _ (L _ ((stmt@(L loc _)) : _))) _ + VAExpansion (HsDo _ _ _) _ -> do traceTc "addArgCtxt 2d" empty -- Set the context as the first statement of do block - setSrcSpanA loc $ - addStmtCtxt stmt $ - thing_inside + -- setSrcSpan loc $ -- skip adding "In the expression do ... " + -- addExprCtxt e $ + thing_inside VAExpansion _ _ -> do traceTc "addArgCtxt 2e" empty -- Skip setting "In the expression..." -- as the arg will be an generated expanded stmt ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -790,8 +790,6 @@ tcInferAppHead_maybe fun args HsOverLit _ lit -> Just <$> tcInferOverLit lit HsUntypedSplice (HsUntypedSpliceTop _ e) _ -> tcInferAppHead_maybe e args - -- XExpr (PopSrcSpan e) -> tcInferAppHead_maybe (unLoc e) args - -- XExpr (ExpandedStmt (HsExpanded _ e)) -> tcInferAppHead_maybe (unLoc e) args _ -> return Nothing addHeadCtxt :: AppCtxt -> TcM a -> TcM a ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1207,8 +1207,6 @@ expandDoStmts doFlav stmts = do expanded_expr <- expand_do_stmts doFlav stmts -- | Expand the Do statments so that it works fine with Quicklook -- See Note[Rebindable Do and Expanding Statements] --- ANI Questions: 1. What should be the location information in the expanded expression? --- Currently the error is displayed on the expanded expr and not on the unexpanded expr expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expand_do_stmts ListComp _ = pprPanic "expand_do_stmts: impossible happened. ListComp" empty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1c9f376f483c2c7253ddb12585c027c9670b122 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1c9f376f483c2c7253ddb12585c027c9670b122 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:27:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:27:49 -0400 Subject: [Git][ghc/ghc][master] Add -fbreak-points to control breakpoint insertion Message-ID: <64a27875ad81c_3cb8234755415183d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - 15 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - docs/users_guide/debug-info.rst - docs/users_guide/ghci.rst - docs/users_guide/phases.rst - ghc/Main.hs - + testsuite/tests/ghci.debugger/scripts/T23057.hs - + testsuite/tests/ghci.debugger/scripts/T23057.script - + testsuite/tests/ghci.debugger/scripts/T23057.stdout - testsuite/tests/ghci.debugger/scripts/all.T - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE MultiWayIf, LambdaCase #-} {-| Module : GHC.Driver.Backend @@ -85,7 +85,7 @@ module GHC.Driver.Backend , backendUnregisterisedAbiOnly , backendGeneratesHc , backendSptIsDynamic - , backendWantsBreakpointTicks + , backendSupportsBreakpoints , backendForcesOptimization0 , backendNeedsFullWays , backendSpecialModuleSource @@ -650,16 +650,16 @@ backendSptIsDynamic (Named JavaScript) = False backendSptIsDynamic (Named Interpreter) = True backendSptIsDynamic (Named NoBackend) = False --- | If this flag is set, then "GHC.HsToCore.Ticks" --- inserts `Breakpoint` ticks. Used only for the --- interpreter. -backendWantsBreakpointTicks :: Backend -> Bool -backendWantsBreakpointTicks (Named NCG) = False -backendWantsBreakpointTicks (Named LLVM) = False -backendWantsBreakpointTicks (Named ViaC) = False -backendWantsBreakpointTicks (Named JavaScript) = False -backendWantsBreakpointTicks (Named Interpreter) = True -backendWantsBreakpointTicks (Named NoBackend) = False +-- | If this flag is unset, then the driver ignores the flag @-fbreak-points@, +-- since backends other than the interpreter tend to panic on breakpoints. +backendSupportsBreakpoints :: Backend -> Bool +backendSupportsBreakpoints = \case + Named NCG -> False + Named LLVM -> False + Named ViaC -> False + Named JavaScript -> False + Named Interpreter -> True + Named NoBackend -> False -- | If this flag is set, then the driver forces the -- optimization level to 0, issuing a warning message if ===================================== compiler/GHC/Driver/Config/HsToCore/Ticks.hs ===================================== @@ -1,5 +1,6 @@ module GHC.Driver.Config.HsToCore.Ticks ( initTicksConfig + , breakpointsAllowed ) where @@ -18,9 +19,14 @@ initTicksConfig dflags = TicksConfig , ticks_countEntries = gopt Opt_ProfCountEntries dflags } +breakpointsAllowed :: DynFlags -> Bool +breakpointsAllowed dflags = + gopt Opt_InsertBreakpoints dflags && + backendSupportsBreakpoints (backend dflags) + coveragePasses :: DynFlags -> [TickishType] coveragePasses dflags = catMaybes - [ ifA Breakpoints $ backendWantsBreakpointTicks $ backend dflags + [ ifA Breakpoints $ breakpointsAllowed dflags , ifA HpcTicks $ gopt Opt_Hpc dflags , ifA ProfNotes $ sccProfilingEnabled dflags && profAuto dflags /= NoProfAuto , ifA SourceNotes $ needSourceNotes dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -355,6 +355,7 @@ data GeneralFlag | Opt_BuildingCabalPackage | Opt_IgnoreDotGhci | Opt_GhciSandbox + | Opt_InsertBreakpoints | Opt_GhciHistory | Opt_GhciLeakCheck | Opt_ValidateHie ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2470,7 +2470,8 @@ fFlagsDeps = [ return dflags)), flagSpec "show-error-context" Opt_ShowErrorContext, flagSpec "cmm-thread-sanitizer" Opt_CmmThreadSanitizer, - flagSpec "split-sections" Opt_SplitSections + flagSpec "split-sections" Opt_SplitSections, + flagSpec "break-points" Opt_InsertBreakpoints ] ++ fHoleFlags ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -167,7 +167,7 @@ deSugar hsc_env [ (i, s) | i <- hsc_interp hsc_env , (_, s) <- m_tickInfo - , backendWantsBreakpointTicks (backend dflags) + , breakpointsAllowed dflags ] $ \(interp, specs) -> mkModBreaks interp mod specs ===================================== docs/users_guide/debug-info.rst ===================================== @@ -1,9 +1,9 @@ Debugging compiled programs =========================== -Since the 7.10 release GHC can emit a debugging information to help debugging +Since the 7.10 release GHC can emit debugging information to help debugging tools understand the code that GHC produces. This debugging information is -useable by most UNIX debugging tools. +usable by most UNIX debugging tools. .. ghc-flag:: -g -g⟨n⟩ ===================================== docs/users_guide/ghci.rst ===================================== @@ -541,7 +541,7 @@ including entities that are in scope in the current module context. .. warning:: Temporary bindings introduced at the prompt only last until the - next :ghci-cmd:`:load`, :ghci-cmd:`:reload`, :ghci-cmd:`:add` or + next :ghci-cmd:`:load`, :ghci-cmd:`:reload`, :ghci-cmd:`:add` or :ghci-cmd:`:unadd` command, at which time they will be simply lost. However, they do survive a change of context with :ghci-cmd:`:module`: the temporary bindings just move to the new location. @@ -1312,6 +1312,17 @@ is possible to break automatically when an exception is thrown, even if it is thrown from within compiled code (see :ref:`ghci-debugger-exceptions`). +.. ghc-flag:: -fbreak-points + :shortdesc: :ref:`Insert breakpoints in the GHCi debugger ` + :type: dynamic + :reverse: -fno-break-points + :category: interactive + + :default: enabled for GHCi + + This flag's purpose is to allow disabling breakpoint insertion with + the reverse form. + .. _breakpoints: Breakpoints and inspecting variables @@ -3172,7 +3183,7 @@ example, to turn on :ghc-flag:`-Wmissing-signatures`, you would say: ghci> :set -Wmissing-signatures -GHCi will also accept any file-header pragmas it finds, such as +GHCi will also accept any file-header pragmas it finds, such as ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, you could instead write: ===================================== docs/users_guide/phases.rst ===================================== @@ -619,8 +619,8 @@ Options affecting code generation useful if you're only interested in type checking code. If a module contains a Template Haskell splice then in ``--make`` mode, code - generation will be automatically turned on for all dependencies. By default - object files are generated but if ghc-flag:`-fprefer-byte-code` is enable then + generation will be automatically turned on for all dependencies. By default, + object files are generated, but if ghc-flag:`-fprefer-byte-code` is enabled, byte-code will be generated instead. .. ghc-flag:: -fwrite-interface @@ -777,7 +777,7 @@ Options affecting code generation :category: codegen If a home package module has byte-code available then use that instead of - and object file (if that's available) to evaluate and run TH splices. + an object file (if that's available) to evaluate and run TH splices. This is useful with flags such as :ghc-flag:`-fbyte-code-and-object-code`, which tells the compiler to generate byte-code, and :ghc-flag:`-fwrite-if-simplified-core` which ===================================== ghc/Main.hs ===================================== @@ -216,6 +216,8 @@ main' postLoadMode units dflags0 args flagWarnings = do -- object code but has little other effect unless you are also using -- fat interface files. `gopt_set` Opt_UseBytecodeRatherThanObjects + -- By default enable the debugger by inserting breakpoints + `gopt_set` Opt_InsertBreakpoints logger1 <- getLogger let logger2 = setLogFlags logger1 (initLogFlags dflags2) ===================================== testsuite/tests/ghci.debugger/scripts/T23057.hs ===================================== @@ -0,0 +1,4 @@ +module T23057 where + +main :: IO () +main = putStrLn "done" ===================================== testsuite/tests/ghci.debugger/scripts/T23057.script ===================================== @@ -0,0 +1,3 @@ +:load T23057 +:break main +main ===================================== testsuite/tests/ghci.debugger/scripts/T23057.stdout ===================================== @@ -0,0 +1,2 @@ +Cannot set breakpoint on ‘main’: No breakpoint found for ‘main’ in module ‘T23057’ +done ===================================== testsuite/tests/ghci.debugger/scripts/all.T ===================================== @@ -139,3 +139,4 @@ test('break030', ghci_script, ['break030.script'], ) +test('T23057', [only_ghci, extra_hc_opts('-fno-break-points')], ghci_script, ['T23057.script']) ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -14,6 +14,7 @@ other dynamic, non-language, flag settings: -fkeep-going -fshow-warning-groups -fprefer-byte-code + -fbreak-points warning settings: -Wsemigroup -Wcompat-unqualified-imports ===================================== testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 ===================================== @@ -13,6 +13,7 @@ other dynamic, non-language, flag settings: -fkeep-going -fshow-warning-groups -fprefer-byte-code + -fbreak-points warning settings: -Wsemigroup -Wcompat-unqualified-imports View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083794b10dc27e9d97b62cc8b8eb4e1da162bf66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/083794b10dc27e9d97b62cc8b8eb4e1da162bf66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:28:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:28:42 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rts: Ensure that pinned allocations respect block size Message-ID: <64a278aaecad_3cb82347644157075@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4 changed files: - rts/sm/Storage.c - + testsuite/tests/rts/T23400.hs - + testsuite/tests/rts/T23400.stdout - testsuite/tests/rts/all.T Changes: ===================================== rts/sm/Storage.c ===================================== @@ -1231,6 +1231,74 @@ allocateMightFail (Capability *cap, W_ n) */ #define MEMSET_SLOP_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) +/** + * Finish the capability's current pinned object accumulator block + * (cap->pinned_object_block), if any, and start a new one. + */ +static bdescr * +start_new_pinned_block(Capability *cap) +{ + bdescr *bd = cap->pinned_object_block; + + // stash the old block on cap->pinned_object_blocks. On the + // next GC cycle these objects will be moved to + // g0->large_objects. + if (bd != NULL) { + // add it to the allocation stats when the block is full + finishedNurseryBlock(cap, bd); + dbl_link_onto(bd, &cap->pinned_object_blocks); + } + + // We need to find another block. We could just allocate one, + // but that means taking a global lock and we really want to + // avoid that (benchmarks that allocate a lot of pinned + // objects scale really badly if we do this). + // + // See Note [Sources of Block Level Fragmentation] + // for a more complete history of this section. + bd = cap->pinned_object_empty; + if (bd == NULL) { + // The pinned block list is empty: allocate a fresh block (we can't fail + // here). + ACQUIRE_SM_LOCK; + bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE); + RELEASE_SM_LOCK; + } + + // Bump up the nursery pointer to avoid the pathological situation + // where a program is *only* allocating pinned objects. + // T4018 fails without this safety. + // This has the effect of counting a full pinned block in the same way + // as a full nursery block, so GCs will be triggered at the same interval + // if you are only allocating pinned data compared to normal allocations + // via allocate(). + bdescr *nbd = cap->r.rCurrentNursery->link; + if (nbd != NULL){ + newNurseryBlock(nbd); + cap->r.rCurrentNursery->link = nbd->link; + if (nbd->link != NULL) { + nbd->link->u.back = cap->r.rCurrentNursery; + } + dbl_link_onto(nbd, &cap->r.rNursery->blocks); + // Important for accounting purposes + if (cap->r.rCurrentAlloc){ + finishedNurseryBlock(cap, cap->r.rCurrentAlloc); + } + cap->r.rCurrentAlloc = nbd; + } + + cap->pinned_object_empty = bd->link; + newNurseryBlock(bd); + if (bd->link != NULL) { + bd->link->u.back = cap->pinned_object_empty; + } + initBdescr(bd, g0, g0); + + cap->pinned_object_block = bd; + bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED; + return bd; +} + /* --------------------------------------------------------------------------- Allocate a fixed/pinned object. @@ -1258,135 +1326,76 @@ allocateMightFail (Capability *cap, W_ n) StgPtr allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ align_off /*bytes*/) { - StgPtr p; - bdescr *bd; - // Alignment and offset have to be a power of two - ASSERT(alignment && !(alignment & (alignment - 1))); - ASSERT(alignment >= sizeof(W_)); - - ASSERT(!(align_off & (align_off - 1))); + CHECK(alignment && !(alignment & (alignment - 1))); + CHECK(!(align_off & (align_off - 1))); + // We don't support sub-word alignments + CHECK(alignment >= sizeof(W_)); + + bdescr *bd = cap->pinned_object_block; + if (bd == NULL) { + bd = start_new_pinned_block(cap); + } const StgWord alignment_w = alignment / sizeof(W_); + W_ off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + + // If the request is is smaller than LARGE_OBJECT_THRESHOLD then + // allocate into the pinned object accumulator. + if (n + off_w < LARGE_OBJECT_THRESHOLD/sizeof(W_)) { + // If the current pinned object block isn't large enough to hold the new + // object, get a new one. + if ((bd->free + off_w + n) > (bd->start + BLOCK_SIZE_W)) { + bd = start_new_pinned_block(cap); + + // The pinned_object_block remains attached to the capability + // until it is full, even if a GC occurs. We want this + // behaviour because otherwise the unallocated portion of the + // block would be forever slop, and under certain workloads + // (allocating a few ByteStrings per GC) we accumulate a lot + // of slop. + // + // So, the pinned_object_block is initially marked + // BF_EVACUATED so the GC won't touch it. When it is full, + // we place it on the large_objects list, and at the start of + // the next GC the BF_EVACUATED flag will be cleared, and the + // block will be promoted as usual (if anything in it is + // live). + + off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + } - // If the request is for a large object, then allocate() - // will give us a pinned object anyway. - if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - // For large objects we don't bother optimizing the number of words - // allocated for alignment reasons. Here we just allocate the maximum - // number of extra words we could possibly need to satisfy the alignment - // constraint. - p = allocateMightFail(cap, n + alignment_w - 1); - if (p == NULL) { - return NULL; - } else { - Bdescr(p)->flags |= BF_PINNED; - W_ off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); + // N.B. it is important that we account for the alignment padding + // when determining large-object-ness, lest we may over-fill the + // block. See #23400. + if (n + off_w < LARGE_OBJECT_THRESHOLD/sizeof(W_)) { + StgPtr p = bd->free; MEMSET_SLOP_W(p, 0, off_w); + n += off_w; p += off_w; - MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); + bd->free += n; + ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W); + accountAllocation(cap, n); return p; } } - bd = cap->pinned_object_block; - - W_ off_w = 0; - - if(bd) - off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); - - // If we don't have a block of pinned objects yet, or the current - // one isn't large enough to hold the new object, get a new one. - if (bd == NULL || (bd->free + off_w + n) > (bd->start + BLOCK_SIZE_W)) { - - // stash the old block on cap->pinned_object_blocks. On the - // next GC cycle these objects will be moved to - // g0->large_objects. - if (bd != NULL) { - // add it to the allocation stats when the block is full - finishedNurseryBlock(cap, bd); - dbl_link_onto(bd, &cap->pinned_object_blocks); - } - - // We need to find another block. We could just allocate one, - // but that means taking a global lock and we really want to - // avoid that (benchmarks that allocate a lot of pinned - // objects scale really badly if we do this). - // - // See Note [Sources of Block Level Fragmentation] - // for a more complete history of this section. - bd = cap->pinned_object_empty; - if (bd == NULL) { - // The pinned block list is empty: allocate a fresh block (we can't fail - // here). - ACQUIRE_SM_LOCK; - bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE); - RELEASE_SM_LOCK; - } - - // Bump up the nursery pointer to avoid the pathological situation - // where a program is *only* allocating pinned objects. - // T4018 fails without this safety. - // This has the effect of counting a full pinned block in the same way - // as a full nursery block, so GCs will be triggered at the same interval - // if you are only allocating pinned data compared to normal allocations - // via allocate(). - bdescr * nbd; - nbd = cap->r.rCurrentNursery->link; - if (nbd != NULL){ - newNurseryBlock(nbd); - cap->r.rCurrentNursery->link = nbd->link; - if (nbd->link != NULL) { - nbd->link->u.back = cap->r.rCurrentNursery; - } - dbl_link_onto(nbd, &cap->r.rNursery->blocks); - // Important for accounting purposes - if (cap->r.rCurrentAlloc){ - finishedNurseryBlock(cap, cap->r.rCurrentAlloc); - } - cap->r.rCurrentAlloc = nbd; - } - - - cap->pinned_object_empty = bd->link; - newNurseryBlock(bd); - if (bd->link != NULL) { - bd->link->u.back = cap->pinned_object_empty; - } - initBdescr(bd, g0, g0); - - cap->pinned_object_block = bd; - bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED; - - // The pinned_object_block remains attached to the capability - // until it is full, even if a GC occurs. We want this - // behaviour because otherwise the unallocated portion of the - // block would be forever slop, and under certain workloads - // (allocating a few ByteStrings per GC) we accumulate a lot - // of slop. - // - // So, the pinned_object_block is initially marked - // BF_EVACUATED so the GC won't touch it. When it is full, - // we place it on the large_objects list, and at the start of - // the next GC the BF_EVACUATED flag will be cleared, and the - // block will be promoted as usual (if anything in it is - // live). - - off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + // Otherwise handle the request as a large object + // For large objects we don't bother optimizing the number of words + // allocated for alignment reasons. Here we just allocate the maximum + // number of extra words we could possibly need to satisfy the alignment + // constraint. + StgPtr p = allocateMightFail(cap, n + alignment_w - 1); + if (p == NULL) { + return NULL; + } else { + Bdescr(p)->flags |= BF_PINNED; + off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); + MEMSET_SLOP_W(p, 0, off_w); + p += off_w; + MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); + return p; } - - p = bd->free; - - MEMSET_SLOP_W(p, 0, off_w); - - n += off_w; - p += off_w; - bd->free += n; - - accountAllocation(cap, n); - - return p; } /* ----------------------------------------------------------------------------- ===================================== testsuite/tests/rts/T23400.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main (main) where + +import Control.Monad +import Data.Array.Byte +import Data.Int +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + let szInt = 8 + sz = 101 + + cur0 <- newAlignedPinnedByteArray (sz*szInt) 4096 + old0 <- newAlignedPinnedByteArray (sz*szInt) 64 + + print (sizeofMutableByteArray cur0) + print (sizeofMutableByteArray old0) + + replicateM_ 20 $ do + forM_ [0 .. sz-1] $ \i -> do + putStrLn $ "I: " <> show i + writeByteArray cur0 i (2*i) + +newAlignedPinnedByteArray :: Int -> Int -> IO (MutableByteArray RealWorld) +newAlignedPinnedByteArray (I# sz) (I# align) = IO $ \s0 -> + case newAlignedPinnedByteArray# sz align s0 of + (# s1, ba #) -> (# s1, MutableByteArray ba #) + +sizeofMutableByteArray :: MutableByteArray RealWorld -> Int +sizeofMutableByteArray (MutableByteArray arr#) = I# (sizeofMutableByteArray# arr#) + +writeByteArray :: MutableByteArray RealWorld -> Int -> Int -> IO () +writeByteArray (MutableByteArray arr#) (I# i#) (I# x#) = + IO (\s# -> case writeIntArray# arr# i# x# s# of + s'# -> (# s'#, () #)) ===================================== testsuite/tests/rts/T23400.stdout ===================================== @@ -0,0 +1,2022 @@ +808 +808 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 ===================================== testsuite/tests/rts/all.T ===================================== @@ -594,3 +594,5 @@ test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) test('T23221', [js_skip, high_memory_usage, extra_run_opts('1500000'), unless(wordsize(64), skip), omit_ghci], compile_and_run, ['-O -with-rtsopts -T']) test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142']) + +test('T23400', [], compile_and_run, ['-with-rtsopts -A8k']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/083794b10dc27e9d97b62cc8b8eb4e1da162bf66...98185d5212fb0464dcbcca0ca2c33326a7a002e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/083794b10dc27e9d97b62cc8b8eb4e1da162bf66...98185d5212fb0464dcbcca0ca2c33326a7a002e8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:29:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:29:13 -0400 Subject: [Git][ghc/ghc][master] ghc-heap: Support for BLOCKING_QUEUE closures Message-ID: <64a278c92e139_3cb823ab89a0c16031e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - rts/Heap.c Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -317,8 +317,9 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do _ -> fail $ "Expected at least 3 ptrs to MVAR, found " ++ show (length pts) - BLOCKING_QUEUE -> - pure $ OtherClosure itbl pts rawHeapWords + BLOCKING_QUEUE + | [_link, bh, _owner, msg] <- pts -> + pure $ BlockingQueueClosure itbl _link bh _owner msg WEAK -> case pts of pts0 : pts1 : pts2 : pts3 : rest -> pure $ WeakClosure ===================================== rts/Heap.c ===================================== @@ -245,6 +245,16 @@ StgWord collect_pointers(StgClosure *closure, StgClosure *ptrs[]) { // See the note in AP_STACK about the stack chunk. break; + case BLOCKING_QUEUE: + { + StgBlockingQueue *bq = (StgBlockingQueue *) closure; + ptrs[nptrs++] = (StgClosure *) bq->link; + ptrs[nptrs++] = bq->bh; + ptrs[nptrs++] = (StgClosure *) bq->owner; + ptrs[nptrs++] = (StgClosure *) bq->queue; + break; + } + default: fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", closure_type_names[info->type]); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4aac0540a8180be0ac6b497c5617807031e0dfa4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4aac0540a8180be0ac6b497c5617807031e0dfa4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:29:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:29:53 -0400 Subject: [Git][ghc/ghc][master] Add some structured diagnostics in Tc/Validity.hs Message-ID: <64a278f19540e_3cb823475541662ed@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 24 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/deriving/should_fail/T8165_fail2.stderr - testsuite/tests/indexed-types/should_compile/T9085.stderr - testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr - testsuite/tests/indexed-types/should_fail/T10817.stderr - testsuite/tests/indexed-types/should_fail/T15172.stderr - testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr - testsuite/tests/quantified-constraints/T15231.stderr - testsuite/tests/quantified-constraints/T15316.stderr - testsuite/tests/typecheck/should_compile/T15473.stderr - testsuite/tests/typecheck/should_compile/T6018.stderr - testsuite/tests/typecheck/should_compile/tc265.stderr - testsuite/tests/typecheck/should_fail/T15552a.stderr - testsuite/tests/typecheck/should_fail/T19187a.stderr - testsuite/tests/typecheck/should_fail/fd-loop.stderr - testsuite/tests/typecheck/should_fail/tcfail108.stderr - testsuite/tests/typecheck/should_fail/tcfail154.stderr - testsuite/tests/typecheck/should_fail/tcfail157.stderr - testsuite/tests/typecheck/should_fail/tcfail214.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -152,6 +152,10 @@ instance Diagnostic TcRnMessage where hang (text "Inaccessible code in") 2 (ppr (ic_info implic)) $$ pprSolverReportWithCtxt contra + TcRnInaccessibleCoAxBranch fam_tc cur_branch + -> mkSimpleDecorated $ + text "Type family instance equation is overlapped:" $$ + nest 2 (pprCoAxBranchUser fam_tc cur_branch) TcRnTypeDoesNotHaveFixedRuntimeRep ty prov (ErrInfo extra supplementary) -> mkDecorated [pprTypeDoesNotHaveFixedRuntimeRep ty prov, extra, supplementary] TcRnImplicitLift id_or_name ErrInfo{..} @@ -1833,7 +1837,8 @@ instance Diagnostic TcRnMessage where TcRnIllegalQuasiQuotes -> mkSimpleDecorated $ text "Quasi-quotes are not permitted without QuasiQuotes" TcRnTHError err -> pprTHError err - + TcRnPatersonCondFailure reason ctxt lhs rhs -> + mkSimpleDecorated $ pprPatersonCondFailure reason ctxt lhs rhs TcRnIllegalInvisTyVarBndr bndr -> mkSimpleDecorated $ hang (text "Illegal invisible type variable binder:") @@ -1877,6 +1882,8 @@ instance Diagnostic TcRnMessage where -> WarningWithFlag Opt_WarnRedundantConstraints TcRnInaccessibleCode {} -> WarningWithFlag Opt_WarnInaccessibleCode + TcRnInaccessibleCoAxBranch {} + -> WarningWithFlag Opt_WarnInaccessibleCode TcRnTypeDoesNotHaveFixedRuntimeRep{} -> ErrorWithoutFlag TcRnImplicitLift{} @@ -2485,6 +2492,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnImplicitRhsQuantification{} -> WarningWithFlag Opt_WarnImplicitRhsQuantification + TcRnPatersonCondFailure{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -2500,6 +2509,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInaccessibleCode{} -> noHints + TcRnInaccessibleCoAxBranch{} + -> noHints TcRnTypeDoesNotHaveFixedRuntimeRep{} -> noHints TcRnImplicitLift{} @@ -3154,6 +3165,8 @@ instance Diagnostic TcRnMessage where -> [SuggestAddStandaloneKindSignature name] TcRnImplicitRhsQuantification kv -> [SuggestBindTyVarOnLhs (unLoc kv)] + TcRnPatersonCondFailure{} + -> [suggestExtension LangExt.UndecidableInstances] diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode @@ -6218,6 +6231,45 @@ addTopDeclsErrorHints = \case AddTopDeclsRunSpliceFailure {} -> noHints +-------------------------------------------------------------------------------- + +pprPatersonCondFailure :: + PatersonCondFailure -> PatersonCondFailureContext -> Type -> Type -> SDoc +pprPatersonCondFailure (PCF_TyVar tvs) InInstanceDecl lhs rhs = + hang (occMsg tvs) + 2 (sep [ text "in the constraint" <+> quotes (ppr lhs) + , text "than in the instance head" <+> quotes (ppr rhs) ]) + where + occMsg tvs = text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) + <+> pp_occurs <+> text "more often" + pp_occurs | isSingleton tvs = text "occurs" + | otherwise = text "occur" +pprPatersonCondFailure (PCF_TyVar tvs) InTyFamEquation lhs rhs = + hang (occMsg tvs) + 2 (sep [ text "in the type-family application" <+> quotes (ppr rhs) + , text "than in the LHS of the family instance" <+> quotes (ppr lhs) ]) + where + occMsg tvs = text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) + <+> pp_occurs <+> text "more often" + pp_occurs | isSingleton tvs = text "occurs" + | otherwise = text "occur" +pprPatersonCondFailure PCF_Size InInstanceDecl lhs rhs = + hang (text "The constraint" <+> quotes (ppr lhs)) + 2 (sep [ text "is no smaller than", pp_rhs ]) + where pp_rhs = text "the instance head" <+> quotes (ppr rhs) +pprPatersonCondFailure PCF_Size InTyFamEquation lhs rhs = + hang (text "The type-family application" <+> quotes (ppr rhs)) + 2 (sep [ text "is no smaller than", pp_lhs ]) + where pp_lhs = text "the LHS of the family instance" <+> quotes (ppr lhs) +pprPatersonCondFailure (PCF_TyFam tc) InInstanceDecl lhs _rhs = + hang (text "Illegal use of type family" <+> quotes (ppr tc)) + 2 (text "in the constraint" <+> quotes (ppr lhs)) +pprPatersonCondFailure (PCF_TyFam tc) InTyFamEquation _lhs rhs = + hang (text "Illegal nested use of type family" <+> quotes (ppr tc)) + 2 (text "in the arguments of the type-family application" <+> quotes (ppr rhs)) + + + -------------------------------------------------------------------------------- pprZonkerMessage :: ZonkerMessage -> SDoc ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -167,7 +167,8 @@ import GHC.Tc.Types.Origin ( CtOrigin (ProvCtxtOrigin), SkolemInfoAnon (SigSkol) , UserTypeCtxt (PatSynCtxt), TyVarBndrs, TypedThing , FixedRuntimeRepOrigin(..), InstanceWhat ) import GHC.Tc.Types.Rank (Rank) -import GHC.Tc.Utils.TcType (TcType, TcSigmaType, TcPredType) +import GHC.Tc.Utils.TcType (TcType, TcSigmaType, TcPredType, + PatersonCondFailure, PatersonCondFailureContext) import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Avail @@ -364,7 +365,19 @@ data TcRnMessage where TcRnInaccessibleCode :: Implication -- ^ The implication containing a contradiction. -> SolverReportWithCtxt -- ^ The contradiction. -> TcRnMessage + {-| TcRnInaccessibleCoAxBranch is a warning that is emitted when a closed type family has a + branch which is inaccessible due to a more general, prior branch. + Example: + type family F a where + F a = Int + F Bool = Bool + Test cases: T9085, T14066a, T9085, T6018, tc265, + + -} + TcRnInaccessibleCoAxBranch :: TyCon -- ^ The type family's constructor + -> CoAxBranch -- ^ The inaccessible branch + -> TcRnMessage {-| A type which was expected to have a fixed runtime representation does not have a fixed runtime representation. @@ -4120,6 +4133,21 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnPatersonCondFailure is an error that occurs when an instance + declaration fails to conform to the Paterson conditions. Which particular condition + fails depends on the constructor of PatersonCondFailure + See Note [Paterson conditions]. + + Test cases: + T15231, tcfail157, T15316, T19187a, fd-loop, tcfail108, tcfail154, + T15172, tcfail214 + -} + TcRnPatersonCondFailure + :: PatersonCondFailure -- ^ the failed Paterson Condition + -> PatersonCondFailureContext + -> Type -- ^ the LHS + -> Type -- ^ the RHS + -> TcRnMessage {-| TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly quantifies over a type variable that occurs free on the RHS of the type declaration ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -117,7 +117,8 @@ module GHC.Tc.Utils.TcType ( --------------------------------- -- Patersons sizes - PatersonSize(..), PatersonSizeFailure(..), + PatersonSize(..), PatersonCondFailure(..), + PatersonCondFailureContext(..), ltPatersonSize, pSizeZero, pSizeOne, pSizeType, pSizeTypeX, pSizeTypes, @@ -2097,17 +2098,28 @@ The type-family termination test, in GHC.Tc.Validity.checkFamInstRhs, already has a separate call to isStuckTypeFamily, so the `F` above will still be accepted. -} - --- | Why was the LHS 'PatersonSize' not strictly smaller than the RHS 'PatersonSize'? +-- | Why did the Paterson conditions fail; that is, why +-- was the context P not Paterson-smaller than the head H? -- -- See Note [Paterson conditions] in GHC.Tc.Validity. -data PatersonSizeFailure - -- | Either side contains a type family. - = PSF_TyFam TyCon - -- | The size of the LHS is not strictly less than the size of the RHS. - | PSF_Size - -- | These type variables appear more often in the LHS than in the RHS. - | PSF_TyVar [TyVar] -- ^ no duplicates in this list +data PatersonCondFailure + -- | Some type variables occur more often in P than in H. + -- See (PC1) in Note [Paterson conditions] in GHC.Tc.Validity. + = PCF_TyVar + [TyVar] -- ^ the type variables which appear more often in the context + -- | P is not smaller in size than H. + -- See (PC2) in Note [Paterson conditions] in GHC.Tc.Validity. + | PCF_Size + -- | P contains a type family. + -- See (PC3) in Note [Paterson conditions] in GHC.Tc.Validity. + | PCF_TyFam + TyCon -- ^ the type constructor of the type family + +-- | Indicates whether a Paterson condition failure occurred in an instance declaration or a type family equation. +-- Useful for differentiating context in error messages. +data PatersonCondFailureContext + = InInstanceDecl + | InTyFamEquation -------------------------------------- @@ -2119,7 +2131,6 @@ data PatersonSizeFailure data PatersonSize -- | The type mentions a type family, so the size could be anything. = PS_TyFam TyCon - -- | The type does not mention a type family. | PS_Vanilla { ps_tvs :: [TyVar] -- ^ free tyvars, including repetitions; , ps_size :: Int -- ^ number of type constructors and variables @@ -2142,14 +2153,14 @@ pSizeOne = PS_Vanilla { ps_tvs = [], ps_size = 1 } -- - @Just ps_fail@ otherwise; @ps_fail@ says what went wrong. ltPatersonSize :: PatersonSize -> PatersonSize - -> Maybe PatersonSizeFailure + -> Maybe PatersonCondFailure ltPatersonSize (PS_Vanilla { ps_tvs = tvs1, ps_size = s1 }) (PS_Vanilla { ps_tvs = tvs2, ps_size = s2 }) - | s1 >= s2 = Just PSF_Size - | bad_tvs@(_:_) <- noMoreTyVars tvs1 tvs2 = Just (PSF_TyVar bad_tvs) + | s1 >= s2 = Just PCF_Size + | bad_tvs@(_:_) <- noMoreTyVars tvs1 tvs2 = Just (PCF_TyVar bad_tvs) | otherwise = Nothing -- OK! -ltPatersonSize (PS_TyFam tc) _ = Just (PSF_TyFam tc) -ltPatersonSize _ (PS_TyFam tc) = Just (PSF_TyFam tc) +ltPatersonSize (PS_TyFam tc) _ = Just (PCF_TyFam tc) +ltPatersonSize _ (PS_TyFam tc) = Just (PCF_TyFam tc) -- NB: this last equation is never taken when checking instances, because -- type families are disallowed in instance heads. -- ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -2049,40 +2049,9 @@ checkInstTermination theta head_pred where check2 pred_size = case pred_size `ltPatersonSize` head_size of - Just ps_failure -> failWithTc $ mkInstSizeError ps_failure head_pred pred + Just pc_failure -> failWithTc $ TcRnPatersonCondFailure pc_failure InInstanceDecl pred head_pred Nothing -> return () - -mkInstSizeError :: PatersonSizeFailure -> TcPredType -> TcPredType -> TcRnMessage -mkInstSizeError ps_failure head_pred pred - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ main_msg - , parens undecidableMsg ] - where - pp_head = text "instance head" <+> quotes (ppr head_pred) - pp_pred = text "constraint" <+> quotes (ppr pred) - - main_msg = case ps_failure of - PSF_TyFam tc -> -- See (PC3) of Note [Paterson conditions] - hang (text "Illegal use of type family" <+> quotes (ppr tc)) - 2 (text "in the" <+> pp_pred) - PSF_TyVar tvs -> hang (occMsg tvs) - 2 (sep [ text "in the" <+> pp_pred - , text "than in the" <+> pp_head ]) - PSF_Size -> hang (text "The" <+> pp_pred) - 2 (sep [ text "is no smaller than", text "the" <+> pp_head ]) - -occMsg :: [TyVar] -> SDoc -occMsg tvs = text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) - <+> pp_occurs <+> text "more often" - where - pp_occurs | isSingleton tvs = text "occurs" - | otherwise = text "occur" - -undecidableMsg :: SDoc -undecidableMsg = text "Use UndecidableInstances to permit this" - - {- Note [Instances and constraint synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Currently, we don't allow instances for constraint synonyms at all. @@ -2137,8 +2106,7 @@ checkValidCoAxiom ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_branches = branches }) -- (b) failure of injectivity check_branch_compat prev_branches cur_branch | cur_branch `isDominatedBy` prev_branches - = do { let dia = mkTcRnUnknownMessage $ - mkPlainDiagnostic WarningWithoutFlag noHints (inaccessibleCoAxBranch fam_tc cur_branch) + = do { let dia = TcRnInaccessibleCoAxBranch fam_tc cur_branch ; addDiagnosticAt (coAxBranchSpan cur_branch) dia ; return prev_branches } | otherwise @@ -2272,7 +2240,7 @@ checkValidAssocTyFamDeflt fam_tc pats = let dups = findDupsEq ((==) `on` fst) cpt_tvs_vis in traverse_ (\d -> let (pat_tv, pat_vis) = NE.head d in failWithTc $ - mkTcRnUnknownMessage $ mkPlainError noHints $ + mkTcRnUnknownMessage $ mkPlainError noHints $ pprWithExplicitKindsWhen (isInvisibleForAllTyFlag pat_vis) $ hang (text "Illegal duplicate variable" <+> quotes (ppr pat_tv) <+> text "in:") @@ -2305,30 +2273,11 @@ checkFamInstRhs lhs_tc lhs_tys famInsts lhs_size = pSizeTypes lhs_tys check (tc, tys) | not (isStuckTypeFamily tc) -- (TF1) - , Just ps_failure <- pSizeTypes tys `ltPatersonSize` lhs_size -- (TF2) - = Just $ mkFamSizeError ps_failure (TyConApp lhs_tc lhs_tys) (TyConApp tc tys) + , Just pc_failure <- pSizeTypes tys `ltPatersonSize` lhs_size -- (TF2) + = Just $ TcRnPatersonCondFailure pc_failure InTyFamEquation (TyConApp lhs_tc lhs_tys) (TyConApp tc tys) | otherwise = Nothing -mkFamSizeError :: PatersonSizeFailure -> Type -> Type -> TcRnMessage -mkFamSizeError ps_failure lhs fam_call - = mkTcRnUnknownMessage $ mkPlainError noHints $ - vcat [ main_msg - , parens undecidableMsg ] - where - pp_lhs = text "LHS of the family instance" <+> quotes (ppr lhs) - pp_call = text "type-family application" <+> quotes (ppr fam_call) - - main_msg = case ps_failure of - PSF_TyFam tc -> -- See (PC3) of Note [Paterson conditions] - hang (text "Illegal nested use of type family" <+> quotes (ppr tc)) - 2 (text "in the arguments of the" <+> pp_call) - PSF_TyVar tvs -> hang (occMsg tvs) - 2 (sep [ text "in the" <+> pp_call - , text "than in the" <+> pp_lhs ]) - PSF_Size -> hang (text "The" <+> pp_call) - 2 (sep [ text "is no smaller than", text "the" <+> pp_lhs ]) - ----------------- checkFamPatBinders :: TyCon -> [TcTyVar] -- Bound on LHS of family instance @@ -2425,13 +2374,6 @@ checkValidTypePats tc pat_ty_args <+> quotes (ppr ty) <+> text "in instance" <> colon) 2 (ppr inst_ty) --- Error messages - -inaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc -inaccessibleCoAxBranch fam_tc cur_branch - = text "Type family instance equation is overlapped:" $$ - nest 2 (pprCoAxBranchUser fam_tc cur_branch) - ------------------------- checkConsistentFamInst :: AssocInstInfo -> TyCon -- ^ Family tycon ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -332,6 +332,7 @@ type family GhcDiagnosticCode c = n | n -> c where -- Typechecker/renamer diagnostic codes GhcDiagnosticCode "TcRnRedundantConstraints" = 30606 GhcDiagnosticCode "TcRnInaccessibleCode" = 40564 + GhcDiagnosticCode "TcRnInaccessibleCoAxBranch" = 28129 GhcDiagnosticCode "TcRnTypeDoesNotHaveFixedRuntimeRep" = 18478 GhcDiagnosticCode "TcRnImplicitLift" = 00846 GhcDiagnosticCode "TcRnUnusedPatternBinds" = 61367 @@ -593,6 +594,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 + GhcDiagnosticCode "TcRnPatersonCondFailure" = 22979 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== testsuite/tests/dependent/should_compile/T14066a.stderr ===================================== @@ -1,5 +1,5 @@ -T14066a.hs:14:3: warning: +T14066a.hs:14:3: warning: [GHC-28129] [-Winaccessible-code (in -Wdefault)] Type family instance equation is overlapped: forall {c} {x :: c} {d} {y :: d}. Bar x y = Bool -- Defined at T14066a.hs:14:3 ===================================== testsuite/tests/deriving/should_fail/T8165_fail2.stderr ===================================== @@ -1,6 +1,6 @@ -T8165_fail2.hs:9:12: error: +T8165_fail2.hs:9:12: error: [GHC-22979] • The type-family application ‘T Loop’ is no smaller than the LHS of the family instance ‘T Loop’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘C Loop’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/indexed-types/should_compile/T9085.stderr ===================================== @@ -1,4 +1,4 @@ -T9085.hs:7:3: Warning: +T9085.hs:7:3: warning: [GHC-28129] [-Winaccessible-code (in -Wdefault)] Type family instance equation is overlapped: F Bool = Bool -- Defined at T9085.hs:7:3 ===================================== testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr ===================================== @@ -1,18 +1,18 @@ -NotRelaxedExamples.hs:9:15: error: +NotRelaxedExamples.hs:9:15: error: [GHC-22979] • Illegal nested use of type family ‘F1’ in the arguments of the type-family application ‘F1 (F1 Char)’ - (Use UndecidableInstances to permit this) • In the type instance declaration for ‘F1’ + Suggested fix: Perhaps you intended to use UndecidableInstances -NotRelaxedExamples.hs:10:15: error: +NotRelaxedExamples.hs:10:15: error: [GHC-22979] • The type-family application ‘F2 [x]’ is no smaller than the LHS of the family instance ‘F2 [x]’ - (Use UndecidableInstances to permit this) • In the type instance declaration for ‘F2’ + Suggested fix: Perhaps you intended to use UndecidableInstances -NotRelaxedExamples.hs:11:15: error: +NotRelaxedExamples.hs:11:15: error: [GHC-22979] • The type-family application ‘F3 [Char]’ is no smaller than the LHS of the family instance ‘F3 Bool’ - (Use UndecidableInstances to permit this) • In the type instance declaration for ‘F3’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/indexed-types/should_fail/T10817.stderr ===================================== @@ -1,7 +1,7 @@ -T10817.hs:9:3: error: +T10817.hs:9:3: error: [GHC-22979] • The type-family application ‘F a’ is no smaller than the LHS of the family instance ‘F a’ - (Use UndecidableInstances to permit this) • In the default type instance declaration for ‘F’ In the class declaration for ‘C’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/indexed-types/should_fail/T15172.stderr ===================================== @@ -1,5 +1,5 @@ -T15172.hs:11:10: error: +T15172.hs:11:10: error: [GHC-22979] • Illegal use of type family ‘F’ in the constraint ‘F a’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘C [[a]]’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr ===================================== @@ -1,19 +1,19 @@ -TyFamUndec.hs:6:15: error: +TyFamUndec.hs:6:15: error: [GHC-22979] • Variable ‘b’ occurs more often in the type-family application ‘T (b, b)’ than in the LHS of the family instance ‘T (a, [b])’ - (Use UndecidableInstances to permit this) • In the type instance declaration for ‘T’ + Suggested fix: Perhaps you intended to use UndecidableInstances -TyFamUndec.hs:7:15: error: +TyFamUndec.hs:7:15: error: [GHC-22979] • The type-family application ‘T (a, Maybe b)’ is no smaller than the LHS of the family instance ‘T (a, Maybe b)’ - (Use UndecidableInstances to permit this) • In the type instance declaration for ‘T’ + Suggested fix: Perhaps you intended to use UndecidableInstances -TyFamUndec.hs:8:15: error: +TyFamUndec.hs:8:15: error: [GHC-22979] • Illegal nested use of type family ‘T’ in the arguments of the type-family application ‘T (a, T b)’ - (Use UndecidableInstances to permit this) • In the type instance declaration for ‘T’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/quantified-constraints/T15231.stderr ===================================== @@ -1,7 +1,7 @@ -T15231.hs:15:10: error: +T15231.hs:15:10: error: [GHC-22979] • Variable ‘c’ occurs more often in the constraint ‘c’ than in the instance head ‘Z a’ - (Use UndecidableInstances to permit this) • In the quantified constraint ‘c => Z a’ In the instance declaration for ‘Z (ECC c a)’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/quantified-constraints/T15316.stderr ===================================== @@ -1,6 +1,6 @@ -T15316.hs:20:13: error: +T15316.hs:20:13: error: [GHC-22979] • The constraint ‘c’ is no smaller than the instance head ‘c’ - (Use UndecidableInstances to permit this) • In the quantified constraint ‘c => c’ In the type signature: subsume' :: Proxy c -> ((c => c) => r) -> r + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_compile/T15473.stderr ===================================== @@ -1,9 +1,9 @@ -T15473.hs:11:3: error: +T15473.hs:11:3: error: [GHC-22979] • Variable ‘a’ occurs more often in the type-family application ‘Undefined’ than in the LHS of the family instance ‘LetInterleave xs t ts is y z’ - (Use UndecidableInstances to permit this) • In the equations for closed type family ‘LetInterleave’ In the type family declaration for ‘LetInterleave’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_compile/T6018.stderr ===================================== @@ -2,10 +2,10 @@ [2 of 3] Compiling T6018a ( T6018a.hs, T6018a.o ) [3 of 3] Compiling T6018 ( T6018.hs, T6018.o ) -T6018.hs:109:5: warning: +T6018.hs:109:5: warning: [GHC-28129] [-Winaccessible-code (in -Wdefault)] Type family instance equation is overlapped: Foo Bool = Bool -- Defined at T6018.hs:109:5 -T6018.hs:116:5: warning: +T6018.hs:116:5: warning: [GHC-28129] [-Winaccessible-code (in -Wdefault)] Type family instance equation is overlapped: Bar Bool = Char -- Defined at T6018.hs:116:5 ===================================== testsuite/tests/typecheck/should_compile/tc265.stderr ===================================== @@ -1,4 +1,4 @@ -tc265.hs:8:3: warning: +tc265.hs:8:3: warning: [GHC-28129] [-Winaccessible-code (in -Wdefault)] Type family instance equation is overlapped: F (T Int) = Bool -- Defined at tc265.hs:8:3 ===================================== testsuite/tests/typecheck/should_fail/T15552a.stderr ===================================== @@ -1,24 +1,24 @@ -T15552a.hs:26:9: error: +T15552a.hs:26:9: error: [GHC-22979] • Illegal nested use of type family ‘FirstEntryOfVal’ in the arguments of the type-family application ‘GetEntryOfVal (FirstEntryOfVal v kvs)’ - (Use UndecidableInstances to permit this) • In the equations for closed type family ‘FirstEntryOfVal’ In the type family declaration for ‘FirstEntryOfVal’ + Suggested fix: Perhaps you intended to use UndecidableInstances -T15552a.hs:26:9: error: +T15552a.hs:26:9: error: [GHC-22979] • Illegal nested use of type family ‘FirstEntryOfVal’ in the arguments of the type-family application ‘EntryOfValKey (FirstEntryOfVal v kvs)’ - (Use UndecidableInstances to permit this) • In the equations for closed type family ‘FirstEntryOfVal’ In the type family declaration for ‘FirstEntryOfVal’ + Suggested fix: Perhaps you intended to use UndecidableInstances -T15552a.hs:26:9: error: +T15552a.hs:26:9: error: [GHC-22979] • Illegal nested use of type family ‘FirstEntryOfVal’ in the arguments of the type-family application ‘EntryOfValKey (FirstEntryOfVal v kvs)’ - (Use UndecidableInstances to permit this) • In the equations for closed type family ‘FirstEntryOfVal’ In the type family declaration for ‘FirstEntryOfVal’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_fail/T19187a.stderr ===================================== @@ -1,6 +1,6 @@ -T19187a.hs:7:10: error: +T19187a.hs:7:10: error: [GHC-22979] • The constraint ‘Eq Int’ is no smaller than the instance head ‘Eq T’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘Eq T’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_fail/fd-loop.stderr ===================================== @@ -1,6 +1,6 @@ -fd-loop.hs:12:10: error: +fd-loop.hs:12:10: error: [GHC-22979] • The constraint ‘C a b’ is no smaller than the instance head ‘Eq (T a)’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘Eq (T a)’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_fail/tcfail108.stderr ===================================== @@ -1,6 +1,6 @@ -tcfail108.hs:7:10: error: +tcfail108.hs:7:10: error: [GHC-22979] • The constraint ‘Eq (f (Rec f))’ is no smaller than the instance head ‘Eq (Rec f)’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘Eq (Rec f)’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_fail/tcfail154.stderr ===================================== @@ -1,6 +1,6 @@ -tcfail154.hs:13:10: error: +tcfail154.hs:13:10: error: [GHC-22979] • The constraint ‘C a a’ is no smaller than the instance head ‘Eq (T a)’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘Eq (T a)’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_fail/tcfail157.stderr ===================================== @@ -1,7 +1,7 @@ -tcfail157.hs:27:10: error: +tcfail157.hs:27:10: error: [GHC-22979] • Variable ‘b’ occurs more often in the constraint ‘E m a b’ than in the instance head ‘Foo m (a -> ())’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘Foo m (a -> ())’ + Suggested fix: Perhaps you intended to use UndecidableInstances ===================================== testsuite/tests/typecheck/should_fail/tcfail214.stderr ===================================== @@ -1,5 +1,5 @@ -tcfail214.hs:9:10: error: +tcfail214.hs:9:10: error: [GHC-22979] • Illegal use of type family ‘F’ in the constraint ‘F a’ - (Use UndecidableInstances to permit this) • In the instance declaration for ‘C [a]’ + Suggested fix: Perhaps you intended to use UndecidableInstances View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03f941f45607a5ee52ca53a358333bbb41ddb1bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03f941f45607a5ee52ca53a358333bbb41ddb1bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:30:06 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 03:30:06 -0400 Subject: [Git][ghc/ghc][wip/T22010] configure: Don't use ld.gold on i386 Message-ID: <64a278fecbb30_3cb823ab89a0c166496@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 4f85511a by Ben Gamari at 2023-07-03T09:29:55+02:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 1 changed file: - m4/find_ld.m4 Changes: ===================================== m4/find_ld.m4 ===================================== @@ -21,10 +21,19 @@ AC_DEFUN([FIND_LD],[ return fi + case $CPU in + i386) + # We refuse to use ld.gold on i386 due to #23579, which we don't + # have a good autoconf check for. + linkers="ld.lld ld" ;; + *) + linkers="ld.lld ld.gold ld" ;; + esac + # Manually iterate over possible names since we want to ensure that, e.g., # if ld.lld is installed but gcc doesn't support -fuse-ld=lld, that we # then still try ld.gold and -fuse-ld=gold. - for possible_ld in ld.lld ld.gold ld; do + for possible_ld in $linkers; do TmpLd="" # In case the user set LD AC_CHECK_TARGET_TOOL([TmpLd], [$possible_ld]) if test "x$TmpLd" = "x"; then continue; fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f85511a1616a61fac2dee6f8414423205a01a6d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f85511a1616a61fac2dee6f8414423205a01a6d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:30:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:30:39 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Add failing test case for #23492 Message-ID: <64a2791f12abb_3cb823475041711db@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 5 changed files: - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/TyCl/Utils.hs - + testsuite/tests/hiefile/should_run/T23492.hs - + testsuite/tests/hiefile/should_run/T23492.stdout - testsuite/tests/hiefile/should_run/all.T Changes: ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -18,8 +18,9 @@ module GHC.Rename.Utils ( warnForallIdentifier, checkUnusedRecordWildcard, badQualBndrErr, typeAppErr, badFieldConErr, - wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType, - genHsIntegralLit, genHsTyLit, genSimpleConPat, + wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genLHsApp, + genAppType, + genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat, genVarPat, genWildPat, genSimpleFunBind, genFunBind, @@ -572,6 +573,9 @@ genHsApps fun args = foldl genHsApp (genHsVar fun) args genHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn genHsApp fun arg = HsApp noAnn (wrapGenSpan fun) arg +genLHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn +genLHsApp fun arg = wrapGenSpan (genHsApp fun arg) + genLHsVar :: Name -> LHsExpr GhcRn genLHsVar nm = wrapGenSpan $ genHsVar nm @@ -581,8 +585,11 @@ genHsVar nm = HsVar noExtField $ wrapGenSpan nm genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) noHsTok (mkEmptyWildCardBndrs (wrapGenSpan ty)) +genLHsLit :: HsLit GhcRn -> LocatedAn an (HsExpr GhcRn) +genLHsLit = wrapGenSpan . HsLit noAnn + genHsIntegralLit :: IntegralLit -> LocatedAn an (HsExpr GhcRn) -genHsIntegralLit lit = wrapGenSpan $ HsLit noAnn (HsInt noExtField lit) +genHsIntegralLit = genLHsLit . HsInt noExtField genHsTyLit :: FastString -> HsType GhcRn genHsTyLit = HsTyLit noExtField . HsStrTy NoSourceText ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -64,6 +64,8 @@ import GHC.Data.FastString import GHC.Unit.Module +import GHC.Rename.Utils (genHsVar, genLHsApp, genLHsLit, genWildPat) + import GHC.Types.Basic import GHC.Types.FieldLabel import GHC.Types.SrcLoc @@ -954,10 +956,10 @@ mkOneRecordSelector all_cons idDetails fl has_sel -- mentions this particular record selector deflt | all dealt_with all_cons = [] | otherwise = [mkSimpleMatch CaseAlt - [L loc' (WildPat noExtField)] - (mkHsApp (L loc' (HsVar noExtField - (L locn (getName rEC_SEL_ERROR_ID)))) - (L loc' (HsLit noComments msg_lit)))] + [genWildPat] + (genLHsApp + (genHsVar (getName rEC_SEL_ERROR_ID)) + (genLHsLit msg_lit))] -- Do not add a default case unless there are unmatched -- constructors. We must take account of GADTs, else we ===================================== testsuite/tests/hiefile/should_run/T23492.hs ===================================== @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module Main where + +import TestUtils +import qualified Data.Map as M +import Data.Foldable + +-- regression test for https://gitlab.haskell.org/ghc/ghc/-/issues/23492 +data PartialFieldSelector + = NoFields + | PartialField { a :: Bool } +-- ^ +-- 1 + +f :: PartialFieldSelector -> Bool +f x = a x +-- ^ +-- 2 + +g :: PartialFieldSelector -> Bool +g x = x.a +-- ^^^ +-- 345 + +p1, p2, p3, p4, p5 :: (Int,Int) +p1 = (13,20) +p2 = (18,7) +p3 = (23,7) +p4 = (23,8) +p5 = (23,9) + +selectPoint' :: HieFile -> (Int,Int) -> HieAST Int +selectPoint' hf loc = + maybe (error "point not found") id $ selectPoint hf loc + +main = do + (df, hf) <- readTestHie "T23492.hie" + forM_ [p1,p2,p3,p4,p5] $ \point -> do + putStr $ "At " ++ show point ++ ", got type: " + let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point + forM_ types $ \typ -> do + putStrLn (renderHieType df $ recoverFullType typ (hie_types hf)) ===================================== testsuite/tests/hiefile/should_run/T23492.stdout ===================================== @@ -0,0 +1,7 @@ +At (13,20), got type: PartialFieldSelector -> Bool +Bool +PartialFieldSelector +At (18,7), got type: PartialFieldSelector -> Bool +At (23,7), got type: PartialFieldSelector +At (23,8), got type: PartialFieldSelector +At (23,9), got type: Bool ===================================== testsuite/tests/hiefile/should_run/all.T ===================================== @@ -1,5 +1,6 @@ test('PatTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('HieQueries', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T20341', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('T23492', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('RecordDotTypes', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('SpliceTypes', [req_th, 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/03f941f45607a5ee52ca53a358333bbb41ddb1bc...dd782343f131cfd983a7fb2431d9d4a9ae497551 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03f941f45607a5ee52ca53a358333bbb41ddb1bc...dd782343f131cfd983a7fb2431d9d4a9ae497551 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:30:51 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 03:30:51 -0400 Subject: [Git][ghc/ghc][wip/T22010] Deleted 1 commit: configure: Don't use ld.gold on i386 Message-ID: <64a2792bd48c6_3cb823475b8171376@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 4f85511a by Ben Gamari at 2023-07-03T09:29:55+02:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 1 changed file: - m4/find_ld.m4 Changes: ===================================== m4/find_ld.m4 ===================================== @@ -21,10 +21,19 @@ AC_DEFUN([FIND_LD],[ return fi + case $CPU in + i386) + # We refuse to use ld.gold on i386 due to #23579, which we don't + # have a good autoconf check for. + linkers="ld.lld ld" ;; + *) + linkers="ld.lld ld.gold ld" ;; + esac + # Manually iterate over possible names since we want to ensure that, e.g., # if ld.lld is installed but gcc doesn't support -fuse-ld=lld, that we # then still try ld.gold and -fuse-ld=gold. - for possible_ld in ld.lld ld.gold ld; do + for possible_ld in $linkers; do TmpLd="" # In case the user set LD AC_CHECK_TARGET_TOOL([TmpLd], [$possible_ld]) if test "x$TmpLd" = "x"; then continue; fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f85511a1616a61fac2dee6f8414423205a01a6d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f85511a1616a61fac2dee6f8414423205a01a6d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:31:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:31:19 -0400 Subject: [Git][ghc/ghc][master] Add regression test for #23549 Message-ID: <64a27947132f4_3cb8234752c174838@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 4 changed files: - + testsuite/tests/unlifted-datatypes/should_run/T23549.hs - + testsuite/tests/unlifted-datatypes/should_run/T23549.stdout - + testsuite/tests/unlifted-datatypes/should_run/T23549a.hs - testsuite/tests/unlifted-datatypes/should_run/all.T Changes: ===================================== testsuite/tests/unlifted-datatypes/should_run/T23549.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE GADTs, TypeData, TypeFamilies #-} +module Main where + +import GHC.Types (Type) + +import T23549a + +type data TDWrapper = TDWrapperCon Type + +type family UnwrapTDW tdw where + UnwrapTDW (TDWrapperCon a) = a + +data ProxyBox tdw = ProxyBox (UnliftedGADTProxy (UnwrapTDW tdw)) + +shouldBeExhaustive :: ProxyBox (TDWrapperCon Int) -> () +shouldBeExhaustive pb = id $ case pb of ProxyBox UGPInt -> () + +main :: IO () +main = let + pb :: ProxyBox (TDWrapperCon Int) + pb = ProxyBox UGPInt + !_ = shouldBeExhaustive pb + in putStrLn "OK" ===================================== testsuite/tests/unlifted-datatypes/should_run/T23549.stdout ===================================== @@ -0,0 +1 @@ +OK ===================================== testsuite/tests/unlifted-datatypes/should_run/T23549a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE GADTs, UnliftedDatatypes #-} +module T23549a where + +import GHC.Exts (UnliftedType) +import GHC.Types (Type) + +data UnliftedGADTProxy :: Type -> UnliftedType where + UGPInt :: UnliftedGADTProxy Int + UGPBool :: UnliftedGADTProxy Bool ===================================== testsuite/tests/unlifted-datatypes/should_run/all.T ===================================== @@ -1,2 +1,3 @@ test('UnlData1', normal, compile_and_run, ['']) test('UnlGadt1', [exit_code(1), expect_broken_for(23060, ghci_ways)], compile_and_run, ['']) +test('T23549', normal, multimod_compile_and_run, ['T23549', '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e09c38e133e6c46889408d7ff1b2c56e7df5782 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e09c38e133e6c46889408d7ff1b2c56e7df5782 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:31:55 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 03:31:55 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor Unique to be represented by Word64 Message-ID: <64a2796b493e9_3cb8234752c178346@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 9563b1f5 by Jaro Reinders at 2023-07-03T09:31:01+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 18 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9563b1f5dfd108989c910bc059763d8a63017725 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9563b1f5dfd108989c910bc059763d8a63017725 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:32:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:32:11 -0400 Subject: [Git][ghc/ghc][master] perf tests: Increase default stack size for MultiLayerModules Message-ID: <64a2797b48540_3cb823821fd74179058@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 1 changed file: - testsuite/tests/perf/compiler/all.T Changes: ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -315,11 +315,18 @@ test('T13379', compile, ['']) -# MultiLayerModules flip flops by 2.5%, depending on the -# number of modules within GHC (#19293). Just widen the -# acceptance window until we figured out how to fix it. +# Note [Increased initial stack size for MultiLayerModules] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# The MultiLayerModules test, and a few other tests like it, had a +# tendency to fluctuate wildly with the default initial stack size of +# 1k (see #19293), presumably because it creates threads that happen +# to need very close to 1k of peak stack space. Increasing the initial +# stack size to 2k via the -ki RTS option seems to avoid this problem +# (though the size of the fluctuations does perhaps suggest that it +# would be valuable to solve the pathology in a more general way). + test('MultiLayerModules', - [ collect_compiler_stats('bytes allocated',3), + [ collect_compiler_stats('bytes allocated',2), pre_cmd('./genMultiLayerModules'), extra_files(['genMultiLayerModules']), compile_timeout_multiplier(5) @@ -329,14 +336,12 @@ test('MultiLayerModules', # to complete successfully reliably everywhere. ], multimod_compile, - ['MultiLayerModules', '-v0']) + # see Note [Increased initial stack size for MultiLayerModules] + ['MultiLayerModules', '-v0 +RTS -ki2k -kb2k -RTS']) -# MultiLayerModules flip flops by 2.5%, depending on the -# number of modules within GHC (#19293). Just widen the -# acceptance window until we figured out how to fix it. test('MultiLayerModulesRecomp', - [ collect_compiler_stats('bytes allocated',3), + [ collect_compiler_stats('bytes allocated',2), pre_cmd('$MAKE -s --no-print-directory MultiModulesRecomp'), extra_files(['genMultiLayerModules']), compile_timeout_multiplier(5) @@ -346,30 +351,33 @@ test('MultiLayerModulesRecomp', # to complete successfully reliably everywhere. ], multimod_compile, - ['MultiLayerModules', '-v0']) + # see Note [Increased initial stack size for MultiLayerModules] + ['MultiLayerModules', '-v0 +RTS -ki2k -kb2k -RTS']) # A performance test for calculating link dependencies in --make mode. test('MultiLayerModulesTH_Make', - [ collect_compiler_stats('bytes allocated',3), + [ collect_compiler_stats('bytes allocated',2), pre_cmd('$MAKE -s --no-print-directory MultiLayerModulesTH_Make_Prep'), extra_files(['genMultiLayerModulesTH']), unless(have_dynamic(),skip), compile_timeout_multiplier(5) ], multimod_compile_fail, - ['MultiLayerModules', '-v0']) + # see Note [Increased initial stack size for MultiLayerModules] + ['MultiLayerModules', '-v0 +RTS -ki2k -kb2k -RTS']) # A performance test for calculating link dependencies in -c mode. test('MultiLayerModulesTH_OneShot', - [ collect_compiler_stats('bytes allocated',3), + [ collect_compiler_stats('bytes allocated',2), pre_cmd('$MAKE -s --no-print-directory MultiLayerModulesTH_OneShot_Prep'), extra_files(['genMultiLayerModulesTH']), unless(have_dynamic(),skip), compile_timeout_multiplier(5) ], compile_fail, - ['-v0']) + # see Note [Increased initial stack size for MultiLayerModules] + ['-v0 +RTS -ki2k -kb2k -RTS']) test('MultiLayerModulesDefsGhci', [ collect_compiler_residency(15), @@ -466,7 +474,8 @@ test('T13701', # to complete successfully reliably everywhere. ], multimod_compile, - ['T13701', '-v0']) + # see Note [Increased initial stack size for MultiLayerModules] + ['T13701', '-v0 +RTS -ki2k -kb2k -RTS']) test('T13719', [ collect_compiler_stats('bytes allocated',2), @@ -492,7 +501,8 @@ test('T14697', extra_hc_opts('$(cat T14697-flags)'), # 10k -optP arguments ], multimod_compile, - ['T14697', '-v0']) + # see Note [Increased initial stack size for MultiLayerModules] + ['T14697', '-v0 +RTS -ki2k -kb2k -RTS']) test('T14683', [ collect_compiler_stats('bytes allocated',2), @@ -680,4 +690,3 @@ test('T22744', ], multimod_compile, ['T22744', '-v0']) - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3274174357871a83870ede78c3fac04cc4d3c04a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3274174357871a83870ede78c3fac04cc4d3c04a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:32:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:32:58 -0400 Subject: [Git][ghc/ghc][master] Add missing void prototypes to rts functions Message-ID: <64a279aa98d18_3cb823ddaf644182967@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 30 changed files: - rts/CheckUnload.c - rts/ExecPage.c - rts/ForeignExports.c - rts/IPE.c - rts/Libdw.c - rts/Linker.c - rts/OldARMAtomic.c - rts/Printer.c - rts/ReportMemoryMap.c - rts/RtsAPI.c - rts/RtsMessages.c - rts/Schedule.c - rts/StaticPtrTable.c - rts/Stats.c - rts/Ticky.c - rts/Trace.c - rts/adjustor/LibffiAdjustor.c - rts/adjustor/NativeAmd64.c - rts/adjustor/NativeAmd64Mingw.c - rts/adjustor/NativeIA64.c - rts/adjustor/NativePowerPC.c - rts/adjustor/Nativei386.c - rts/eventlog/EventLog.c - rts/linker/PEi386.c - rts/posix/GetTime.c - rts/sm/BlockAlloc.c - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMovingCensus.c - rts/sm/NonMovingMark.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82ac6bf113526f61913943b911089534705984fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82ac6bf113526f61913943b911089534705984fb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:33:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:33:25 -0400 Subject: [Git][ghc/ghc][master] gitlab-ci: Refactor compilation of gen_ci Message-ID: <64a279c5192db_3cb823821fd74186372@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 12 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitignore ===================================== @@ -97,6 +97,7 @@ _darcs/ # ----------------------------------------------------------------------------- # specific generated files +/.gitlab/jobs-metadata.json /bindist-list /bindist-list.uniq /bindistprep/ ===================================== .gitlab-ci.yml ===================================== @@ -274,13 +274,10 @@ lint-ci-config: GIT_SUBMODULE_STRATEGY: none before_script: - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf - - nix-channel --update script: - - .gitlab/generate_jobs + - nix run .gitlab/generate-ci#generate-jobs # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code - # And run this to just make sure that works - - .gitlab/generate_job_metadata dependencies: [] lint-submods: @@ -1020,7 +1017,7 @@ project-version: - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" - nix shell nixpkgs#wget -c wget "https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" -O ghcup-0.0.7.yaml - - .gitlab/generate_job_metadata + - nix run .gitlab/generate-ci#generate-job-metadata artifacts: paths: ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,34 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates two outputs: + + * `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) + file which defines the bulk of the validation, nightly, and release jobs of + GHC's CI. This is committed to the GHC repository and must be updated + whenever `gen_ci.hs` is modified. + + * `.gitlab/jobs-metadata.json`, which is a mapping between platforms and + produced binary distribution names used when producing `ghcup` metadata + for nightly pipeline artifacts (see the `.ghcup-metadata` job in + `/.gitlab-ci.yaml`). + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .gitlab/generate-ci#generate-jobs +``` +from the top of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./generate-jobs +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,47 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + # The Haskell generator executable + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + + # Wrapper scripts + generate-job-metadata = pkgs.runCommand "generate-job-metadata" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./generate-job-metadata} $out/bin/generate-job-metadata \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci gitMinimal ]} + ''; + + generate-jobs = pkgs.runCommand "generate-jobs" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./generate-jobs} $out/bin/generate-jobs \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + default = generate-jobs; + }; + + apps = rec { + generate-jobs = flake-utils.lib.mkApp { + drv = self.packages.${system}.generate-jobs; + }; + + generate-job-metadata = flake-utils.lib.mkApp { + drv = self.packages.${system}.generate-job-metadata; + }; + + default = generate-jobs; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/generate-job-metadata ===================================== @@ -0,0 +1,7 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" ===================================== .gitlab/generate-ci/generate-jobs ===================================== @@ -0,0 +1,12 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" + ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6078b429414fe91ed361988da9a7c0fe57b741fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6078b429414fe91ed361988da9a7c0fe57b741fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:33:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:33:50 -0400 Subject: [Git][ghc/ghc][master] testsuite: Update documentation Message-ID: <64a279deb0dca_3cb823821fd741896d6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 1 changed file: - testsuite/README.md Changes: ===================================== testsuite/README.md ===================================== @@ -7,29 +7,18 @@ For the full testsuite documentation, please see [here][1]. Commands to run testsuite: - * Full testsuite: `make` - * Using more threads: `make THREADS=12` - * Reduced (fast) testsuite: `make fast` - * Run a specific test: `make TEST=tc054` - * Test a specific 'way': `make WAY=optllvm` - * Keeping the run directory after test run: `make CLEANUP=0`. You will find a - directory `{test_name}.run` in the test's source directory. - * Test a specific stage of GHC: `make stage=1` - * Skip performance tests: `make SKIP_PERF_TESTS=YES` - * Set verbosity: `make VERBOSE=n` + * Full testsuite: `hadrian/build test` + * Using more threads: `hadrian/build test -j12` + * Reduced (fast) testsuite: `hadrian/build test --test-speed=fast` + * Run a specific test: `hadrian/build test --only="tc055 tc054"` + * Test a specific 'way': `hadrian/build test --test-way=optllvm` + * Skip performance tests: `hadrian/build test --skip-perf` + * Set verbosity: `hadrian/build test --test-verbose=` where n=0: No per-test output, n=1: Only failures, n=2: Progress output, n=3: Include commands called (default), n=4: Include perf test results unconditionally, n=5: Echo commands in subsidiary make invocations - * Pass in extra GHC options: `make EXTRA_HC_OPTS=-fvectorize` -You can also change directory to a specific test folder to run that -individual test or group of tests. For example: - -``` .sh -$ cd tests/array -$ make -``` ## Testsuite Ways View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa2db0ae9c13bc1728d8ffd9d07a523daef045a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa2db0ae9c13bc1728d8ffd9d07a523daef045a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:34:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:34:37 -0400 Subject: [Git][ghc/ghc][master] Better error for data deriving of type synonym/family. Closes #23522 Message-ID: <64a27a0d4ce65_3cb82347554194855@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 5 changed files: - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - + testsuite/tests/deriving/should_fail/T23522.hs - + testsuite/tests/deriving/should_fail/T23522.stderr - testsuite/tests/deriving/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1201,11 +1201,15 @@ data TcRnMessage where {-| TcRnIllegalClassInst is an error that occurs whenever a class instance is specified for a non-class. + This also includes derived instances. See the T23522 test case. + Examples(s): type C1 a = (Show (a -> Bool)) instance C1 Int where - Test cases: polykinds/T13267 + Test cases: + polykinds/T13267 + deriving/should_fail/T23522 -} TcRnIllegalClassInst :: !(TyConFlavour TyCon) -> TcRnMessage ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -99,7 +99,6 @@ import GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBinders, tcInstInvisibleTyBin import GHC.Tc.Zonk.TcType import GHC.Core.Type -import GHC.Core.Predicate import GHC.Core.TyCo.Rep import GHC.Core.TyCo.Ppr @@ -639,9 +638,15 @@ tcHsDeriv hs_ty = do { ty <- tcTopLHsType DerivClauseCtxt hs_ty ; let (tvs, pred) = splitForAllTyCoVars ty (kind_args, _) = splitFunTys (typeKind pred) - ; case getClassPredTys_maybe pred of - Just (cls, tys) -> return (tvs, cls, tys, map scaledThing kind_args) - Nothing -> failWithTc $ TcRnIllegalDerivingItem hs_ty } + -- Checking that `pred` a is type class application + ; case splitTyConApp_maybe pred of + Just (tyCon, tyConArgs) -> + case tyConClass_maybe tyCon of + Just clas -> + return (tvs, clas, tyConArgs, map scaledThing kind_args) + Nothing -> failWithTc $ TcRnIllegalClassInst (tyConFlavour tyCon) + Nothing -> failWithTc $ TcRnIllegalDerivingItem hs_ty + } -- | Typecheck a deriving strategy. For most deriving strategies, this is a -- no-op, but for the @via@ strategy, this requires typechecking the @via@ type. ===================================== testsuite/tests/deriving/should_fail/T23522.hs ===================================== @@ -0,0 +1,5 @@ +module T23522 where + +type F x = Show x + +data Proposition = Proposition deriving (F) ===================================== testsuite/tests/deriving/should_fail/T23522.stderr ===================================== @@ -0,0 +1,5 @@ + +T23522.hs:5:42: [GHC-53946] + Illegal instance for a type synonym + A class instance must be for a class + In the data declaration for ‘Proposition’ ===================================== testsuite/tests/deriving/should_fail/all.T ===================================== @@ -87,3 +87,4 @@ test('T21087b', [extra_files(['T21087b_aux.hs','T21087b_aux.hs-boot'])], multimo test('T21302', normal, compile_fail, ['']) test('T21871', normal, compile_fail, ['']) test('T22696b', normal, compile_fail, ['']) +test('T23522', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/924a2362810d9fa27c5da212cb35fd3e357ab9d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/924a2362810d9fa27c5da212cb35fd3e357ab9d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:35:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 03:35:14 -0400 Subject: [Git][ghc/ghc][master] Fix some broken links and typos Message-ID: <64a27a325b79b_3cb823475401983d6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - 5 changed files: - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst Changes: ===================================== docs/users_guide/debug-info.rst ===================================== @@ -251,7 +251,7 @@ Implementor's notes: DWARF annotations interpret the GHC-specific DWARF annotations contained in compiled binaries. When invoked with the ``-g`` flag GHC will produce standard `DWARF v4 -`__ debugging information. This format is used by nearly +`__ debugging information. This format is used by nearly all POSIX-compliant targets and can be used by debugging and performance tools (e.g. ``gdb``, ``lldb``, and ``perf``) to understand the structure of GHC-compiled programs. ===================================== docs/users_guide/exts/gadt.rst ===================================== @@ -43,9 +43,9 @@ refinement*. For example, in the right hand side of the equation :: the type ``a`` is refined to ``Int``. That's the whole point! A precise specification of the type rules is beyond what this user manual aspires to, but the design closely follows that described in the paper `Simple -unification-based type inference for -GADTs `__, (ICFP -2006). The general principle is this: *type refinement is only carried +unification-based type inference for GADTs +`__ +(ICFP 2006). The general principle is this: *type refinement is only carried out based on user-supplied type annotations*. So if no type signature is supplied for ``eval``, no type refinement happens, and lots of obscure error messages will occur. However, the refinement is quite general. For @@ -153,9 +153,9 @@ also sets :extension:`GADTSyntax` and :extension:`MonoLocalBinds`. A type is "rigid" if it is completely known to the compiler at its binding site. The easiest way to ensure that a variable has a rigid type is to give it a type signature. For more precise details see `Simple - unification-based type inference for - GADTs `__. The - criteria implemented by GHC are given in the Appendix. + unification-based type inference for GADTs + `__. + The criteria implemented by GHC are given in the Appendix. - When GHC typechecks multiple patterns in a function clause, it typechecks each pattern in order from left to right. This has consequences for patterns ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -365,7 +365,7 @@ has a number of other effects: GHC ensures that inlining cannot go on forever: every mutually-recursive group is cut by one or more *loop breakers* that is never inlined (see `Secrets of the GHC inliner, JFP 12(4) July -2002 `__). +2002 `__). GHC tries not to select a function with an ``INLINE`` pragma as a loop breaker, but when there is no choice even an INLINE function can be selected, in which case the ``INLINE`` pragma is ignored. For example, for a ===================================== docs/users_guide/exts/type_families.rst ===================================== @@ -51,7 +51,7 @@ families `__. .. [AssocDataTypes2005] “`Associated Types with Class - `__\ ”, M. + `__\ ”, M. Chakravarty, G. Keller, S. Peyton Jones, and S. Marlow. In Proceedings of “The 32nd Annual ACM SIGPLAN-SIGACT Symposium on Principles of @@ -59,15 +59,15 @@ families `__. Press, 2005. .. [AssocTypeSyn2005] - “`Type Associated Type - Synonyms `__\ ”. M. + “`Associated Type Synonyms + `__\ ”, M. Chakravarty, G. Keller, and S. Peyton Jones. In Proceedings of “The Tenth ACM SIGPLAN International Conference on Functional Programming”, ACM Press, pages 241-253, 2005. .. [TypeFamilies2008] - “\ `Type Checking with Open Type - Functions `__\ ”, + “\ `Type Checking with Open Type Functions + `__\ ”, T. Schrijvers, S. Peyton-Jones, M. Chakravarty, and M. Sulzmann, in Proceedings of “ICFP 2008: The 13th ACM SIGPLAN International Conference on Functional Programming”, ACM Press, pages 51-62, 2008. @@ -548,8 +548,8 @@ Decidability of type synonym instances In order to guarantee that type inference in the presence of type families is decidable, we need to place a number of additional restrictions on the formation of type instance declarations (c.f., Definition 5 -(Relaxed Conditions) of “\ `Type Checking with Open Type -Functions `__\ ”). +(Relaxed Conditions) of “\ `Type Checking with Open Type Functions +`__\ ”). Instance declarations have the general form :: type instance F t1 .. tn = t @@ -1158,7 +1158,7 @@ will be possible to infer ``t`` at call sites from the type of the argument: :: Injective type families are enabled with ``-XTypeFamilyDependencies`` language extension. This extension implies ``-XTypeFamilies``. -For full details on injective type families refer to Haskell Symposium +For full details on injective type families refer to the Haskell Symposium 2015 paper `Injective type families for Haskell `__. ===================================== docs/users_guide/exts/view_patterns.rst ===================================== @@ -119,8 +119,8 @@ follows: into a single nested case expression, so that the view function is only applied once. Pattern compilation in GHC follows the matrix algorithm described in Chapter 4 of `The Implementation of Functional - Programming - Languages `__. + Programming Languages + `__. When the top rows of the first column of a matrix are all view patterns with the "same" expression, these patterns are transformed into a single nested case. This includes, for example, adjacent view View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4457da2a7dba97ab2cd2f64bb338c904bb614244 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4457da2a7dba97ab2cd2f64bb338c904bb614244 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 07:58:50 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 03:58:50 -0400 Subject: [Git][ghc/ghc][wip/T23576] Insert unconditional jumps before NEWBLOCK Message-ID: <64a27fba240a8_3cb8234752c20922@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: f8ac8be6 by Jaro Reinders at 2023-07-03T09:58:44+02:00 Insert unconditional jumps before NEWBLOCK - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -659,6 +659,7 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do JXX EQQ b, MOV II32 (OpReg rlo) (OpReg rhi), XOR II32 (OpReg rlo) (OpReg rlo), + JXX ALWAYS b, NEWBLOCK b ] return (RegCode64 code rhi rlo) @@ -680,6 +681,7 @@ iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do JXX EQQ b, MOV II32 (OpReg rhi) (OpReg rlo), SAR II32 (OpImm (ImmInt 31)) (OpReg rhi), + JXX ALWAYS b, NEWBLOCK b ] return (RegCode64 code rhi rlo) @@ -701,6 +703,7 @@ iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do JXX EQQ b, MOV II32 (OpReg rhi) (OpReg rlo), XOR II32 (OpReg rhi) (OpReg rhi), + JXX ALWAYS b, NEWBLOCK b ] return (RegCode64 code rhi rlo) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8ac8be6fb04ce8a7bc6f94dd45b765c63365ed5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8ac8be6fb04ce8a7bc6f94dd45b765c63365ed5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 08:21:31 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 04:21:31 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix blocks Message-ID: <64a2850b3a9b7_3cb823475542133ee@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 1bd292d6 by Jaro Reinders at 2023-07-03T10:21:24+02:00 Fix blocks - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -646,7 +646,8 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 (r2, code2) <- getSomeReg e2 Reg64 rhi rlo <- getNewReg64 - b <- newBlockId + lbl1 <- newBlockId + lbl2 <- newBlockId let code = code1 `appOL` code2 `appOL` @@ -656,11 +657,13 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do SHLD II32 (OpReg ecx) (OpReg rlo) (OpReg rhi), SAL II32 (OpReg ecx) (OpReg rlo), TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), - JXX EQQ b, + JXX EQQ lbl2, + JXX ALWAYS lbl1, + NEWBLOCK lbl1, MOV II32 (OpReg rlo) (OpReg rhi), XOR II32 (OpReg rlo) (OpReg rlo), - JXX ALWAYS b, - NEWBLOCK b + JXX ALWAYS lbl2, + NEWBLOCK lbl2 ] return (RegCode64 code rhi rlo) @@ -668,7 +671,8 @@ iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 (r2, code2) <- getSomeReg e2 Reg64 rhi rlo <- getNewReg64 - b <- newBlockId + lbl1 <- newBlockId + lbl2 <- newBlockId let code = code1 `appOL` code2 `appOL` @@ -678,11 +682,13 @@ iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), SAR II32 (OpReg ecx) (OpReg rhi), TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), - JXX EQQ b, + JXX EQQ lbl2, + JXX ALWAYS lbl1, + NEWBLOCK lbl1, MOV II32 (OpReg rhi) (OpReg rlo), SAR II32 (OpImm (ImmInt 31)) (OpReg rhi), - JXX ALWAYS b, - NEWBLOCK b + JXX ALWAYS lbl2, + NEWBLOCK lbl2 ] return (RegCode64 code rhi rlo) @@ -690,7 +696,8 @@ iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 (r2, code2) <- getSomeReg e2 Reg64 rhi rlo <- getNewReg64 - b <- newBlockId + lbl1 <- newBlockId + lbl2 <- newBlockId let code = code1 `appOL` code2 `appOL` @@ -700,11 +707,13 @@ iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), SHR II32 (OpReg ecx) (OpReg rhi), TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), - JXX EQQ b, + JXX EQQ lbl2, + JXX ALWAYS lbl1, + NEWBLOCK lbl1, MOV II32 (OpReg rhi) (OpReg rlo), XOR II32 (OpReg rhi) (OpReg rhi), - JXX ALWAYS b, - NEWBLOCK b + JXX ALWAYS lbl2, + NEWBLOCK lbl2 ] return (RegCode64 code rhi rlo) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bd292d6ad14d95f51145fd01808f1727fe9f4ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1bd292d6ad14d95f51145fd01808f1727fe9f4ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 09:02:57 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 03 Jul 2023 05:02:57 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] 42 commits: Configure CPP into settings Message-ID: <64a28ec1d200e_3cb823ddaf6442415b4@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - 520b3a7b by Matthew Pickering at 2023-07-03T09:02:53+00:00 Try deb10 for i386 bindists - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62a604b69545ffec1e3c53d1b2bc05bb7acbda7f...520b3a7b6346f1e88592f80609c5e9c75d2178a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62a604b69545ffec1e3c53d1b2bc05bb7acbda7f...520b3a7b6346f1e88592f80609c5e9c75d2178a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 09:08:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 05:08:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 23 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a28ffad95c3_3cb823ab89a0c253725@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - 00b3ed83 by Ben Gamari at 2023-07-03T05:07:24-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - f730e4cc by Ben Gamari at 2023-07-03T05:07:25-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 09bb7d5d by Matthew Pickering at 2023-07-03T05:07:26-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 5e47479d by Ben Gamari at 2023-07-03T05:07:26-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - a4b10b80 by Ben Gamari at 2023-07-03T05:07:26-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - fef90eaa by Ben Gamari at 2023-07-03T05:07:26-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - ed39792e by Ben Gamari at 2023-07-03T05:07:27-04:00 compiler: Make OccSet opaque - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Occurrence.hs - configure.ac - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43ca1f4293e3215eb765630d616cb451250d8fd5...ed39792e683bf76fc7c97f462b5bcfbbc3459e00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43ca1f4293e3215eb765630d616cb451250d8fd5...ed39792e683bf76fc7c97f462b5bcfbbc3459e00 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 09:40:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 03 Jul 2023 05:40:49 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 113 commits: Report scoped kind variables at the type-checking phase (#16635) Message-ID: <64a297a18bef_3cb823821fd742719f1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - b7c43f59 by Ben Gamari at 2023-07-03T10:38:12+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 1a65bd87 by Ben Gamari at 2023-07-03T10:38:12+01:00 ghc-toolchain: Initial commit - - - - - 09fa741c by Rodrigo Mesquita at 2023-07-03T10:38:12+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 35124c55 by Rodrigo Mesquita at 2023-07-03T10:40:21+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - 99c77526 by Rodrigo Mesquita at 2023-07-03T10:40:22+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - ab75aa02 by Rodrigo Mesquita at 2023-07-03T10:40:22+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - f10acf66 by Rodrigo Mesquita at 2023-07-03T10:40:22+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c555310e9d6d80010220202252aeadc4a0b7f30...f10acf66c700aaf493611a90e13e11317dcfbd63 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c555310e9d6d80010220202252aeadc4a0b7f30...f10acf66c700aaf493611a90e13e11317dcfbd63 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 10:49:09 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 06:49:09 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor Unique to be represented by Word64 Message-ID: <64a2a7a51f3eb_3cb823475042822fc@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: b353afa0 by Jaro Reinders at 2023-07-03T12:48:55+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 18 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b353afa099662fcd3de31d840ec8218b4e26ac2f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b353afa099662fcd3de31d840ec8218b4e26ac2f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 11:12:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 03 Jul 2023 07:12:40 -0400 Subject: [Git][ghc/ghc][wip/t23465] 167 commits: Generate Addr# access ops programmatically Message-ID: <64a2ad283bf2b_3cb8234755429214@gitlab.mail> Matthew Pickering pushed to branch wip/t23465 at Glasgow Haskell Compiler / GHC Commits: 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - e3cd31d5 by Matthew Pickering at 2023-07-03T12:12:22+01:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0275882551e9a2fc8c79378cd377fc91c2acc079...e3cd31d50889635bed5d482e1c23999f6155fa1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0275882551e9a2fc8c79378cd377fc91c2acc079...e3cd31d50889635bed5d482e1c23999f6155fa1b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 12:10:24 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 08:10:24 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add condIntCode for 64-bit ints on i386 Message-ID: <64a2bab08f40d_3cb82347554308573@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: d5dc807f by Jaro Reinders at 2023-07-03T14:10:17+02:00 Add condIntCode for 64-bit ints on i386 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1500,10 +1500,7 @@ getAmode e = do , is_label lit -> return (Amode (AddrBaseIndex EABaseRip EAIndexNone (litToImm lit)) nilOL) - CmmLit lit - | is32BitLit platform lit - -> return (Amode (ImmAddr (litToImm lit) 0) nilOL) - + CmmLit litsnoc -- Literal with offsets too big (> 32 bits) fails during the linking phase -- (#15570). We already handled valid literals above so we don't have to -- test anything here. @@ -1807,6 +1804,23 @@ condIntCode cond x y = do platform <- getPlatform condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode +-- Larger-than-native (64-bit ops on 32-bit platforms) +condIntCode' platform cond x y + | target32Bit platform && isWord64 (cmmExprType platform x) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 x + RegCode64 code2 r2hi r2lo <- iselExpr64 y + tmp <- getNewRegNat II32 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r2lo) (OpReg tmp), + CMP II32 (OpReg tmp) (OpReg r1lo), + MOV II32 (OpReg r2hi) (OpReg tmp), + SBB II32 (OpReg r1hi) (OpReg tmp) + ] + + return (CondCode False cond code) + -- memory vs immediate condIntCode' platform cond (CmmLoad x pk _) (CmmLit lit) | is32BitLit platform lit = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5dc807f65948ffd95d19236acd393cdcc59b86c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5dc807f65948ffd95d19236acd393cdcc59b86c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 12:13:02 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 08:13:02 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix typo Message-ID: <64a2bb4e12fca_3cb823821fd7430883@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: c426666e by Jaro Reinders at 2023-07-03T14:12:56+02:00 Fix typo - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1500,7 +1500,9 @@ getAmode e = do , is_label lit -> return (Amode (AddrBaseIndex EABaseRip EAIndexNone (litToImm lit)) nilOL) - CmmLit litsnoc + CmmLit lit + | is32BitLit platform lit + -> return (Amode (ImmAddr (litToImm lit) 0) nilOL) -- Literal with offsets too big (> 32 bits) fails during the linking phase -- (#15570). We already handled valid literals above so we don't have to -- test anything here. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c426666e2d88e7d0fceb39317d47825be27a334d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c426666e2d88e7d0fceb39317d47825be27a334d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 12:47:07 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 03 Jul 2023 08:47:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/code-documentation Message-ID: <64a2c34b753c2_3cb8234752c33118d@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/code-documentation at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/code-documentation You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 12:59:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 08:59:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: configure: Rip out Solaris dyld check Message-ID: <64a2c614c3ba7_3cb823ddaf6443394c3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ee781273 by Ben Gamari at 2023-07-03T08:58:36-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - b492ce64 by Ben Gamari at 2023-07-03T08:58:37-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - c39dc7d7 by Matthew Pickering at 2023-07-03T08:58:38-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 48d3ff95 by Ben Gamari at 2023-07-03T08:58:38-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ea68fa81 by Ben Gamari at 2023-07-03T08:58:38-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 66d5fd31 by Ben Gamari at 2023-07-03T08:58:38-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 2ddda58b by Mario Blažević at 2023-07-03T08:58:44-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 5358cd8a by Matthew Pickering at 2023-07-03T08:58:45-04:00 Try deb10 for i386 bindists - - - - - feef8137 by Ben Gamari at 2023-07-03T08:58:45-04:00 compiler: Make OccSet opaque - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Types/Name/Occurrence.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Settings/Warnings.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - m4/fp_hs_cpp_cmd_with_args.m4 - mk/project.mk.in - rts/posix/Signals.c - testsuite/tests/th/T20454.hs - testsuite/tests/th/T20454.stdout - + testsuite/tests/warnings/should_compile/T23573.hs - + testsuite/tests/warnings/should_compile/T23573.stderr - + testsuite/tests/warnings/should_compile/T23573A.hs - + testsuite/tests/warnings/should_compile/T23573B.hs - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: 96a18cc74ee973db95f33affaf743997774605db # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false - - job: nightly-i386-linux-deb9-validate + - job: nightly-i386-linux-deb10-validate artifacts: false - job: nightly-x86_64-linux-deb10-validate artifacts: false ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -913,7 +913,8 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) +-- , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -120,7 +120,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -130,7 +130,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -139,14 +139,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -172,10 +172,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -359,7 +359,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -369,7 +369,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -378,14 +378,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -411,10 +411,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2355,7 +2355,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2365,7 +2365,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml" ], "reports": { @@ -2374,14 +2374,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2407,12 +2407,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/merge_request_templates/backport-for-8.8.md deleted ===================================== @@ -1,11 +0,0 @@ -Thank you for help in maintaining GHC's stable branch! - -Please take a few moments to verify the following: - - * [ ] the issue that this backport fixes is milestoned for the target release. - -If you have any questions don't hesitate to open your merge request and inquire -in a comment. - -/label ~backport -/milestone %8.8.1 ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -191,7 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): deb10 = mk(debian("x86_64", 10)) deb11 = mk(debian("x86_64", 11)) deb10_arm64 = mk(debian("aarch64", 10)) - deb9_i386 = mk(debian("i386", 9)) + deb10_i386 = mk(debian("i386", 10)) source = mk_one_metadata(release_mode, version, job_map, source_artifact) test = mk_one_metadata(release_mode, version, job_map, test_artifact) @@ -221,10 +221,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): } - a32 = { "Linux_Debian": { "<10": deb9_i386, "unknown_versioning": deb9_i386 } - , "Linux_Ubuntu": { "unknown_versioning": deb9_i386 } - , "Linux_Mint" : { "unknown_versioning": deb9_i386 } - , "Linux_UnknownLinux" : { "unknown_versioning": deb9_i386 } + a32 = { "Linux_Debian": { "unknown_versioning": deb10_i386 } + , "Linux_Ubuntu": { "unknown_versioning": deb10_i386 } + , "Linux_Mint" : { "unknown_versioning": deb10_i386 } + , "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 } } arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 } ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1099,8 +1099,11 @@ instance Diagnostic TcRnMessage where , pprWarningTxtForMsg pragma_warning_msg ] where impMsg = text "imported from" <+> ppr pragma_warning_import_mod <> extra - extra | maybe True (pragma_warning_import_mod ==) pragma_warning_defined_mod = empty - | otherwise = text ", but defined in" <+> ppr pragma_warning_defined_mod + extra = case pragma_warning_defined_mod of + Just def_mod + | def_mod /= pragma_warning_import_mod + -> text ", but defined in" <+> ppr def_mod + _ -> empty TcRnDifferentExportWarnings name locs -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "exported with different error messages", text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -809,7 +809,7 @@ forceOccEnv nf (MkOccEnv fs) = seqEltsUFM (seqEltsUFM nf) fs -------------------------------------------------------------------------------- -type OccSet = FastStringEnv (UniqSet NameSpace) +newtype OccSet = OccSet (FastStringEnv (UniqSet NameSpace)) emptyOccSet :: OccSet unitOccSet :: OccName -> OccSet @@ -821,15 +821,15 @@ unionManyOccSets :: [OccSet] -> OccSet elemOccSet :: OccName -> OccSet -> Bool isEmptyOccSet :: OccSet -> Bool -emptyOccSet = emptyFsEnv -unitOccSet (OccName ns s) = unitFsEnv s (unitUniqSet ns) +emptyOccSet = OccSet emptyFsEnv +unitOccSet (OccName ns s) = OccSet $ unitFsEnv s (unitUniqSet ns) mkOccSet = extendOccSetList emptyOccSet -extendOccSet occs (OccName ns s) = extendFsEnv occs s (unitUniqSet ns) -extendOccSetList = foldl extendOccSet -unionOccSets = plusFsEnv_C unionUniqSets +extendOccSet (OccSet occs) (OccName ns s) = OccSet $ extendFsEnv occs s (unitUniqSet ns) +extendOccSetList = foldl' extendOccSet +unionOccSets (OccSet xs) (OccSet ys) = OccSet $ plusFsEnv_C unionUniqSets xs ys unionManyOccSets = foldl' unionOccSets emptyOccSet -elemOccSet (OccName ns s) occs = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s -isEmptyOccSet = isNullUFM +elemOccSet (OccName ns s) (OccSet occs) = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s +isEmptyOccSet (OccSet occs) = isNullUFM occs {- ************************************************************************ ===================================== configure.ac ===================================== @@ -298,23 +298,6 @@ then exit 1 fi -# Testing if we shall enable shared libs support on Solaris. -# Anything older than SunOS 5.11 aka Solaris 11 (Express) is broken. - -SOLARIS_BROKEN_SHLD=NO - -case $host in - i386-*-solaris2) - # here we go with the test - MINOR=`uname -r|cut -d '.' -f 2-` - if test "$MINOR" -lt "11"; then - SOLARIS_BROKEN_SHLD=YES - fi - ;; -esac - -AC_SUBST(SOLARIS_BROKEN_SHLD) - dnl ** Do an unregisterised build? dnl -------------------------------------------------------------- ===================================== hadrian/cfg/system.config.in ===================================== @@ -51,7 +51,6 @@ hs-cpp-args = @HaskellCPPArgs@ # Build options: #=============== -solaris-broken-shld = @SOLARIS_BROKEN_SHLD@ ghc-unregisterised = @Unregisterised@ tables-next-to-code = @TablesNextToCode@ use-libffi-for-adjustors = @UseLibffiForAdjustors@ ===================================== hadrian/src/Flavour.hs ===================================== @@ -142,6 +142,8 @@ werror = [ arg "-optc-Werror" -- clang complains about #pragma GCC pragmas , arg "-optc-Wno-error=unknown-pragmas" + -- rejected inlinings are highly dependent upon toolchain and way + , arg "-optc-Wno-error=inline" ] -- N.B. We currently don't build the boot libraries' C sources with -Werror -- as this tends to be a portability nightmare. ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -28,7 +28,6 @@ data Flag = ArSupportsAtFile | GmpInTree | GmpFrameworkPref | LeadingUnderscore - | SolarisBrokenShld | UseSystemFfi | BootstrapThreadedRts | BootstrapEventLoggingRts @@ -60,7 +59,6 @@ flag f = do GmpInTree -> "intree-gmp" GmpFrameworkPref -> "gmp-framework-preferred" LeadingUnderscore -> "leading-underscore" - SolarisBrokenShld -> "solaris-broken-shld" UseSystemFfi -> "use-system-ffi" BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" @@ -105,8 +103,7 @@ platformSupportsSharedLibs = do ppc_linux <- anyTargetPlatform [ "powerpc-unknown-linux" ] solaris <- anyTargetPlatform [ "i386-unknown-solaris2" ] javascript <- anyTargetArch [ "javascript" ] - solarisBroken <- flag SolarisBrokenShld - return $ not (windows || wasm || javascript || ppc_linux || solaris && solarisBroken) + return $ not (windows || wasm || javascript || ppc_linux || solaris) -- | Does the target support threaded RTS? targetSupportsThreadedRts :: Action Bool ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -2,6 +2,7 @@ module Settings.Warnings (defaultGhcWarningsArgs, ghcWarningsArgs) where import Expression import Oracles.Flag +import Oracles.Setting (isOsxTarget, isWinTarget) import Packages -- See @mk/warnings.mk@ for warning-related arguments in the Make build system. @@ -12,7 +13,11 @@ defaultGhcWarningsArgs = mconcat [ notStage0 ? arg "-Wnoncanonical-monad-instances" , notM (flag CcLlvmBackend) ? arg "-optc-Wno-error=inline" , flag CcLlvmBackend ? arg "-optc-Wno-unknown-pragmas" - , arg "-optP-Wno-nonportable-include-path" -- #17798 + -- Cabal can seemingly produce filepaths with incorrect case on filesystems + -- with case-insensitive names. Ignore such issues for now as they seem benign. + -- See #17798. + , isOsxTarget ? arg "-optP-Wno-nonportable-include-path" + , isWinTarget ? arg "-optP-Wno-nonportable-include-path" ] -- | Package-specific warnings-related arguments, mostly suppressing various warnings. ===================================== libraries/template-haskell/Language/Haskell/TH/Ppr.hs ===================================== @@ -302,27 +302,28 @@ pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#' pprLit _ (BytesPrimL {}) = pprString "" pprLit i (RationalL rat) | withoutFactor 2 (withoutFactor 5 $ denominator rat) /= 1 - -- if the denominator has prime factors other than 2 and 5, show as fraction + -- if the denominator has prime factors other than 2 and 5 + -- or can't be represented as Double, show as fraction = parensIf (i > noPrec) $ integer (numerator rat) <+> char '/' <+> integer (denominator rat) - | rat /= 0 && (zeroes < -1 || zeroes > 7), - let (n, d) = properFraction (rat' / magnitude) - (rat', zeroes') - | abs rat < 1 = (10 * rat, zeroes - 1) - | otherwise = (rat, zeroes) + | rat /= 0 && (zeroes < -2 || zeroes > 6), + let (n, d) = properFraction (rat / magnitude) -- if < 0.01 or >= 100_000_000, use scientific notation = parensIf (i > noPrec && rat < 0) (integer n <> (if d == 0 then empty else char '.' <> decimals (abs d)) - <> char 'e' <> integer zeroes') + <> char 'e' <> integer zeroes) | let (n, d) = properFraction rat = parensIf (i > noPrec && rat < 0) (integer n <> char '.' <> if d == 0 then char '0' else decimals (abs d)) where zeroes :: Integer - zeroes = truncate (logBase 10 (abs (fromRational rat) :: Double) - * (1 - epsilon)) - epsilon = 0.0000001 + zeroes = log10 (abs rat) + log10 :: Rational -> Integer + log10 x + | x >= 10 = 1 + log10 (x / 10) + | x < 1 = -1 + log10 (x * 10) + | otherwise = 0 magnitude :: Rational magnitude = 10 ^^ zeroes withoutFactor :: Integer -> Integer -> Integer ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -25,36 +25,6 @@ AC_ARG_WITH(hs-cpp, # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". HS_CPP_CMD=$CC - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi ] ) ===================================== mk/project.mk.in ===================================== @@ -156,10 +156,6 @@ else Windows_Target=NO endif -# In case of Solaris OS, does it provide broken shared libs -# linker or not? -SOLARIS_BROKEN_SHLD=@SOLARIS_BROKEN_SHLD@ - # Is the stage0 compiler affected by Bug #9439? GHC_LLVM_AFFECTED_BY_9439 = @GHC_LLVM_AFFECTED_BY_9439@ ===================================== rts/posix/Signals.c ===================================== @@ -368,9 +368,11 @@ int stg_sig_install(int sig, int spi, void *mask) { sigset_t signals, osignals; - struct sigaction action; StgInt previous_spi; + struct sigaction action; + memset(&action, 0, sizeof(struct sigaction)); + ACQUIRE_LOCK(&sig_mutex); // Block the signal until we figure out what to do @@ -619,6 +621,7 @@ static void set_sigtstp_action (bool handle) { struct sigaction sa; + memset(&sa, 0, sizeof(struct sigaction)); if (handle) { sa.sa_handler = sigtstp_handler; } else { @@ -635,7 +638,8 @@ set_sigtstp_action (bool handle) void install_vtalrm_handler(int sig, TickProc handle_tick) { - struct sigaction action = {}; + struct sigaction action; + memset(&action, 0, sizeof(struct sigaction)); action.sa_handler = handle_tick; @@ -677,8 +681,11 @@ install_vtalrm_handler(int sig, TickProc handle_tick) void initDefaultHandlers(void) { - struct sigaction action = {}; - struct sigaction oact = {}; + // N.B. We can't use initializers here as CentOS's ancient toolchain throws + // spurious warnings. See #23577. + struct sigaction action, oact; + memset(&oact, 0, sizeof(struct sigaction)); + memset(&action, 0, sizeof(struct sigaction)); // install the SIGINT handler action.sa_handler = shutdown_handler; ===================================== testsuite/tests/th/T20454.hs ===================================== @@ -8,6 +8,7 @@ e1, e2 :: ExpQ e1 = [| -- Test the Template Haskell pretty-printing of rational literals [0.0, 123.0, -321.0, 9e3, 10000.0, -500000000.0, 345e67, -456e78, + 1e400, -1e400, -- T23571 0.01, -0.002, 0.04e-56, -0.3e-65, 0.33333333333333333333333333333, $(pure $ LitE $ RationalL $ 1/3)] |] ===================================== testsuite/tests/th/T20454.stdout ===================================== @@ -6,6 +6,8 @@ -5e8, 3.45e69, -4.56e80, + 1e400, + -1e400, 0.01, -2e-3, 4e-58, ===================================== testsuite/tests/warnings/should_compile/T23573.hs ===================================== @@ -0,0 +1,5 @@ +module T23573 where + +import T23573A + +foo = deprec ===================================== testsuite/tests/warnings/should_compile/T23573.stderr ===================================== @@ -0,0 +1,5 @@ + +T23573.hs:5:7: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of ‘deprec’ + (imported from T23573A, but defined in T23573B): + Deprecated: "deprec" ===================================== testsuite/tests/warnings/should_compile/T23573A.hs ===================================== @@ -0,0 +1,5 @@ +module T23573A(module T23573B) where + +import T23573B + + ===================================== testsuite/tests/warnings/should_compile/T23573B.hs ===================================== @@ -0,0 +1,4 @@ +module T23573B where + +{-# DEPRECATED deprec "deprec" #-} +deprec = () ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -65,3 +65,4 @@ test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) test('T22702a', normal, compile, ['']) test('T22702b', normal, compile, ['']) test('T22826', normal, compile, ['']) +test('T23573', [extra_files(["T23573.hs", "T23573A.hs", "T23573B.hs"])], multimod_compile, ['T23573', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed39792e683bf76fc7c97f462b5bcfbbc3459e00...feef8137bbb1d2d4c99abd0d0dbf254151e691cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed39792e683bf76fc7c97f462b5bcfbbc3459e00...feef8137bbb1d2d4c99abd0d0dbf254151e691cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 13:38:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 03 Jul 2023 09:38:50 -0400 Subject: [Git][ghc/ghc][wip/ipe-section] compiler: Place IPE information in separate section Message-ID: <64a2cf6a9795b_3cb823475b83658ee@gitlab.mail> Ben Gamari pushed to branch wip/ipe-section at Glasgow Haskell Compiler / GHC Commits: 973bc9aa by Ben Gamari at 2023-07-03T09:38:43-04:00 compiler: Place IPE information in separate section Previously IPE information would end up in the `.data` section. Not only does this make it difficult to measure the size of the IPE metadata, but by placing it in its own section we reduce the probability of the (generally rather large) IPE metadata inducing large displacements at link-time. Moreover, we can now in principle allow the data to be stripped post-build; we would merely need to sort out how to make the could - - - - - 4 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToCmm/Utils.hs Changes: ===================================== compiler/GHC/Cmm.hs ===================================== @@ -249,6 +249,7 @@ data SectionType | ReadOnlyData | RelocatableReadOnlyData | UninitialisedData + | InfoProvData -- See Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini | InitArray -- .init_array on ELF, .ctor on Windows | FiniArray -- .fini_array on ELF, .dtor on Windows @@ -268,6 +269,7 @@ sectionProtection (Section t _) = case t of Text -> ReadOnlySection ReadOnlyData -> ReadOnlySection RelocatableReadOnlyData -> WriteProtectedSection + InfoProvData -> ReadWriteSection InitArray -> ReadOnlySection FiniArray -> ReadOnlySection CString -> ReadOnlySection ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -230,6 +230,7 @@ pprGNUSectionHeader config t suffix = -> text ".rdata$rel.ro" | otherwise -> text ".data.rel.ro" UninitialisedData -> text ".bss" + InfoProvData -> text ".data$ipe" InitArray | OSMinGW32 <- platformOS platform -> text ".ctors" @@ -272,6 +273,7 @@ pprDarwinSectionHeader t = case t of Text -> text ".text" Data -> text ".data" ReadOnlyData -> text ".const" + InfoProvData -> text ".data" RelocatableReadOnlyData -> text ".const_data" UninitialisedData -> text ".data" InitArray -> text ".section\t__DATA,__mod_init_func,mod_init_funcs" ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -140,22 +140,22 @@ emitIpeBufferListNode this_mod ents = do -- Emit the list of info table pointers emitDecl $ CmmData - (Section Data tables_lbl) + (Section InfoProvData tables_lbl) (CmmStaticsRaw tables_lbl tables) -- Emit the strings table emitDecl $ CmmData - (Section Data strings_lbl) + (Section InfoProvData strings_lbl) (CmmStaticsRaw strings_lbl strings) -- Emit the list of IPE buffer entries emitDecl $ CmmData - (Section Data entries_lbl) + (Section InfoProvData entries_lbl) (CmmStaticsRaw entries_lbl entries) -- Emit the IPE buffer list node emitDecl $ CmmData - (Section Data ipe_buffer_lbl) + (Section InfoProvData ipe_buffer_lbl) (CmmStaticsRaw ipe_buffer_lbl ipe_buffer_node) -- | Emit the fields of an IpeBufferEntry struct for each entry in a given list. ===================================== compiler/GHC/StgToCmm/Utils.hs ===================================== @@ -10,6 +10,7 @@ module GHC.StgToCmm.Utils ( emitDataLits, emitRODataLits, + emitInfoProvDataLits, emitDataCon, emitRtsCall, emitRtsCallWithResult, emitRtsCallGen, emitBarf, @@ -262,6 +263,9 @@ callerRestoreGlobalReg platform reg emitDataLits :: CLabel -> [CmmLit] -> FCode () emitDataLits lbl lits = emitDecl (mkDataLits (Section Data lbl) lbl lits) +emitInfoProvDataLits :: CLabel -> [CmmLit] -> FCode () +emitInfoProvDataLits lbl lits = emitDecl (mkDataLits (Section InfoProvData lbl) lbl lits) + -- | Emit a read-only data block emitRODataLits :: CLabel -> [CmmLit] -> FCode () emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/973bc9aac04d39f0472d9c12570c9b5dd2e3c8f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/973bc9aac04d39f0472d9c12570c9b5dd2e3c8f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 14:18:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 03 Jul 2023 10:18:39 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: refactor on hadrian handling of toolchains Message-ID: <64a2d8bf3b116_3cb823475544185e0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9b53c702 by Rodrigo Mesquita at 2023-07-03T15:18:09+01:00 refactor on hadrian handling of toolchains - - - - - eec2c329 by Rodrigo Mesquita at 2023-07-03T15:18:30+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 3116e879 by Rodrigo Mesquita at 2023-07-03T15:18:30+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - bcd2b149 by Rodrigo Mesquita at 2023-07-03T15:18:30+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/Configure.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f10acf66c700aaf493611a90e13e11317dcfbd63...bcd2b149692be15612d87af4fe03e3bc5bad2441 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f10acf66c700aaf493611a90e13e11317dcfbd63...bcd2b149692be15612d87af4fe03e3bc5bad2441 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 14:29:12 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 10:29:12 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add MO_UU_Conv W64 W8 Message-ID: <64a2db37d4d79_3cb823ddaf644428071@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: f9b02af6 by Jaro Reinders at 2023-07-03T16:29:03+02:00 Add MO_UU_Conv W64 W8 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -837,6 +837,11 @@ getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x]) RegCode64 code _rhi rlo <- iselExpr64 x return $ Fixed II32 rlo code +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W8) [x]) + | is32Bit = do + RegCode64 code _rhi rlo <- iselExpr64 x + return $ Fixed II8 rlo code + getRegister' _ _ (CmmLit lit@(CmmFloat f w)) = float_const_sse2 where float_const_sse2 @@ -1503,6 +1508,7 @@ getAmode e = do CmmLit lit | is32BitLit platform lit -> return (Amode (ImmAddr (litToImm lit) 0) nilOL) + -- Literal with offsets too big (> 32 bits) fails during the linking phase -- (#15570). We already handled valid literals above so we don't have to -- test anything here. @@ -1890,8 +1896,25 @@ condIntCode' platform cond x y = do -------------------------------------------------------------------------------- condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode -condFltCode cond x y - = condFltCode_sse2 +-- Larger-than-native (64-bit ops on 32-bit platforms) +condFltCode cond x y = do + platform <- getPlatform + if target32Bit platform && isFloat64 (cmmExprType platform x) + then panic "condFLtCode 64-bit on 32-bit platform" +-- RegCode64 code1 r1hi r1lo <- iselExpr64 x +-- RegCode64 code2 r2hi r2lo <- iselExpr64 y +-- tmp <- getNewRegNat II32 +-- let +-- code = code1 `appOL` +-- code2 `appOL` +-- toOL [ FLD FF32 (OpReg r2lo) (OpReg tmp), +-- FLD FF32 (OpReg tmp) (OpReg r1lo), +-- MOV II32 (OpReg r2hi) (OpReg tmp), +-- SBB II32 (OpReg r1hi) (OpReg tmp) +-- ] +-- +-- return (CondCode False cond code) + else condFltCode_sse2 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9b02af6340d099b5be8b0985ba1e234b7684bf6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9b02af6340d099b5be8b0985ba1e234b7684bf6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 14:35:50 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 10:35:50 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add CmmRegOff case to iselExpr64 Message-ID: <64a2dcc68462a_3cb823ddaf6444337aa@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 8541fb05 by Jaro Reinders at 2023-07-03T16:35:44+02:00 Add CmmRegOff case to iselExpr64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -771,6 +771,8 @@ iselExpr64 (CmmMachOp (MO_Not _) [e1]) = do ] return (RegCode64 code rhi rlo) +iselExpr64 (CmmRegOff r i) = iselExpr64 (mangleIndexTree r i) + iselExpr64 expr = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8541fb05144a8c599b8edc2a5992cfe59bf95d07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8541fb05144a8c599b8edc2a5992cfe59bf95d07 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 14:38:44 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 03 Jul 2023 10:38:44 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: refactor on hadrian handling of toolchains Message-ID: <64a2dd742aa87_3cb823ddaf6444340d6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f7a941dd by Rodrigo Mesquita at 2023-07-03T15:38:35+01:00 refactor on hadrian handling of toolchains - - - - - fa3879c7 by Rodrigo Mesquita at 2023-07-03T15:38:35+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - b7a7fbef by Rodrigo Mesquita at 2023-07-03T15:38:35+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - c7deb5e8 by Rodrigo Mesquita at 2023-07-03T15:38:35+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/Configure.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcd2b149692be15612d87af4fe03e3bc5bad2441...c7deb5e8934a79fb0ea4ff8b6ff7138680bb9a10 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcd2b149692be15612d87af4fe03e3bc5bad2441...c7deb5e8934a79fb0ea4ff8b6ff7138680bb9a10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 15:19:10 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 11:19:10 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add MO_UU_Conv W64 W16 Message-ID: <64a2e6ee1306c_3cb82347504462137@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 6b512985 by Jaro Reinders at 2023-07-03T17:18:09+02:00 Add MO_UU_Conv W64 W16 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -842,7 +842,14 @@ getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W64 W32) [x]) getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W8) [x]) | is32Bit = do RegCode64 code _rhi rlo <- iselExpr64 x - return $ Fixed II8 rlo code + ro <- getNewRegNat II8 + return $ Fixed II8 ro (code `appOL` toOL [ MOV II8 (OpReg rlo) (OpReg ro) ]) + +getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W16) [x]) + | is32Bit = do + RegCode64 code _rhi rlo <- iselExpr64 x + ro <- getNewRegNat II16 + return $ Fixed II16 ro (code `appOL` toOL [ MOV II16 (OpReg rlo) (OpReg ro) ]) getRegister' _ _ (CmmLit lit@(CmmFloat f w)) = float_const_sse2 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b5129851c9525f1ecf3b6fec5324b77d84c0447 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b5129851c9525f1ecf3b6fec5324b77d84c0447 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 15:31:46 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 03 Jul 2023 11:31:46 -0400 Subject: [Git][ghc/ghc][wip/testsuite-no-cusks-transitional] 24 commits: Define FFI_GO_CLOSURES Message-ID: <64a2e9e23ddd2_3cb8231dd99c80467422@gitlab.mail> Vladislav Zavialov pushed to branch wip/testsuite-no-cusks-transitional at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - 4f01b811 by Vladislav Zavialov at 2023-07-03T18:04:36+03:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae1968d3a5fad94142bc992d290ba078e8074ba0...4f01b811d90b4d1a2b97ea463c68cc746a615bba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae1968d3a5fad94142bc992d290ba078e8074ba0...4f01b811d90b4d1a2b97ea463c68cc746a615bba You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 15:39:26 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 03 Jul 2023 11:39:26 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add MO_SS_Conv W16/W8 W64 Message-ID: <64a2ebae57fde_3cb82317b5c9144681f1@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 08553be2 by Jaro Reinders at 2023-07-03T17:39:18+02:00 Add MO_SS_Conv W16/W8 W64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -610,6 +610,28 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do r_dst_hi r_dst_lo +iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do + code <- getAnyReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code r_dst_lo `snocOL` + MOV II16 (OpReg r_dst_lo) (OpReg eax) `snocOL` + CLTD II16 `snocOL` + MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` + MOV II32 (OpReg edx) (OpReg r_dst_hi)) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do + code <- getAnyReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code r_dst_lo `snocOL` + MOV II8 (OpReg r_dst_lo) (OpReg eax) `snocOL` + CLTD II8 `snocOL` + MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` + MOV II32 (OpReg edx) (OpReg r_dst_hi)) + r_dst_hi + r_dst_lo + iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do RegCode64 code rhi rlo <- iselExpr64 expr Reg64 rohi rolo <- getNewReg64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/08553be2b8223389584146da8d5ffa06da022da0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/08553be2b8223389584146da8d5ffa06da022da0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 15:49:25 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 03 Jul 2023 11:49:25 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 6 commits: Create ghc_toolchain.m4 Message-ID: <64a2ee05d86da_3cb8234764447034@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: e7e50394 by Rodrigo Mesquita at 2023-07-03T16:24:04+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure - - - - - fe457151 by Rodrigo Mesquita at 2023-07-03T16:49:17+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - 1ca82b52 by Rodrigo Mesquita at 2023-07-03T16:49:17+01:00 refactor on hadrian handling of toolchains - - - - - 19de9a2d by Rodrigo Mesquita at 2023-07-03T16:49:17+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 38281491 by Rodrigo Mesquita at 2023-07-03T16:49:17+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - f9c16721 by Rodrigo Mesquita at 2023-07-03T16:49:17+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7deb5e8934a79fb0ea4ff8b6ff7138680bb9a10...f9c16721878cdab196c9746d95863acfca82b502 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7deb5e8934a79fb0ea4ff8b6ff7138680bb9a10...f9c16721878cdab196c9746d95863acfca82b502 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 19:20:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 15:20:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: configure: Rip out Solaris dyld check Message-ID: <64a31f8f215d2_3cb8234752c5190be@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d67faf40 by Ben Gamari at 2023-07-03T15:20:17-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 947b904e by Ben Gamari at 2023-07-03T15:20:17-04:00 Drop circle-ci-job.sh - - - - - 75c1c628 by Ben Gamari at 2023-07-03T15:20:17-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 2e65aca9 by Ben Gamari at 2023-07-03T15:20:17-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 6de81d98 by Jaro Reinders at 2023-07-03T15:20:18-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - ef715c68 by doyougnu at 2023-07-03T15:20:34-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - c36aadfc by Ben Gamari at 2023-07-03T15:20:35-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 4b1ff911 by Alan Zimmerman at 2023-07-03T15:20:36-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - a6e02909 by Matthew Pickering at 2023-07-03T15:20:36-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 01282ddc by Ben Gamari at 2023-07-03T15:20:37-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - 3938c97a by Ben Gamari at 2023-07-03T15:20:37-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - f80bde98 by Ben Gamari at 2023-07-03T15:20:37-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 2b8dc00a by Mario Blažević at 2023-07-03T15:20:40-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 4fcf45e9 by Ben Gamari at 2023-07-03T15:20:41-04:00 compiler: Make OccSet opaque - - - - - 08c6418c by Andrei Borzenkov at 2023-07-03T15:20:42-04:00 Add Note about why we need forall in Code to be on the right - - - - - 23 changed files: - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/feef8137bbb1d2d4c99abd0d0dbf254151e691cc...08c6418cb7aa84746fd07c54f3e0c2380716b713 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/feef8137bbb1d2d4c99abd0d0dbf254151e691cc...08c6418cb7aa84746fd07c54f3e0c2380716b713 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 3 22:33:20 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Mon, 03 Jul 2023 18:33:20 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 63 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64a34cb03a4ff_3cb82347644553742@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7bb7d91a by Alan Zimmerman at 2023-07-01T16:26:14+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 9aacd650 by Alan Zimmerman at 2023-07-01T16:28:55+01:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - f773ffc4 by Alan Zimmerman at 2023-07-01T16:31:27+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 21062c4d by Alan Zimmerman at 2023-07-01T19:59:36+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - dfa624d4 by Alan Zimmerman at 2023-07-02T10:11:26+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - fd352736 by Alan Zimmerman at 2023-07-02T10:25:15+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - dc0edf2d by Alan Zimmerman at 2023-07-02T10:25:18+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 0b38b820 by Alan Zimmerman at 2023-07-02T10:25:18+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - a6d11a4f by Alan Zimmerman at 2023-07-02T10:25:18+01:00 EPA: Fix span for GRHS - - - - - 9d31663e by Alan Zimmerman at 2023-07-02T10:25:18+01:00 EPA: Fix span for Located Context - - - - - 08b90d69 by Alan Zimmerman at 2023-07-02T10:25:18+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - 323eb009 by Alan Zimmerman at 2023-07-02T10:25:18+01:00 EPA: widen more TrailingAnn usages - - - - - 10d13a21 by Alan Zimmerman at 2023-07-02T10:25:18+01:00 EPA: Capture full range for a CaseAlt Match - - - - - d2875b4c by Alan Zimmerman at 2023-07-02T10:25:18+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - f2bed823 by Alan Zimmerman at 2023-07-02T10:25:19+01:00 WIP - - - - - 93993af1 by Alan Zimmerman at 2023-07-02T10:25:19+01:00 Fixup after rebase - - - - - 717caccb by Alan Zimmerman at 2023-07-02T10:25:19+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - f483b869 by Alan Zimmerman at 2023-07-02T10:25:19+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - b4e912cd by Alan Zimmerman at 2023-07-02T13:35:59+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - a38fdb5a by Alan Zimmerman at 2023-07-03T22:30:40+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 9cb0e930 by Alan Zimmerman at 2023-07-03T22:33:49+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 9ff3341e by Alan Zimmerman at 2023-07-03T22:35:17+01:00 EPA: More extending anchors to full span in Parser.y - - - - - d089deac by Alan Zimmerman at 2023-07-03T23:19:18+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/addc2a14cb442bd9b9a00274c9d6547653d18b96...d089deac3bba3e017285a002b6740b91c2bba1d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/addc2a14cb442bd9b9a00274c9d6547653d18b96...d089deac3bba3e017285a002b6740b91c2bba1d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 02:32:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 03 Jul 2023 22:32:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: configure: Rip out Solaris dyld check Message-ID: <64a384a0bde9c_3cb823476445846d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b46146b7 by Ben Gamari at 2023-07-03T22:31:33-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 5aec4ac8 by Ben Gamari at 2023-07-03T22:31:33-04:00 Drop circle-ci-job.sh - - - - - a569ba4d by Ben Gamari at 2023-07-03T22:31:33-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 44ef162b by Ben Gamari at 2023-07-03T22:31:33-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - e45cc78d by Jaro Reinders at 2023-07-03T22:31:34-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 4266550f by doyougnu at 2023-07-03T22:31:38-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 62d0a8fb by Ben Gamari at 2023-07-03T22:31:39-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 73fcf34b by Alan Zimmerman at 2023-07-03T22:31:40-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 0a5edec2 by Matthew Pickering at 2023-07-03T22:31:40-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 2bc15f78 by Ben Gamari at 2023-07-03T22:31:41-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - 18a04172 by Ben Gamari at 2023-07-03T22:31:41-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - ddd0e3d6 by Ben Gamari at 2023-07-03T22:31:41-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - d939fcf6 by Mario Blažević at 2023-07-03T22:31:44-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 043aa743 by Ben Gamari at 2023-07-03T22:31:45-04:00 compiler: Make OccSet opaque - - - - - 3ed4dd6f by Andrei Borzenkov at 2023-07-03T22:31:45-04:00 Add Note about why we need forall in Code to be on the right - - - - - 23 changed files: - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08c6418cb7aa84746fd07c54f3e0c2380716b713...3ed4dd6ff7b0019c4010654d50387e70789cae6d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08c6418cb7aa84746fd07c54f3e0c2380716b713...3ed4dd6ff7b0019c4010654d50387e70789cae6d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 02:48:26 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Mon, 03 Jul 2023 22:48:26 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to enable/disable incoherent instances Message-ID: <64a3887aa1668_3cb8231e88ad6061040@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 5e426bac by Gergő Érdi at 2023-07-04T03:48:14+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 9 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Instance/Class.hs - testsuite/tests/simplCore/should_run/T22448.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -812,8 +812,17 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. However, the +specialiser crucially depends on evidence dictionaries being +singletons. Something has to give: either we avoid specialising +dictionaries that were incoherently constructed, leaving optimisation +opportunities on the table; or we assume that the choice of instance +doesn't matter for the behaviour of the program, leaving this as a +proof obligation to the user. The flags `-fspecialise-incoherents` (on +by default) selects the second behaviour. The rest of this note +describes what happens with `-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -955,7 +964,7 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +data Coherence = IsCoherent | IsIncoherent | IsNoncanonical -- See Note [Recording coherence information in `PotentialUnifiers`] data PotentialUnifiers = NoUnifiers Coherence @@ -983,6 +992,7 @@ potential unifiers is otherwise empty. instance Outputable Coherence where ppr IsCoherent = text "coherent" ppr IsIncoherent = text "incoherent" + ppr IsNoncanonical = text "non-canonical" instance Outputable PotentialUnifiers where ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c @@ -990,6 +1000,8 @@ instance Outputable PotentialUnifiers where instance Semigroup Coherence where IsCoherent <> IsCoherent = IsCoherent + IsNoncanonical <> _ = IsNoncanonical + _ <> IsNoncanonical = IsNoncanonical _ <> _ = IsIncoherent instance Semigroup PotentialUnifiers where ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -1201,20 +1201,23 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring incoherent evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1236,40 +1239,46 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside + = do { spec_incoherents <- getSpecIncoherents + ; ds_ev_binds spec_incoherents ev_binds thing_inside } + +ds_ev_binds :: Bool -> Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a +ds_ev_binds spec_incoherents ev_binds thing_inside = do { ds_binds <- mapBagM dsEvBind ev_binds ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False + is_specable IsCoherent = True + is_specable IsIncoherent = spec_incoherents + is_specable IsNoncanonical = False - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + transitively_unspecable = not (is_specable this_coherence) || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where (pairs, direct_coherence) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not (is_specable this_coherence) || any is_unspecable_remote deps | (this_coherence, deps) <- direct_coherence ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring incoherent evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + getSpecIncoherents, addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -248,8 +248,10 @@ mkDsEnvsFromTcGbl hsc_env msg_var tcg_env ++ eps_complete_matches eps -- from imports -- re-use existing next_wrapper_num to ensure uniqueness next_wrapper_num_var = tcg_next_wrapper_num tcg_env + spec_incoherents = gopt Opt_SpecialiseIncoherents (hsc_dflags hsc_env) ; return $ mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num_var complete_matches + spec_incoherents } runDs :: HscEnv -> (DsGblEnv, DsLclEnv) -> DsM a -> IO (Messages DsMessage, Maybe a) @@ -282,6 +284,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds complete_matches = hptCompleteSigs hsc_env -- from the home package ++ local_complete_matches -- from the current module ++ eps_complete_matches eps -- from imports + spec_incoherents = gopt Opt_SpecialiseIncoherents (hsc_dflags hsc_env) bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -290,6 +293,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds envs = mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num complete_matches + spec_incoherents ; runDs hsc_env envs thing_inside } @@ -330,9 +334,10 @@ mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv -> PromotionTickContext -> IORef (Messages DsMessage) -> IORef CostCentreState -> IORef (ModuleEnv Int) -> CompleteMatches + -> Bool -> (DsGblEnv, DsLclEnv) mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var - next_wrapper_num complete_matches + next_wrapper_num complete_matches spec_incoherents = let if_genv = IfGblEnv { if_doc = text "mkDsEnvs" -- Failing tests here are `ghci` and `T11985` if you get this wrong. -- this is very very "at a distance" because the reason for this check is that the type_env in interactive @@ -353,11 +358,12 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var , ds_next_wrapper_num = next_wrapper_num + , ds_spec_incoherents = spec_incoherents } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +419,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv @@ -523,6 +529,9 @@ discardWarningsDs thing_inside ; return result } +getSpecIncoherents :: DsM Bool +getSpecIncoherents = ds_spec_incoherents <$> getGblEnv + -- | Inject a trace message into the compiled program. Whereas -- pprTrace prints out information *while compiling*, pprRuntimeTrace -- captures that information and causes it to be printed *at runtime* ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -11,7 +11,7 @@ module GHC.HsToCore.Types ( DsMetaEnv, DsMetaVal(..), CompleteMatches ) where -import GHC.Prelude (Int) +import GHC.Prelude (Int, Bool) import Data.IORef import qualified Data.Set as S @@ -65,6 +65,8 @@ data DsGblEnv -- Tracking indices for cost centre annotations , ds_next_wrapper_num :: IORef (ModuleEnv Int) -- ^ See Note [Generating fresh names for FFI wrappers] + + , ds_spec_incoherents :: Bool } instance ContainsModule DsGblEnv where @@ -79,9 +81,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar + , dsl_unspecables :: S.Set EvVar -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -448,7 +448,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_coherence = IsNoncanonical -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e426bacdc47b485675e140686c52a7c52a1508f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e426bacdc47b485675e140686c52a7c52a1508f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 02:54:19 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Mon, 03 Jul 2023 22:54:19 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to enable/disable incoherent instances Message-ID: <64a389db7ee7c_3cb8232a981d706108c8@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 880126b3 by Gergő Érdi at 2023-07-04T03:54:08+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 9 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Instance/Class.hs - testsuite/tests/simplCore/should_run/T22448.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -812,8 +812,19 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. However, the +specialiser crucially depends on evidence dictionaries being +singletons. Something has to give: either we avoid specialising +dictionaries that were incoherently constructed, leaving optimisation +opportunities on the table (see discussions in #23287); or we assume +that the choice of instance doesn't matter for the behaviour of the +program, leaving this as a proof obligation to the user. The flags +`-fspecialise-incoherents` (on by default) selects the second +behaviour, i.e. enables specialisation on incoherent evidence. The +rest of this note describes what happens with +`-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -955,7 +966,18 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +data Coherence = + -- | Coherent evidence that is always safe to specialise on + IsCoherent + | + -- | Incoherent evidence. The user might decide that they're OK with + -- specialising these. See Note [Coherence and specialisation: overview] + -- for the subtleties of this situation. + IsIncoherent + | + -- | Non-canonical evidence, a la `withDict`. Never OK to specialise. + -- See Note [withDict] in GHC.Tc.Instance.Class for details. + IsNoncanonical -- See Note [Recording coherence information in `PotentialUnifiers`] data PotentialUnifiers = NoUnifiers Coherence @@ -983,6 +1005,7 @@ potential unifiers is otherwise empty. instance Outputable Coherence where ppr IsCoherent = text "coherent" ppr IsIncoherent = text "incoherent" + ppr IsNoncanonical = text "non-canonical" instance Outputable PotentialUnifiers where ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c @@ -990,6 +1013,8 @@ instance Outputable PotentialUnifiers where instance Semigroup Coherence where IsCoherent <> IsCoherent = IsCoherent + IsNoncanonical <> _ = IsNoncanonical + _ <> IsNoncanonical = IsNoncanonical _ <> _ = IsIncoherent instance Semigroup PotentialUnifiers where ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -1201,20 +1201,23 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring incoherent evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1236,40 +1239,46 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside + = do { spec_incoherents <- getSpecIncoherents + ; ds_ev_binds spec_incoherents ev_binds thing_inside } + +ds_ev_binds :: Bool -> Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a +ds_ev_binds spec_incoherents ev_binds thing_inside = do { ds_binds <- mapBagM dsEvBind ev_binds ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False + is_specable IsCoherent = True + is_specable IsIncoherent = spec_incoherents + is_specable IsNoncanonical = False - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + transitively_unspecable = not (is_specable this_coherence) || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where (pairs, direct_coherence) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not (is_specable this_coherence) || any is_unspecable_remote deps | (this_coherence, deps) <- direct_coherence ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring incoherent evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + getSpecIncoherents, addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -248,8 +248,10 @@ mkDsEnvsFromTcGbl hsc_env msg_var tcg_env ++ eps_complete_matches eps -- from imports -- re-use existing next_wrapper_num to ensure uniqueness next_wrapper_num_var = tcg_next_wrapper_num tcg_env + spec_incoherents = gopt Opt_SpecialiseIncoherents (hsc_dflags hsc_env) ; return $ mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num_var complete_matches + spec_incoherents } runDs :: HscEnv -> (DsGblEnv, DsLclEnv) -> DsM a -> IO (Messages DsMessage, Maybe a) @@ -282,6 +284,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds complete_matches = hptCompleteSigs hsc_env -- from the home package ++ local_complete_matches -- from the current module ++ eps_complete_matches eps -- from imports + spec_incoherents = gopt Opt_SpecialiseIncoherents (hsc_dflags hsc_env) bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -290,6 +293,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds envs = mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num complete_matches + spec_incoherents ; runDs hsc_env envs thing_inside } @@ -330,9 +334,10 @@ mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv -> PromotionTickContext -> IORef (Messages DsMessage) -> IORef CostCentreState -> IORef (ModuleEnv Int) -> CompleteMatches + -> Bool -> (DsGblEnv, DsLclEnv) mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var - next_wrapper_num complete_matches + next_wrapper_num complete_matches spec_incoherents = let if_genv = IfGblEnv { if_doc = text "mkDsEnvs" -- Failing tests here are `ghci` and `T11985` if you get this wrong. -- this is very very "at a distance" because the reason for this check is that the type_env in interactive @@ -353,11 +358,12 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var , ds_next_wrapper_num = next_wrapper_num + , ds_spec_incoherents = spec_incoherents } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +419,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv @@ -523,6 +529,9 @@ discardWarningsDs thing_inside ; return result } +getSpecIncoherents :: DsM Bool +getSpecIncoherents = ds_spec_incoherents <$> getGblEnv + -- | Inject a trace message into the compiled program. Whereas -- pprTrace prints out information *while compiling*, pprRuntimeTrace -- captures that information and causes it to be printed *at runtime* ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -11,7 +11,7 @@ module GHC.HsToCore.Types ( DsMetaEnv, DsMetaVal(..), CompleteMatches ) where -import GHC.Prelude (Int) +import GHC.Prelude (Int, Bool) import Data.IORef import qualified Data.Set as S @@ -65,6 +65,8 @@ data DsGblEnv -- Tracking indices for cost centre annotations , ds_next_wrapper_num :: IORef (ModuleEnv Int) -- ^ See Note [Generating fresh names for FFI wrappers] + + , ds_spec_incoherents :: Bool } instance ContainsModule DsGblEnv where @@ -79,9 +81,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar + , dsl_unspecables :: S.Set EvVar -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -448,7 +448,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_coherence = IsNoncanonical -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/880126b39b65269d5e34239208fcad8505acadfa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/880126b39b65269d5e34239208fcad8505acadfa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 05:03:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 01:03:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: configure: Rip out Solaris dyld check Message-ID: <64a3a81791f5_3cb8231e88ad606554ef@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e07c1f25 by Ben Gamari at 2023-07-04T01:03:00-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 9f85905b by Jaro Reinders at 2023-07-04T01:03:00-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 45a94a3c by doyougnu at 2023-07-04T01:03:05-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 3cbc2db6 by Vladislav Zavialov at 2023-07-04T01:03:05-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 57e46db8 by Ben Gamari at 2023-07-04T01:03:06-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - db989e18 by Alan Zimmerman at 2023-07-04T01:03:07-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 5aefafd6 by Matthew Pickering at 2023-07-04T01:03:07-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - f8d003fe by Ben Gamari at 2023-07-04T01:03:08-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - d45e4463 by Ben Gamari at 2023-07-04T01:03:08-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - e432c417 by Ben Gamari at 2023-07-04T01:03:08-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - eaa65f9d by Mario Blažević at 2023-07-04T01:03:11-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - f2f653a4 by Matthew Pickering at 2023-07-04T01:03:11-04:00 Try deb10 for i386 bindists - - - - - 8b5636c3 by Ben Gamari at 2023-07-04T01:03:12-04:00 compiler: Make OccSet opaque - - - - - ec04392d by Andrei Borzenkov at 2023-07-04T01:03:13-04:00 Add Note about why we need forall in Code to be on the right - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ed4dd6ff7b0019c4010654d50387e70789cae6d...ec04392d2199f1532b3822f3c7fe43db104e3f82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ed4dd6ff7b0019c4010654d50387e70789cae6d...ec04392d2199f1532b3822f3c7fe43db104e3f82 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 07:53:12 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 04 Jul 2023 03:53:12 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor Unique to be represented by Word64 Message-ID: <64a3cfe870cb2_3cb8231e88ad60707073@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 4316bcbb by Jaro Reinders at 2023-07-04T09:52:35+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 18 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4316bcbbb48a2885cab981e50eb4000dde0ba870 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4316bcbbb48a2885cab981e50eb4000dde0ba870 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 07:58:29 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 04 Jul 2023 03:58:29 -0400 Subject: [Git][ghc/ghc][wip/T23576] Revert confFltCode changes Message-ID: <64a3d12591f12_3cb823821fd74711198@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 01b02766 by Jaro Reinders at 2023-07-04T09:58:15+02:00 Revert confFltCode changes - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1928,24 +1928,7 @@ condIntCode' platform cond x y = do condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode -- Larger-than-native (64-bit ops on 32-bit platforms) -condFltCode cond x y = do - platform <- getPlatform - if target32Bit platform && isFloat64 (cmmExprType platform x) - then panic "condFLtCode 64-bit on 32-bit platform" --- RegCode64 code1 r1hi r1lo <- iselExpr64 x --- RegCode64 code2 r2hi r2lo <- iselExpr64 y --- tmp <- getNewRegNat II32 --- let --- code = code1 `appOL` --- code2 `appOL` --- toOL [ FLD FF32 (OpReg r2lo) (OpReg tmp), --- FLD FF32 (OpReg tmp) (OpReg r1lo), --- MOV II32 (OpReg r2hi) (OpReg tmp), --- SBB II32 (OpReg r1hi) (OpReg tmp) --- ] --- --- return (CondCode False cond code) - else condFltCode_sse2 +condFltCode cond x y = condFltCode_sse2 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01b02766119113c5045cb3c17c5470557605853b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01b02766119113c5045cb3c17c5470557605853b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 08:53:55 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 04 Jul 2023 04:53:55 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Add flag checks where they are needed Message-ID: <64a3de22e0b99_3cb823476447181e@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: bb242bfb by Andrei Borzenkov at 2023-07-04T12:53:39+04:00 Add flag checks where they are needed - - - - - 7 changed files: - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - + testsuite/tests/rename/should_fail/T22478e.hs - + testsuite/tests/rename/should_fail/T22478e.stderr - + testsuite/tests/rename/should_fail/T22478f.hs - + testsuite/tests/rename/should_fail/T22478f.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Rename.HsType ( rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext, rnLHsKind, rnLHsTypeArgs, rnHsSigType, rnHsWcType, rnHsTyLit, - HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, + HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, rnHsPatSigTypeOnLevel, newTyVarNameRn, rnConDeclFields, lookupField, mkHsOpTyRn, @@ -37,7 +37,9 @@ module GHC.Rename.HsType ( extractHsTysRdrTyVars, extractRdrKindSigVars, extractConDeclGADTDetailsTyVars, extractDataDefnKindVars, extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars, - nubL, nubN + nubL, nubN, + -- Error helpers + badKindSigErr ) where import GHC.Prelude @@ -147,6 +149,14 @@ rnHsPatSigType :: HsPatSigTypeScoping -> HsPatSigType GhcPs -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) +rnHsPatSigType = rnHsPatSigTypeOnLevel TypeLevel + +rnHsPatSigTypeOnLevel :: TypeOrKind + -> HsPatSigTypeScoping + -> HsDocContext + -> HsPatSigType GhcPs + -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) + -> RnM (a, FreeVars) -- Used for -- - Pattern type signatures, which are only allowed with ScopedTypeVariables -- - Signatures on binders in a RULE, which are allowed even if @@ -154,7 +164,7 @@ rnHsPatSigType :: HsPatSigTypeScoping -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type -rnHsPatSigType scoping ctx sig_ty thing_inside +rnHsPatSigTypeOnLevel level scoping ctx sig_ty thing_inside = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) @@ -164,7 +174,7 @@ rnHsPatSigType scoping ctx sig_ty thing_inside AlwaysBind -> tv_rdrs NeverBind -> [] ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> - do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty + do { (nwcs, pat_sig_ty', fvs1) <- rnWcBodyOnLevel level ctx nwc_rdrs pat_sig_ty ; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs } sig_ty' = HsPS { hsps_ext = sig_names, hsps_body = pat_sig_ty' } ; (res, fvs2) <- thing_inside sig_ty' @@ -183,10 +193,14 @@ rnHsWcType ctxt (HsWC { hswc_body = hs_ty }) rnWcBody :: HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs + -> RnM ([Name], LHsType GhcRn, FreeVars) +rnWcBody = rnWcBodyOnLevel TypeLevel + +rnWcBodyOnLevel :: TypeOrKind -> HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs -> RnM ([Name], LHsType GhcRn, FreeVars) -rnWcBody ctxt nwc_rdrs hs_ty +rnWcBodyOnLevel level ctxt nwc_rdrs hs_ty = do { nwcs <- mapM newLocalBndrRn nwc_rdrs - ; let env = RTKE { rtke_level = TypeLevel + ; let env = RTKE { rtke_level = level , rtke_what = RnTypeBody , rtke_nwcs = mkNameSet nwcs , rtke_ctxt = ctxt } @@ -576,7 +590,7 @@ rnHsTyKi env listTy@(HsListTy x ty) rnHsTyKi env (HsKindSig x ty k) = do { kind_sigs_ok <- xoptM LangExt.KindSignatures - ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty) + ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) k) ; (k', sig_fvs) <- rnLHsTyKi (env { rtke_level = KindLevel }) k ; (ty', lhs_fvs) <- bindSigTyVarsFV (hsScopedKvs k') $ rnLHsTyKi env ty ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Rename.Utils ( newLocalBndrRn, bindLocalNames , warnUnusedMatches, newLocalBndrRn , checkUnusedRecordWildcard , checkDupNames, checkDupAndShadowedNames - , wrapGenSpan, genHsApps, genLHsVar, genHsIntegralLit, warnForallIdentifier, delLocalNames ) + , wrapGenSpan, genHsApps, genLHsVar, genHsIntegralLit, warnForallIdentifier, delLocalNames, typeAppErr ) import GHC.Rename.HsType import GHC.Builtin.Names @@ -80,7 +80,7 @@ import GHC.Builtin.Types ( nilDataCon ) import GHC.Core.DataCon import qualified GHC.LanguageExtensions as LangExt -import Control.Monad ( when, ap, guard ) +import Control.Monad ( when, ap, guard, unless ) import Data.Foldable import Data.Function ( on ) import Data.Functor.Identity ( Identity (..) ) @@ -93,6 +93,8 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Data.Functor ((<&>)) import GHC.Rename.Doc (rnLHsDoc) +import GHC.Types.Hint +import GHC.Types.Fixity (LexicalFixity(..)) {- ********************************************************* @@ -1256,6 +1258,8 @@ rn_ty_pat (HsAppTy _ fun_ty arg_ty) = do pure (HsAppTy noExtField fun_ty' arg_ty') rn_ty_pat (HsAppKindTy _ ty at ki) = do + kind_app <- liftRn $ xoptM LangExt.TypeApplications + unless kind_app (liftRn $ addErr (typeAppErr KindLevel ki)) ty' <- rn_lty_pat ty ki' <- rn_lty_pat ki pure (HsAppKindTy noExtField ty' at ki') @@ -1283,6 +1287,9 @@ rn_ty_pat (HsOpTy _ prom ty1 l_op ty2) = do l_op' <- rn_ty_pat_var l_op ty2' <- rn_lty_pat ty2 fix <- liftRn $ lookupTyFixityRn l_op' + let op_name = unLoc l_op' + when (isDataConName op_name && not (isPromoted prom)) $ + liftRn $ addDiagnostic (TcRnUntickedPromotedThing $ UntickedConstructor Infix op_name) liftRn $ mkHsOpTyRn prom l_op' fix ty1' ty2' rn_ty_pat (HsParTy an ty) = do @@ -1301,23 +1308,42 @@ rn_ty_pat (HsDocTy an ty haddock_doc) = do haddock_doc' <- liftRn $ rnLHsDoc haddock_doc pure (HsDocTy an ty' haddock_doc') -rn_ty_pat (HsExplicitListTy _ prom tys) = do +rn_ty_pat ty@(HsExplicitListTy _ prom tys) = do + data_kinds <- liftRn $ xoptM LangExt.DataKinds + unless data_kinds (liftRn $ addErr (TcRnDataKindsError TypeLevel ty)) + + unless (isPromoted prom) $ + liftRn $ addDiagnostic (TcRnUntickedPromotedThing $ UntickedExplicitList) + tys' <- mapM rn_lty_pat tys pure (HsExplicitListTy noExtField prom tys') -rn_ty_pat (HsExplicitTupleTy _ tys) = do +rn_ty_pat ty@(HsExplicitTupleTy _ tys) = do + data_kinds <- liftRn $ xoptM LangExt.DataKinds + unless data_kinds (liftRn $ addErr (TcRnDataKindsError TypeLevel ty)) tys' <- mapM rn_lty_pat tys pure (HsExplicitTupleTy noExtField tys') -rn_ty_pat (HsTyLit src lit) = - pure (HsTyLit src (rnHsTyLit lit)) +rn_ty_pat tyLit@(HsTyLit src t) = do + data_kinds <- liftRn $ xoptM LangExt.DataKinds + unless data_kinds (liftRn $ addErr (TcRnDataKindsError TypeLevel tyLit)) + when (negLit t) (liftRn $ addErr $ TcRnNegativeNumTypeLiteral tyLit) + pure (HsTyLit src (rnHsTyLit t)) + where + negLit :: HsTyLit (GhcPass p) -> Bool + negLit (HsStrTy _ _) = False + negLit (HsNumTy _ i) = i < 0 + negLit (HsCharTy _ _) = False rn_ty_pat (HsWildCardTy _) = pure (HsWildCardTy noExtField) rn_ty_pat (HsKindSig an ty ki) = do ctxt <- askDocContext - ~(HsPS hsps ki') <- liftRnWithCont $ rnHsPatSigType AlwaysBind ctxt (HsPS noAnn ki) + kind_sigs_ok <- liftRn $ xoptM LangExt.KindSignatures + unless kind_sigs_ok (liftRn $ badKindSigErr ctxt ki) + ~(HsPS hsps ki') <- liftRnWithCont $ + rnHsPatSigTypeOnLevel KindLevel AlwaysBind ctxt (HsPS noAnn ki) ty' <- rn_lty_pat ty tellTPB (tpb_hsps hsps) pure (HsKindSig an ty' ki') ===================================== testsuite/tests/rename/should_fail/T22478e.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE NoTypeApplications, NoKindSignatures, NoDataKinds #-} +module T where + +data Proxy a = P + +f (P @[a,b]) = () +g (P @1) = () +h (P @(t @k)) = () +j (P @(t :: k)) = () +k (P @('(a,b))) = () +l (P @"str") = () +d (P @'c') = () ===================================== testsuite/tests/rename/should_fail/T22478e.stderr ===================================== @@ -0,0 +1,29 @@ + +T22478e.hs:6:4: error: [GHC-68567] + Illegal type: ‘[a, b]’ + Suggested fix: Perhaps you intended to use DataKinds + +T22478e.hs:7:4: error: [GHC-68567] + Illegal type: ‘1’ + Suggested fix: Perhaps you intended to use DataKinds + +T22478e.hs:8:4: error: [GHC-23482] + Illegal visible kind application: @k + Suggested fix: Perhaps you intended to use TypeApplications + +T22478e.hs:9:13: error: [GHC-49378] + • Illegal kind signature ‘k’ + • In a type argument in a pattern + Suggested fix: Perhaps you intended to use KindSignatures + +T22478e.hs:10:4: error: [GHC-68567] + Illegal type: ‘'(a, b)’ + Suggested fix: Perhaps you intended to use DataKinds + +T22478e.hs:11:4: error: [GHC-68567] + Illegal type: ‘"str"’ + Suggested fix: Perhaps you intended to use DataKinds + +T22478e.hs:12:4: error: [GHC-68567] + Illegal type: ‘'c'’ + Suggested fix: Perhaps you intended to use DataKinds ===================================== testsuite/tests/rename/should_fail/T22478f.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -Werror=unticked-promoted-constructors #-} +module T where + +data Proxy a = P +data Op a b = a :- b + +f (P @[a,b]) = () +g (P @(a :- b)) = () ===================================== testsuite/tests/rename/should_fail/T22478f.stderr ===================================== @@ -0,0 +1,8 @@ + +T22478f.hs:8:4: error: [GHC-49957] [-Wunticked-promoted-constructors, Werror=unticked-promoted-constructors] + Unticked promoted list. + Suggested fix: Add a promotion tick, e.g. '[x,y,z]. + +T22478f.hs:9:4: error: [GHC-49957] [-Wunticked-promoted-constructors, Werror=unticked-promoted-constructors] + Unticked promoted constructor: :- + Suggested fix: Use ':- instead of :- ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -207,3 +207,5 @@ test('T23512a', normal, compile_fail, ['']) test('DifferentExportWarnings', normal, multimod_compile_fail, ['DifferentExportWarnings', '-v0']) test('T22478b', normal, compile_fail, ['']) test('T22478d', normal, compile_fail, ['']) +test('T22478e', normal, compile_fail, ['']) +test('T22478f', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb242bfb763cb7e8eee108029286ed8d2aab4f0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb242bfb763cb7e8eee108029286ed8d2aab4f0f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 09:21:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 05:21:17 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: ghc-toolchain: Toolchain Selection Message-ID: <64a3e48dbbe8b_3cb823475b872557b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 321c1d87 by Rodrigo Mesquita at 2023-07-04T10:21:02+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - f70603be by Rodrigo Mesquita at 2023-07-04T10:21:02+01:00 refactor on hadrian handling of toolchains - - - - - 45a71e53 by Rodrigo Mesquita at 2023-07-04T10:21:02+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 5aef7cae by Rodrigo Mesquita at 2023-07-04T10:21:03+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - cc680103 by Rodrigo Mesquita at 2023-07-04T10:21:03+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9c16721878cdab196c9746d95863acfca82b502...cc680103062e912818f5363a3dc44e4b4cb5481c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9c16721878cdab196c9746d95863acfca82b502...cc680103062e912818f5363a3dc44e4b4cb5481c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 10:23:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 06:23:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: configure: Rip out Solaris dyld check Message-ID: <64a3f32b8318f_3cb823ab89a0c7710ec@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a37601ad by Ben Gamari at 2023-07-04T06:23:03-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - d5b0d737 by doyougnu at 2023-07-04T06:23:19-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 48cdee63 by Vladislav Zavialov at 2023-07-04T06:23:20-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 090547fe by Ben Gamari at 2023-07-04T06:23:20-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 54067605 by Alan Zimmerman at 2023-07-04T06:23:21-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 3c9ae60d by Matthew Pickering at 2023-07-04T06:23:22-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 33ef3b24 by Ben Gamari at 2023-07-04T06:23:22-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - a3541795 by Ben Gamari at 2023-07-04T06:23:22-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3167b9c9 by Ben Gamari at 2023-07-04T06:23:22-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 06edb101 by Mario Blažević at 2023-07-04T06:23:28-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 9b7c7bae by Ben Gamari at 2023-07-04T06:23:29-04:00 compiler: Make OccSet opaque - - - - - 7f4f1497 by Andrei Borzenkov at 2023-07-04T06:23:29-04:00 Add Note about why we need forall in Code to be on the right - - - - - bcdb1900 by Hécate Moonlight at 2023-07-04T06:23:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 30 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Types/Name/Occurrence.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Flavour.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Settings/Warnings.hs - libraries/base/GHC/ForeignPtr.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - m4/fp_hs_cpp_cmd_with_args.m4 - mk/project.mk.in - rts/posix/Signals.c - testsuite/config/ghc - testsuite/driver/testlib.py - testsuite/tests/dependent/should_compile/Dep2.hs - testsuite/tests/dependent/should_compile/DkNameRes.hs - testsuite/tests/dependent/should_compile/KindEqualities2.hs - testsuite/tests/dependent/should_compile/RaeBlogPost.hs - testsuite/tests/dependent/should_compile/RaeJobTalk.hs - testsuite/tests/dependent/should_compile/T11711.hs - testsuite/tests/dependent/should_compile/T12442.hs - testsuite/tests/dependent/should_compile/T14066a.hs - testsuite/tests/dependent/should_compile/T14066a.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec04392d2199f1532b3822f3c7fe43db104e3f82...bcdb1900411e3a5908a5956f179173526b4f4f0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec04392d2199f1532b3822f3c7fe43db104e3f82...bcdb1900411e3a5908a5956f179173526b4f4f0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 11:25:24 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Tue, 04 Jul 2023 07:25:24 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] 24 commits: Define FFI_GO_CLOSURES Message-ID: <64a401a4cc492_399dfead1ec658ed@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - 60bbb880 by Torsten Schmits at 2023-07-04T13:20:50+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/HsToCore/Ticks.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf4d283479c5dad4323a9fad3a4e58f564d5c240...60bbb880b4a42dfbc4cdb04ccc88fe040651a729 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf4d283479c5dad4323a9fad3a4e58f564d5c240...60bbb880b4a42dfbc4cdb04ccc88fe040651a729 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 12:32:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 08:32:42 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 6 commits: Create ghc_toolchain.m4 Message-ID: <64a4116ac2dc6_399dfead23c77876@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 555f019d by Rodrigo Mesquita at 2023-07-04T13:29:21+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 119472c3 by Rodrigo Mesquita at 2023-07-04T13:30:42+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc - - - - - 88c7b472 by Rodrigo Mesquita at 2023-07-04T13:32:08+01:00 refactor on hadrian handling of toolchains - - - - - c9cc99be by Rodrigo Mesquita at 2023-07-04T13:32:31+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 2dddb96b by Rodrigo Mesquita at 2023-07-04T13:32:33+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 8812f86c by Rodrigo Mesquita at 2023-07-04T13:32:33+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc680103062e912818f5363a3dc44e4b4cb5481c...8812f86c3a712a50804c08436352363e7fe89708 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc680103062e912818f5363a3dc44e4b4cb5481c...8812f86c3a712a50804c08436352363e7fe89708 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 12:41:54 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 08:41:54 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: ghc-toolchain: Toolchain Selection Message-ID: <64a41392d0bf3_399dfead23c802aa@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c2a99b47 by Rodrigo Mesquita at 2023-07-04T13:41:44+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - d893f18d by Rodrigo Mesquita at 2023-07-04T13:41:46+01:00 refactor on hadrian handling of toolchains - - - - - 24257ecb by Rodrigo Mesquita at 2023-07-04T13:41:46+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - d9096582 by Rodrigo Mesquita at 2023-07-04T13:41:46+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - a6a4fa0f by Rodrigo Mesquita at 2023-07-04T13:41:46+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8812f86c3a712a50804c08436352363e7fe89708...a6a4fa0fda9a205cb3752af6cdd5ec0bae4be4d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8812f86c3a712a50804c08436352363e7fe89708...a6a4fa0fda9a205cb3752af6cdd5ec0bae4be4d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 12:50:02 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 08:50:02 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: configure: Create and validate toolchain target file Message-ID: <64a41579db4f1_399dfead214806e2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7c344e0f by Rodrigo Mesquita at 2023-07-04T13:49:51+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 65dc40c1 by Rodrigo Mesquita at 2023-07-04T13:49:51+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - b276df1f by Rodrigo Mesquita at 2023-07-04T13:49:51+01:00 Use ghc-platform instead of ghc-boot - - - - - 25 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/stack.yaml - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs - m4/fp_prog_ar_needs_ranlib.m4 - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - mk/project.mk.in - utils/ghc-toolchain/ghc-toolchain.cabal - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -643,7 +643,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? @@ -1180,6 +1179,10 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1188,6 +1191,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. @@ -1301,3 +1305,6 @@ mk/build.mk.sample to mk/build.mk, and edit the settings in there. For more information on how to configure your GHC build, see https://gitlab.haskell.org/ghc/ghc/wikis/building "] + +VALIDATE_GHC_TOOLCHAIN + ===================================== default.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtVendor = @HostVendor_CPPMaybeStr@ +, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ +, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ +, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ +, tgtWordSize = WS at TargetWordSize@ +, tgtEndianness = @TargetEndianness@ +, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ +, tgtLlvmTarget = "@LlvmTarget@" +, tgtUnregisterised = @UnregisterisedBool@ +, tgtTablesNextToCode = @TablesNextToCodeBool@ +, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @SettingsCPPFlagsList@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@SettingsHaskellCPPCommand@", prgFlags = @SettingsHaskellCPPFlagsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} +, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ +, ccLinkSupportsFilelist = @LdHasFilelistBool@ +, ccLinkIsGnu = @LdIsGNULdBool@ +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@SettingsArCommand@", prgFlags = @ArArgsList@} +, arIsGnu = @ArIsGNUArBool@ +, arSupportsAtFile = @ArSupportsAtFileBool@ +, arSupportsDashL = @ArSupportsDashLBool@ +, arNeedsRanlib = @ArNeedsRanLibBool@ +} + +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@SettingsRanlibCommand@", prgFlags = []}}) +, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}, mergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFilesBool@}) +, tgtDllwrap = @SettingsDllWrapCommandMaybeProg@ +, tgtWindres = @SettingsWindresCommandMaybeProg@ +} ===================================== distrib/configure.ac.in ===================================== @@ -57,10 +57,12 @@ if test "$target" != "$host" ; then # configure: error: cannot run C compiled programs. # If you meant to cross compile, use `--host'. fi +LeadingUnderscore="@LeadingUnderscore@" CrossCompilePrefix="@CrossCompilePrefix@" TargetPlatformFull="${target}" TablesNextToCode="@TablesNextToCode@" +AC_SUBST(LeadingUnderscore) AC_SUBST(CrossCompiling) AC_SUBST(CrossCompilePrefix) AC_SUBST(TargetPlatformFull) @@ -285,6 +287,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS AC_CONFIG_FILES([config.mk]) +AC_CONFIG_FILES([default.target]) AC_OUTPUT # We get caught by @@ -306,6 +309,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + echo "****************************************************" echo "Configuration done, ready to 'make install'" echo "(see README and INSTALL files for more info.)" ===================================== hadrian/bindist/Makefile ===================================== @@ -1,7 +1,10 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: +# Configuration from the source distribution's configure script. include ./mk/project.mk + +# Configuration from the binary distribution's configure script. include ./config.mk .PHONY: default ===================================== hadrian/bindist/config.mk.in ===================================== @@ -254,6 +254,8 @@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ +LeadingUnderscore = @LeadingUnderscore@ +LlvmTarget = @LlvmTarget@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ ===================================== hadrian/cabal.project ===================================== @@ -1,5 +1,6 @@ packages: ./ ../utils/ghc-toolchain/ + ../libraries/ghc-platform/ -- This essentially freezes the build plan for hadrian index-state: 2023-03-30T10:00:00Z ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -83,6 +83,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -258,6 +258,7 @@ bindistRules = do need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") + copyFile ("default.target.in") (bindistFilesDir -/- "default.target.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== hadrian/stack.yaml ===================================== @@ -3,6 +3,7 @@ resolver: lts-19.8 packages: - '.' - '../utils/ghc-toolchain' +- '../libraries/ghc-platform' nix: enable: false ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,8 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the + non-reinstallable `ghc-boot` package into this reinstallable standalone + package which abides by the PVP, in part motivated by the ongoing work on + `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.15.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== ===================================== m4/fp_prog_ar_needs_ranlib.m4 ===================================== @@ -46,4 +46,5 @@ AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[ fi AC_SUBST([REAL_RANLIB_CMD]) AC_SUBST([RANLIB_CMD]) + AC_SUBST([ArNeedsRanLib],[`echo $fp_cv_prog_ar_needs_ranlib | tr 'a-z' 'A-Z'`]) ])# FP_PROG_AR_NEEDS_RANLIB ===================================== m4/ghc_toolchain.m4 ===================================== @@ -30,7 +30,7 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG_NOT], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain @@ -93,8 +93,26 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) &1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([ + There are some differences between the toolchain configured by "configure" ($A) and the toolchain configured by the "ghc-toolchain" program ($B). + $diff_output + Don't worry! This won't affect your ghc in any way. + However, in a near future, we will move to configuring toolchains with "ghc-toolchain" by default, so you might have discovered a future bug! + In light of it, if you've spotted this difference, please report a GHC bug at + https://www.haskell.org/ghc/reportabug + ]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,135 @@ +# PREP_MAYBE_SIMPLE_PROGRAM +# ========================= +# +# Issue a substitution of [$1MaybeProg] with +# * Nothing, if $1 is /bin/false (this is unfortunately hardcoded since SettingsDllWrapCommand and SettingsWindresCommand get set to this on windows). +# * Just (Program {prgPath = "$$1", prgFlags = []}), otherwise +# +# $1 = optional value +AC_DEFUN([PREP_MAYBE_SIMPLE_PROGRAM],[ + case "$$1" in + /bin/false) + $1MaybeProg='Nothing' + ;; + *) + $1MaybeProg='Just (Program {prgPath = "$$1", prgFlags = @<:@@:>@})' + ;; + esac + AC_SUBST([$1MaybeProg]) +]) + +# PREP_MAYBE_STRING +# ========================= +# +# Issue a substitution of [$1MaybeStr] with +# * Nothing, if $1 is empty +# * Just "$$1", otherwise +# +# $1 = optional value +AC_DEFUN([PREP_MAYBE_STRING],[ + if test -z "$$1"; then + $1MaybeStr=Nothing + else + $1MaybeStr="Just \"$$1\"" + fi + AC_SUBST([$1MaybeStr]) +]) + +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# i.e. +# "arg1 arg2 arg3" +# ==> +# ["arg1","arg2","arg3"] +# +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + $1List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([MergeObjsSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_BOOLEAN([ArIsGNUAr]) + PREP_BOOLEAN([ArNeedsRanLib]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([SettingsHaskellCPPFlags]) + PREP_LIST([SettingsCPPFlags]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) + PREP_MAYBE_SIMPLE_PROGRAM([SettingsDllWrapCommand]) + PREP_MAYBE_SIMPLE_PROGRAM([SettingsWindresCommand]) + PREP_MAYBE_STRING([HostVendor_CPP]) + + dnl PREP_ENDIANNESS + case "$TargetWordBigEndian" in + YES) + TargetEndianness=BigEndian + ;; + NO) + TargetEndianness=LittleEndian + ;; + *) + AC_MSG_ERROR([m4/prep_target_file.m4: Expecting YES/NO but got $TargetWordBigEndian in TargetWordBigEndian]) + ;; + esac + AC_SUBST([TargetEndianness]) +]) + +AC_DEFUN() ===================================== mk/project.mk.in ===================================== @@ -123,11 +123,6 @@ BuildVendor_CPP = @BuildVendor_CPP@ # ################################################################################ -# Leading underscores on symbol names in object files -# Valid options: YES/NO -# -LeadingUnderscore=@LeadingUnderscore@ - # Pin a suffix on executables? If so, what (Windows only). exeext0=@exeext_host@ exeext1=@exeext_target@ ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -36,8 +36,7 @@ library filepath, process, transformers, - async, - ghc-boot + ghc-platform hs-source-dirs: src default-language: Haskell2010 @@ -50,6 +49,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -72,7 +72,36 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +instance Show Target where + show Target{..} = unlines + [ "Target" + , "{ tgtArchOs = " ++ show tgtArchOs + , ", tgtVendor = " ++ show tgtVendor + , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack + , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols + , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective + , ", tgtWordSize = " ++ show tgtWordSize + , ", tgtEndianness = " ++ show tgtEndianness + , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore + , ", tgtLlvmTarget = " ++ show tgtLlvmTarget + , ", tgtUnregisterised = " ++ show tgtUnregisterised + , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode + , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtCCompiler = " ++ show tgtCCompiler + , ", tgtCxxCompiler = " ++ show tgtCxxCompiler + , ", tgtCPreprocessor = " ++ show tgtCPreprocessor + , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor + , ", tgtCCompilerLink = " ++ show tgtCCompilerLink + , ", tgtAr = " ++ show tgtAr + , ", tgtRanlib = " ++ show tgtRanlib + , ", tgtNm = " ++ show tgtNm + , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtDllwrap = " ++ show tgtDllwrap + , ", tgtWindres = " ++ show tgtDllwrap + , "}" + ] -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,7 +17,19 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show Ar where + show Ar{..} = unlines + [ "Ar" + , "{ arMkArchive = " ++ show arMkArchive + , ", arIsGnu = " ++ show arIsGnu + , ", arSupportsAtFile = " ++ show arSupportsAtFile + , ", arSupportsDashL = " ++ show arSupportsDashL + , ", arNeedsRanlib = " ++ show arNeedsRanlib + , "}" + ] findAr :: Maybe String -- ^ Vendor name from the target triple, if specified -> ProgOpt -> M Ar ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where @@ -23,7 +24,19 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsFilelist :: Bool -- This too , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show CcLink where + show CcLink{..} = unlines + [ "CcLink" + , "{ ccLinkProgram = " ++ show ccLinkProgram + , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie + , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind + , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist + , ", ccLinkIsGnu = " ++ show ccLinkIsGnu + , "}" + ] _ccLinkProgram :: Lens CcLink Program _ccLinkProgram = Lens ccLinkProgram (\x o -> o{ccLinkProgram=x}) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6a4fa0fda9a205cb3752af6cdd5ec0bae4be4d6...b276df1f69357d407d0492ac2bc435c89f524dac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6a4fa0fda9a205cb3752af6cdd5ec0bae4be4d6...b276df1f69357d407d0492ac2bc435c89f524dac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 13:42:51 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 09:42:51 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 6 commits: Create ghc_toolchain.m4 Message-ID: <64a421db35098_399dfead1b0115663@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 110ec048 by Rodrigo Mesquita at 2023-07-04T14:42:43+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 2b583262 by Rodrigo Mesquita at 2023-07-04T14:42:43+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - 0da2d985 by Rodrigo Mesquita at 2023-07-04T14:42:43+01:00 refactor on hadrian handling of toolchains - - - - - 547ad18d by Rodrigo Mesquita at 2023-07-04T14:42:43+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 36429a87 by Rodrigo Mesquita at 2023-07-04T14:42:43+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 78fef9ef by Rodrigo Mesquita at 2023-07-04T14:42:43+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b276df1f69357d407d0492ac2bc435c89f524dac...78fef9efaf78b03ad5257f84803e578c87afd023 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b276df1f69357d407d0492ac2bc435c89f524dac...78fef9efaf78b03ad5257f84803e578c87afd023 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 15:35:49 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 04 Jul 2023 11:35:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghcup-metadata-fixes2 Message-ID: <64a43c55a4e04_399dfead1b01883c4@gitlab.mail> Matthew Pickering pushed new branch wip/ghcup-metadata-fixes2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghcup-metadata-fixes2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 15:38:30 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 04 Jul 2023 11:38:30 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Fix TH failing on JS backend Message-ID: <64a43cf66f815_399dfead21419366@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 6da65362 by Andrei Borzenkov at 2023-07-04T19:38:20+04:00 Fix TH failing on JS backend - - - - - 1 changed file: - testsuite/tests/rename/should_compile/all.T Changes: ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -220,4 +220,4 @@ test('ExportWarnings3', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_a test('ExportWarnings4', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings4', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings5', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings5', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings6', normal, compile, ['-Wincomplete-export-warnings']) -test('T22478a', normal, compile, ['']) +test('T22478a', req_th, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6da65362b2b73e48114b9ae0194da87bc2189328 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6da65362b2b73e48114b9ae0194da87bc2189328 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 16:34:44 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 12:34:44 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Revert "Mingw bundled toolchain" Message-ID: <64a44a24f1e62_399dfe727d5b02170dd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: b76647a2 by Rodrigo Mesquita at 2023-07-04T16:54:08+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - d5c63707 by Rodrigo Mesquita at 2023-07-04T17:34:37+01:00 Fixes and extensions - - - - - 7 changed files: - hadrian/src/Oracles/Flag.hs - m4/fp_link_supports_no_as_needed.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs Changes: ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -79,8 +79,8 @@ platformSupportsGhciObjects = isJust <$> queryTargetTarget tgtMergeObjs arSupportsDashL :: Stage -> Action Bool -- ROMES:TODO: Build vs Host vs Target, is it Build and Host or Host and Target here? -arSupportsDashL (Stage0 {}) = queryBuildTarget (Toolchain.arSupportsDashL . tgtAr) -arSupportsDashL _ = queryHostTarget (Toolchain.arSupportsDashL . tgtAr) +arSupportsDashL (Stage0 {}) = queryHostTarget (Toolchain.arSupportsDashL . tgtAr) +arSupportsDashL _ = queryBuildTarget (Toolchain.arSupportsDashL . tgtAr) arSupportsAtFile :: Stage -> Action Bool arSupportsAtFile (Stage0 {}) = queryBuildTarget (Toolchain.arSupportsAtFile . tgtAr) ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -5,7 +5,6 @@ # See also Note [ELF needed shared libs] AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], [ - # Why isn't this working on i386? AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) echo 'int f(int a) {return 2*a;}' > conftest.a.c echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c ===================================== m4/ghc_toolchain.m4 ===================================== @@ -17,14 +17,18 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], fi ]) -dnl like ENABLE_GHC_TOOLCHAIN_ARG, but maps YES to --disable-X, and NO to --enable-X -AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG_NOT], +AC_DEFUN([INVOKE_GHC_TOOLCHAIN], [ - if test "$2" = "YES"; then - echo "--disable-$1" >> acargs - elif test "$2" = "NO"; then - echo "--enable-$1" >> acargs - fi + ( + set -- + while read -r arg; do + set -- "[$]@" "$arg" + done + # For now, we don't exit even if ghc-toolchain fails. We don't want to + # fail configure due to it, since the target file is still being generated by configure. + ./acghc-toolchain -v2 "[$]@" # || exit 1 + python3 -c 'import sys; print(sys.argv)' "[$]@" + ) > acargs + echo "--output=default.ghc-toolchain.host.target" >> acargs + dnl echo "--llvm-triple=$LlvmTarget" >> acargs + echo "--cc=$CC_STAGE0" >> acargs + dnl echo "--readelf=$READELF" >> acargs + dnl echo "--cpp=$CPPCmd" >> acargs + dnl echo "--hs-cpp=$HaskellCPPCmd" >> acargs + echo "--cc-link=$CC_STAGE0" >> acargs + dnl echo "--cxx=$CXX" >> acargs + echo "--ar=$AR_STAGE0" >> acargs + dnl echo "--ranlib=$RANLIB" >> acargs + dnl echo "--nm=$NM" >> acargs - # (1) Configure a toolchain for the build and host platform (we require that BUILD=HOST, so one toolchain suffices) - ./acghc-toolchain -v2 --triple="$HostPlatform" --output="default.host.ghc-toolchain.target" - # ROMES:TODO: Should we pass --bundled-windows-toolchain to the Host configuration? + echo "ACARGS-HOST" + cat acargs + + INVOKE_GHC_TOOLCHAIN() - # (2) Configure a toolchain for the target platform - # The resulting + # (2) Configure a toolchain for the target platform (the toolchain is based + # on the triple (or manually specified), and runs on the platform + # configuring it and produces code for the given target) + # We might not find the correct toolchain, and fallback to the default + # toolchain. We should handle it more graciously. + # + # We pass the paths to the programs found by configure. + # The flags for the toolchain configured by ghc-toolchain will still be + # validated against those configured by configure, but ghc-toolchain + # doesn't take into account things like environment variables or bundled + # (windows) toolchains, so we explicitly pass them as arguments here. + # ghc-toolchain is still able to find programs if not explicitly given in + # the usual system locations, including the PATH, we are just explicit when + # calling it through configure. + rm -f acargs echo "--triple=$target" >> acargs echo "--output=default.ghc-toolchain.target" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs - # echo "--cc=$CC" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - - # # CPP flags - # echo "--cpp=$CPPCmd" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) - - # # HS CPP flags - # echo "--hs-cpp=$HaskellCPPCmd" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) - - # echo "--cc-link=$CC" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) - # echo "--cxx=$CXX" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$CONF_CXX_OPTS_STAGE1]) - # echo "--ar=$AR" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([ar-opt], [$ARFLAGS]) - # echo "--ranlib=$RANLIB" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([ranlib-opt], [$RANLIBFLAGS]) - # echo "--nm=$NM" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([nm-opt], [$NMFLAGS]) - # echo "--readelf=$READELF" >> acargs - # ADD_GHC_TOOLCHAIN_ARG([readelf-opt], [$READELFFLAGS]) - + echo "--cc=$CC" >> acargs + echo "--readelf=$READELF" >> acargs + echo "--cpp=$CPPCmd" >> acargs + echo "--hs-cpp=$HaskellCPPCmd" >> acargs + echo "--cc-link=$CC" >> acargs + echo "--cxx=$CXX" >> acargs + echo "--ar=$AR" >> acargs + echo "--ranlib=$RANLIB" >> acargs + echo "--nm=$NM" >> acargs ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) - ENABLE_GHC_TOOLCHAIN_ARG_NOT([bundled-windows-toolchain], [$EnableDistroToolchain]) - # romes:todo: when do we want to add bundled-windows-toolchain? - # For Host or Target? - if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then - echo "--bundled-windows-toolchain=$mingwbin" >> acargs - else - true - fi - - ( - set -- - while read -r arg; do - set -- "[$]@" "$arg" - done - # For now, we don't exit even if ghc-toolchain fails. We don't want to - # fail configure due to it, since the target file is still being generated by configure. - ./acghc-toolchain -v2 "[$]@" # || exit 1 - python3 -c 'import sys; print(sys.argv)' "[$]@" - ) o {optTriple=x}) _optLlvmTriple :: Lens Opts (Maybe String) _optLlvmTriple = Lens optLlvmTriple (\x o -> o {optLlvmTriple=x}) -_optBundledWindowsToolchain :: Lens Opts (Maybe String) -_optBundledWindowsToolchain = Lens optBundledWindowsToolchain (\x o -> o {optBundledWindowsToolchain=x}) - -_optUseBundledWindowsToolchain :: Lens Opts (Maybe Bool) -_optUseBundledWindowsToolchain = Lens optUseBundledWindowsToolchain (\x o -> o {optUseBundledWindowsToolchain=x}) - _optOutput :: Lens Opts String _optOutput = Lens optOutput (\x o -> o {optOutput=x}) @@ -148,11 +137,9 @@ options = , verbosityOpt , keepTempOpt , outputOpt - , bundledWindowsToolchainOpt ] ++ concat - [ enableDisable "bundled-windows-toolchain" "Do not use bundled Windows toolchain binaries" _optUseBundledWindowsToolchain - , enableDisable "unregisterised" "unregisterised backend" _optUnregisterised + [ enableDisable "unregisterised" "unregisterised backend" _optUnregisterised , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode , enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride @@ -220,9 +207,6 @@ options = outputOpt = Option ['o'] ["output"] (ReqArg (set _optOutput) "OUTPUT") "The output path for the generated target toolchain configuration" - bundledWindowsToolchainOpt = Option [] ["bundled-windows-toolchain"] (OptArg (set _optBundledWindowsToolchain) "path to bundled windows toolchain") - "The path to the bundled Windows toolchain binaries." - main :: IO () main = do argv <- getArgs @@ -230,32 +214,11 @@ main = do let opts = foldr (.) id opts0 emptyOpts case errs of [] -> do - -- Note that we inline the infix check for `mingw32` since `parseTriple` is harder to call - let isWindows = "mingw32" `isInfixOf` optTriple opts - - -- Validate that, on a windows platform, either --disable-bundled-windows-toolchain - -- or --bundled-windows-toolchain=path was specified - case ( isWindows - , optUseBundledWindowsToolchain opts - , optBundledWindowsToolchain opts) of - (False, _, Just _) -> - putStrLn "Warning: Ignoring --bundled-windows-toolchain since --triple is a non-windows platform" - (False, _, _) -> pure () - (True, Just False, Just _) -> - putStrLn "Warning: Ignoring --disabled-bundled-windows-toolchain since --bundled-windows-toolchain was specified" - (True, Just False, _) -> pure () - (True, _, Nothing) -> do - putStrLn "On windows, either a path to the bundled toolchain must be given with --bundled-windows-toolchain=\"...\", or --disable-bundled-windows-toolchain must be specified to use another mingw distribution." - exitWith (ExitFailure 1) - let env = Env { verbosity = optVerbosity opts , targetPrefix = case optTargetPrefix opts of Just prefix -> Just prefix Nothing -> Just $ optTriple opts ++ "-" , keepTemp = optKeepTemp opts - , bundledWindowsToolchain = if isWindows - then optBundledWindowsToolchain opts - else Nothing , logContexts = [] } r <- runM env (run opts) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Toolchain.Monad , M , runM , getEnv - , asksEnv , makeM , throwE , ifCrossCompiling @@ -39,7 +38,6 @@ import System.IO hiding (readFile, writeFile, appendFile) data Env = Env { verbosity :: Int , targetPrefix :: Maybe String - , bundledWindowsToolchain :: Maybe String -- ^ Whether to use the bundled windows toolchain. This is only `Just` on windows and when --bundled-windows-toolchain was specified. , keepTemp :: Bool , logContexts :: [String] } @@ -54,9 +52,6 @@ runM env (M k) = getEnv :: M Env getEnv = M $ lift Reader.ask -asksEnv :: (Env -> a) -> M a -asksEnv f = M $ lift (Reader.asks f) - makeM :: IO (Either [Error] a) -> M a makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io))) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} module GHC.Toolchain.Program ( Program(..) , _prgPath @@ -130,17 +129,10 @@ findProgram description userSpec candidates toProgram path = Program { prgPath = path, prgFlags = fromMaybe [] (poFlags userSpec) } find_it name = do - r <- asksEnv bundledWindowsToolchain >>= \case - - -- Find executable in the bundled windows toolchain - Just path -> listToMaybe <$> liftIO (findExecutablesInDirectories [path] name) - - -- Find executable in system (see 'findExecutable' from System.Directory) - Nothing -> liftIO (findExecutable name) - - case r of - Nothing -> throwE $ name ++ " not found in search path" - Just x -> return x + r <- liftIO $ findExecutable name + case r of + Nothing -> throwE $ name ++ " not found in search path" + Just x -> return x -------------------- Compiling utilities -------------------- ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -40,13 +40,14 @@ findCc llvmTarget progOpt = checking "for C compiler" $ do -- there's a more optimal one ccProgram' <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] - ccProgram <- asksEnv bundledWindowsToolchain >>= \case - Nothing -> pure ccProgram' - Just _ -> - -- Signal that we are linking against UCRT with the _UCRT macro. This is - -- necessary to ensure correct behavior when MinGW-w64 headers are in the - -- header include path (#22159). - pure $ ccProgram' & _prgFlags %++ "--rtlib=compiler-rt -D_UCRT" + -- we inline the windows check here because we need Cc to call parseTriple + let ccProgram = if "mingw32" `isInfixOf` llvmTarget && takeBaseName (prgPath ccProgram') == "clang" + then ccProgram' + else + -- Signal that we are linking against UCRT with the _UCRT macro. This is + -- necessary on windows clang to ensure correct behavior when + -- MinGW-w64 headers are in the header include path (#22159). + ccProgram' & _prgFlags %++ "--rtlib=compiler-rt -D_UCRT" cc' <- ignoreUnusedArgs $ Cc {ccProgram} cc <- ccSupportsTarget llvmTarget cc' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78fef9efaf78b03ad5257f84803e578c87afd023...d5c63707b2db9805e263604f0fd7b1e20d1407e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78fef9efaf78b03ad5257f84803e578c87afd023...d5c63707b2db9805e263604f0fd7b1e20d1407e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 17:00:49 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Tue, 04 Jul 2023 13:00:49 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] Filter out nontrivial substituted expressions in substTickish Message-ID: <64a450414c27c_399dfe727d5b022774a@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: cf7ff2ed by Torsten Schmits at 2023-07-04T19:00:35+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 20 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - docs/users_guide/debugging.rst - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/ghc-api/target-contents/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/numeric/should_run/all.T - testsuite/tests/primops/should_run/all.T - testsuite/tests/programs/jtod_circint/test.T - testsuite/tests/rts/all.T - testsuite/tests/simplCore/T9646/test.T - + testsuite/tests/simplCore/should_compile/T23272.hs - + testsuite/tests/simplCore/should_compile/T23272.script - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, orElse ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -1436,7 +1436,7 @@ simplTick env tickish expr cont simplTickish env tickish | Breakpoint ext n ids modl <- tickish - = Breakpoint ext n (map (getDoneId . substId env) ids) modl + = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl | otherwise = tickish -- Push type application and coercion inside a tick @@ -1447,8 +1447,9 @@ simplTick env tickish expr cont where (inc,outc) = splitCont c splitCont other = (mkBoringStop (contHoleType other), other) - getDoneId (DoneId id) = id - getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst + getDoneId (DoneId id) = Just id + getDoneId (DoneEx (Var id) _) = Just id + getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst getDoneId other = pprPanic "getDoneId" (ppr other) -- Note [case-of-scc-of-case] ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -592,9 +592,9 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids modl) - = Breakpoint ext n (map do_one ids) modl + = Breakpoint ext n (mapMaybe do_one ids) modl where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst substTickish _subst other = other {- Note [Substitute lazily] @@ -649,6 +649,13 @@ Second, we have to ensure that we never try to substitute a literal for an Id in a breakpoint. We ensure this by never storing an Id with an unlifted type in a Breakpoint - see GHC.HsToCore.Ticks.mkTickish. Breakpoints can't handle free variables with unlifted types anyway. + +These measures are only reliable with unoptimized code. +Since we can now enable optimizations for GHCi with + at -fno-unoptimized-core-for-interpreter -O@, nontrivial expressions can be +substituted, e.g. by specializations. +Therefore we resort to discarding free variables from breakpoints when this +situation occurs. -} {- ===================================== docs/users_guide/debugging.rst ===================================== @@ -1203,3 +1203,9 @@ Other This option can be used to override this check, e.g. ``ghci -O2 -fno-unoptimized-core-for-interpreter``. It is not recommended for normal use and can cause a compiler panic. + + Note that this has an effect on the debugger interface: With optimizations + in play, free variables in breakpoints may now be substituted with complex + expressions. + Those cannot be stored in breakpoints, so any free variable that refers to + optimized code will not be inspectable when this flag is enabled. ===================================== libraries/base/tests/IO/all.T ===================================== @@ -96,7 +96,6 @@ test('hGetBuf001', [ when(fast(), skip) , expect_fail_if_windows , js_broken(22374) - , expect_broken_for(23272, ['ghci-opt']) , req_process ], compile_and_run, ['-package unix']) ===================================== libraries/base/tests/all.T ===================================== @@ -49,7 +49,7 @@ test('isValidNatural', normal, compile_and_run, ['']) # need to add -K64m to the compiler opts, so that GHCi gets it too test('ioref001', - [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS'), expect_broken_for(23272, ['ghci-opt'])], + [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS')], compile_and_run, ['+RTS -K64m -RTS']) @@ -250,7 +250,7 @@ test('T11334a', normal, compile_and_run, ['']) test('T11555', normal, compile_and_run, ['']) test('T12494', normal, compile_and_run, ['']) test('T12852', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) -test('lazySTexamples', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('lazySTexamples', normal, compile_and_run, ['']) test('T11760', [req_ghc_smp, req_target_smp, only_ways(['threaded1', 'threaded2', 'nonmoving_thr'])], @@ -304,7 +304,7 @@ test('T19719', normal, compile_and_run, ['']) test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring']) test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) -test('listThreads', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('listThreads', normal, compile_and_run, ['']) test('listThreads1', omit_ghci, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -69,7 +69,7 @@ test('cgrun060', test('cgrun061', normal, compile_and_run, ['']) test('cgrun062', normal, compile_and_run, ['']) test('cgrun063', normal, compile_and_run, ['']) -test('cgrun064', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('cgrun064', normal, compile_and_run, ['']) test('cgrun065', normal, compile_and_run, ['']) test('cgrun066', normal, compile_and_run, ['']) test('cgrun067', [extra_files(['Cgrun067A.hs'])], compile_and_run, ['']) @@ -140,9 +140,9 @@ test('CgStaticPointersNoFullLazyness', [when(doing_ghci(), extra_hc_opts('-fobje test('StaticArraySize', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O2']) test('StaticByteArraySize', normal, compile_and_run, ['-O2']) -test('CopySmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('CopySmallArray', normal, compile_and_run, ['']) test('SizeOfSmallArray', normal, compile_and_run, ['']) -test('NewSmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('NewSmallArray', normal, compile_and_run, ['']) test('T9001', normal, compile_and_run, ['']) test('T9013', normal, compile_and_run, ['']) @@ -223,5 +223,5 @@ test('T20640a', normal, compile_and_run, ['']) test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) -test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) +test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -81,7 +81,7 @@ test('T5611a', fragile(12751), compile_and_run, ['']) test('T5238', normal, compile_and_run, ['']) test('T5866', exit_code(1), compile_and_run, ['']) -test('readMVar1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('readMVar1', normal, compile_and_run, ['']) test('readMVar2', normal, compile_and_run, ['']) test('readMVar3', normal, compile_and_run, ['']) test('tryReadMVar1', normal, compile_and_run, ['']) @@ -149,7 +149,7 @@ test('conc016', [omit_ways(concurrent_ways) # see comment in conc016.hs test('conc017', normal, compile_and_run, ['']) test('conc017a', normal, compile_and_run, ['']) test('conc018', normal, compile_and_run, ['']) -test('conc019', [extra_run_opts('+RTS -K16m -RTS'), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, ['']) +test('conc019', [extra_run_opts('+RTS -K16m -RTS')], compile_and_run, ['']) test('conc020', normal, compile_and_run, ['']) test('conc021', [ omit_ghci, exit_code(1) ===================================== testsuite/tests/ghc-api/target-contents/all.T ===================================== @@ -1,7 +1,6 @@ test('TargetContents', [ extra_run_opts('"' + config.libdir + '"') , js_broken(22362) - , expect_broken_for(23272, ['ghci-opt']) , req_process ] , compile_and_run, ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -277,7 +277,7 @@ test('T13420', normal, ghci_script, ['T13420.script']) test('T13466', normal, ghci_script, ['T13466.script']) test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) -test('T13699', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T13699.script']) +test('T13699', normal, ghci_script, ['T13699.script']) test('T13988', normal, ghci_script, ['T13988.script']) test('T13997', [extra_run_opts('-fobject-code')], ghci_script, ['T13997.script']) test('T13407', normal, ghci_script, ['T13407.script']) @@ -319,7 +319,7 @@ test('T16876', normal, ghci_script, ['T16876.script']) test('T17345', normal, ghci_script, ['T17345.script']) test('T17384', normal, ghci_script, ['T17384.script']) test('T17403', normal, ghci_script, ['T17403.script']) -test('T17431', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T17431.script']) +test('T17431', normal, ghci_script, ['T17431.script']) test('T17500', [extra_run_opts('-ddump-to-file -ddump-bcos')], ghci_script, ['T17500.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -57,7 +57,7 @@ test('T7014', js_skip, makefile_test, []) test('T7233', normal, compile_and_run, ['']) test('NumDecimals', normal, compile_and_run, ['']) -test('T8726', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('T8726', normal, compile_and_run, ['']) test('CarryOverflow', normal, compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -60,7 +60,6 @@ test('UnliftedWeakPtr', normal, compile_and_run, ['']) test('FMA_Primops' , [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma')) , js_skip # JS backend doesn't have an FMA implementation - , expect_broken_for(23272, ['ghci-opt']) ] , compile_and_run, ['']) test('FMA_ConstantFold' ===================================== testsuite/tests/programs/jtod_circint/test.T ===================================== @@ -1,4 +1,4 @@ -test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']), expect_broken_for(23272, ['ghci-opt']), +test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']), when(fast(), skip)], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -143,7 +143,6 @@ test('stack003', [ omit_ghci, # parameter 50000 is not passed # Test that +RTS -K0 (e.g. no stack limit) parses correctly test('stack004', [ extra_run_opts('+RTS -K0 -RTS') , js_broken(22374) - , expect_broken_for(23272, ['ghci-opt']) , expect_broken_for(14913, ['ghci']) ], compile_and_run, ['']) @@ -265,7 +264,6 @@ test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ # finalization order is different in the nonmoving omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) - , expect_broken_for(23272, ['ghci-opt']) , js_broken(22261) ], compile_and_run, ['']) @@ -285,7 +283,7 @@ test('T7227', [extra_run_opts('+RTS -tT7227.stat --machine-readable -RTS')], test('T7636', [ exit_code(1), extra_run_opts('100000') ], compile_and_run, [''] ) -test('stablename001', [expect_fail_for(['hpc']), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, ['']) +test('stablename001', [expect_fail_for(['hpc'])], compile_and_run, ['']) # hpc should fail this, because it tags every variable occurrence with # a different tick. It's probably a bug if it works, hence expect_fail. ===================================== testsuite/tests/simplCore/T9646/test.T ===================================== @@ -1,4 +1,4 @@ test('T9646', [extra_files(['Main.hs', 'Natural.hs', 'StrictPrim.hs', 'Type.hs']), - when(fast(), skip), expect_broken_for(23272, ['ghci-opt'])], + when(fast(), skip)], multimod_compile_and_run, ['Main -ddump-simpl -ddump-to-file', '']) ===================================== testsuite/tests/simplCore/should_compile/T23272.hs ===================================== @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined ===================================== testsuite/tests/simplCore/should_compile/T23272.script ===================================== @@ -0,0 +1 @@ +:load T23272 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -489,3 +489,4 @@ test('T23491a', [extra_files(['T23491.hs']), grep_errmsg(r'Float out')], multimo test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], multimod_compile, ['T23491', '-ffloat-in -ddump-float-in']) test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], multimod_compile, ['T23491', '-fliberate-case -ddump-liberate-case']) test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) +test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) ===================================== testsuite/tests/th/all.T ===================================== @@ -327,8 +327,8 @@ test('T10596', normal, compile, ['-v0']) test('T10598_TH', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices']) test('T10620', normal, compile_and_run, ['-v0']) test('T10638', normal, compile_fail, ['-v0']) -test('T10697_decided_1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-v0']) -test('T10697_decided_2', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-XStrictData -v0']) +test('T10697_decided_1', normal, compile_and_run, ['-v0']) +test('T10697_decided_2', normal, compile_and_run, ['-XStrictData -v0']) test('T10697_decided_3', normal, compile_and_run, ['-XStrictData -funbox-strict-fields -O2 -v0']) test('T10697_source', [], multimod_compile_and_run, ['T10697_source', '-w ' + config.ghc_th_way_flags]) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -693,7 +693,7 @@ test('UnlifNewUnify', normal, compile, ['']) test('UnliftedNewtypesLPFamily', normal, compile, ['']) test('UnliftedNewtypesDifficultUnification', normal, compile, ['']) test('LevPolyResult', normal, compile, ['']) -test('T16832', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T16832.script']) +test('T16832', normal, ghci_script, ['T16832.script']) test('T15772', normal, compile, ['']) test('T16995', normal, compile, ['']) test('T17007', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -76,10 +76,10 @@ test('IPRun', normal, compile_and_run, ['']) test('IPLocation', normal, compile_and_run, ['']) test('T10845', normal, compile_and_run, ['']) test('T10846', normal, compile_and_run, ['']) -test('T16646', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('T16646', normal, compile_and_run, ['']) # Support files for T1735 are in directory T1735_Help/ -test('T1735', expect_broken_for(23272, ['ghci-opt']), multimod_compile_and_run, ['T1735','']) +test('T1735', normal, multimod_compile_and_run, ['T1735','']) # The following two tests no longer compile # See Note [Inferring principal types] in Ghc.Tc.Solver View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf7ff2ede5ed1e2139fd62a13f8aa7bcddd15e47 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf7ff2ede5ed1e2139fd62a13f8aa7bcddd15e47 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 18:18:26 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 14:18:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/drop-clangcmd Message-ID: <64a46272ad3a0_399dfead1b0234087@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/drop-clangcmd at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/drop-clangcmd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 18:53:13 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 14:53:13 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 9 commits: configure: Drop Clang command from settings Message-ID: <64a46a998b834_399dfead20024105e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: d29ff360 by Rodrigo Mesquita at 2023-07-04T19:22:09+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - ce15736f by Ben Gamari at 2023-07-04T19:22:09+01:00 ghc-toolchain: Initial commit - - - - - 3fe9e19b by Rodrigo Mesquita at 2023-07-04T19:49:55+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 9e0520b0 by Rodrigo Mesquita at 2023-07-04T19:49:56+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - a8b58e5d by Rodrigo Mesquita at 2023-07-04T19:49:56+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - dcf8c372 by Rodrigo Mesquita at 2023-07-04T19:50:21+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 5cdba13b by Rodrigo Mesquita at 2023-07-04T19:50:22+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - b224ae84 by Rodrigo Mesquita at 2023-07-04T19:51:27+01:00 Use ghc-platform instead of ghc-boot - - - - - 6b46fe32 by Rodrigo Mesquita at 2023-07-04T19:52:59+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5c63707b2db9805e263604f0fd7b1e20d1407e0...6b46fe32c4d9cdf51a408e237abe8fc9239556a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5c63707b2db9805e263604f0fd7b1e20d1407e0...6b46fe32c4d9cdf51a408e237abe8fc9239556a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 19:09:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 15:09:18 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-clangcmd] configure: Drop Clang command from settings Message-ID: <64a46e5ed22e9_399dfead1c424391a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-clangcmd at Glasgow Haskell Compiler / GHC Commits: 5e4e99e4 by Rodrigo Mesquita at 2023-07-04T20:09:08+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 8 changed files: - compiler/GHC/SysTools/Tasks.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -12,7 +12,6 @@ module GHC.SysTools.Tasks where import GHC.Prelude import GHC.Platform import GHC.ForeignSrcLang -import GHC.IO (catchException) import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound) @@ -217,28 +216,6 @@ runLlvmLlc logger dflags args = traceSystoolCommand logger "llc" $ do args1 = map Option (getOpts dflags opt_lc) runSomething logger "LLVM Compiler" p (args0 ++ args1 ++ args) --- | Run the clang compiler (used as an assembler for the LLVM --- backend on OS X as LLVM doesn't support the OS X system --- assembler) -runClang :: Logger -> DynFlags -> [Option] -> IO () -runClang logger dflags args = traceSystoolCommand logger "clang" $ do - let (clang,_) = pgm_lcc dflags - -- be careful what options we call clang with - -- see #5903 and #7617 for bugs caused by this. - (_,args0) = pgm_a dflags - args1 = map Option (getOpts dflags opt_a) - args2 = args0 ++ args1 ++ args - mb_env <- getGccEnv args2 - catchException - (runSomethingFiltered logger id "Clang (Assembler)" clang args2 Nothing mb_env) - (\(err :: SomeException) -> do - errorMsg logger $ - text ("Error running clang! you need clang installed to use the" ++ - " LLVM backend") $+$ - text "(or GHC tried to execute clang incorrectly)" - throwIO err - ) - runEmscripten :: Logger -> DynFlags -> [Option] -> IO () runEmscripten logger dflags args = traceSystoolCommand logger "emcc" $ do let (p,args0) = pgm_a dflags ===================================== configure.ac ===================================== @@ -545,13 +545,6 @@ sUPPORTED_LLVM_VERSION_MAX=$(echo \($LlvmMaxVersion\) | sed 's/\./,/') AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MIN], ${sUPPORTED_LLVM_VERSION_MIN}, [The minimum supported LLVM version number]) AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MAX], ${sUPPORTED_LLVM_VERSION_MAX}, [The maximum supported LLVM version number]) -dnl ** Which LLVM clang to use? -dnl -------------------------------------------------------------- -AC_ARG_VAR(CLANG,[Use as the path to clang [default=autodetect]]) -AC_CHECK_TARGET_TOOL([CLANG], [clang]) -ClangCmd="$CLANG" -AC_SUBST([ClangCmd]) - dnl ** Which LLVM llc to use? dnl -------------------------------------------------------------- AC_ARG_VAR(LLC,[Use as the path to LLVM's llc [default=autodetect]]) @@ -1286,7 +1279,6 @@ echo "\ libdw : $USING_LIBDW Using LLVM tools - clang : $ClangCmd llc : $LlcCmd opt : $OptCmd" ===================================== hadrian/bindist/Makefile ===================================== @@ -120,7 +120,6 @@ lib/settings : config.mk @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ - @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@ @echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@ @echo @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -275,7 +275,6 @@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ -SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -159,7 +159,6 @@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ -settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -126,7 +126,6 @@ data SettingsFileSetting | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand - | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand | SettingsFileSetting_DistroMinGW @@ -224,7 +223,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" - SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" SettingsFileSetting_DistroMinGW -> "settings-use-distro-mingw" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -479,7 +479,6 @@ generateSettings = do , ("LLVM target", getSetting LlvmTarget) , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand) , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand) - , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand) , ("Use inplace MinGW toolchain", expr $ settingsFileSetting SettingsFileSetting_DistroMinGW) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) ===================================== m4/fp_settings.m4 ===================================== @@ -75,12 +75,6 @@ AC_DEFUN([FP_SETTINGS], fi fi - # Platform-agnostic tools - if test -z "$ClangCmd"; then - ClangCmd="clang" - fi - SettingsClangCommand="$ClangCmd" - # LLVM backend tools if test -z "$LlcCmd"; then LlcCmd="llc" @@ -124,7 +118,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) - AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) AC_SUBST(SettingsUseDistroMINGW) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e4e99e478d4692b1a90c67b477073f34009e6c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e4e99e478d4692b1a90c67b477073f34009e6c1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 19:09:50 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 15:09:50 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 9 commits: configure: Drop Clang command from settings Message-ID: <64a46e7e8ce0a_399dfead200246453@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 183ef2db by Rodrigo Mesquita at 2023-07-04T20:09:30+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 18e977be by Ben Gamari at 2023-07-04T20:09:30+01:00 ghc-toolchain: Initial commit - - - - - 017740a1 by Rodrigo Mesquita at 2023-07-04T20:09:30+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 59b8190e by Rodrigo Mesquita at 2023-07-04T20:09:30+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - f92a383b by Rodrigo Mesquita at 2023-07-04T20:09:30+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - 727573d7 by Rodrigo Mesquita at 2023-07-04T20:09:30+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 502f06bb by Rodrigo Mesquita at 2023-07-04T20:09:31+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 43852c2f by Rodrigo Mesquita at 2023-07-04T20:09:31+01:00 Use ghc-platform instead of ghc-boot - - - - - 47ca1ddd by Rodrigo Mesquita at 2023-07-04T20:09:31+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b46fe32c4d9cdf51a408e237abe8fc9239556a2...47ca1ddd9a3c0ec117f2bd0a7d32ed1955b6354f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b46fe32c4d9cdf51a408e237abe8fc9239556a2...47ca1ddd9a3c0ec117f2bd0a7d32ed1955b6354f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 19:51:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 15:51:16 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-clangcmd] configure: Drop Clang command from settings Message-ID: <64a47834e198b_399dfead23c2496cd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-clangcmd at Glasgow Haskell Compiler / GHC Commits: 26f96291 by Rodrigo Mesquita at 2023-07-04T20:51:05+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 12 changed files: - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - testsuite/ghc-config/ghc-config.hs Changes: ===================================== compiler/GHC/Settings.hs ===================================== @@ -42,7 +42,6 @@ module GHC.Settings , sPgm_ranlib , sPgm_lo , sPgm_lc - , sPgm_lcc , sPgm_i , sOpt_L , sOpt_P @@ -56,7 +55,6 @@ module GHC.Settings , sOpt_windres , sOpt_lo , sOpt_lc - , sOpt_lcc , sOpt_i , sExtraGccViaCFlags , sTargetPlatformString @@ -121,8 +119,6 @@ data ToolSettings = ToolSettings toolSettings_pgm_lo :: (String, [Option]) , -- | LLVM: llc static compiler toolSettings_pgm_lc :: (String, [Option]) - , -- | LLVM: c compiler - toolSettings_pgm_lcc :: (String, [Option]) , toolSettings_pgm_i :: String -- options for particular phases @@ -142,8 +138,6 @@ data ToolSettings = ToolSettings toolSettings_opt_lo :: [String] , -- | LLVM: llc static compiler toolSettings_opt_lc :: [String] - , -- | LLVM: c compiler - toolSettings_opt_lcc :: [String] , -- | iserv options toolSettings_opt_i :: [String] @@ -242,8 +236,6 @@ sPgm_lo :: Settings -> (String, [Option]) sPgm_lo = toolSettings_pgm_lo . sToolSettings sPgm_lc :: Settings -> (String, [Option]) sPgm_lc = toolSettings_pgm_lc . sToolSettings -sPgm_lcc :: Settings -> (String, [Option]) -sPgm_lcc = toolSettings_pgm_lcc . sToolSettings sPgm_i :: Settings -> String sPgm_i = toolSettings_pgm_i . sToolSettings sOpt_L :: Settings -> [String] @@ -270,8 +262,6 @@ sOpt_lo :: Settings -> [String] sOpt_lo = toolSettings_opt_lo . sToolSettings sOpt_lc :: Settings -> [String] sOpt_lc = toolSettings_opt_lc . sToolSettings -sOpt_lcc :: Settings -> [String] -sOpt_lcc = toolSettings_opt_lcc . sToolSettings sOpt_i :: Settings -> [String] sOpt_i = toolSettings_opt_i . sToolSettings ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -151,7 +151,6 @@ initSettings top_dir = do -- We just assume on command line lc_prog <- getSetting "LLVM llc command" lo_prog <- getSetting "LLVM opt command" - lcc_prog <- getSetting "LLVM clang command" let iserv_prog = libexec "ghc-iserv" @@ -199,7 +198,6 @@ initSettings top_dir = do , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) - , toolSettings_pgm_lcc = (lcc_prog,[]) , toolSettings_pgm_i = iserv_prog , toolSettings_opt_L = [] , toolSettings_opt_P = [] @@ -211,7 +209,6 @@ initSettings top_dir = do , toolSettings_opt_l = [] , toolSettings_opt_lm = [] , toolSettings_opt_windres = [] - , toolSettings_opt_lcc = [] , toolSettings_opt_lo = [] , toolSettings_opt_lc = [] , toolSettings_opt_i = [] ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -12,7 +12,6 @@ module GHC.SysTools.Tasks where import GHC.Prelude import GHC.Platform import GHC.ForeignSrcLang -import GHC.IO (catchException) import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound) @@ -217,28 +216,6 @@ runLlvmLlc logger dflags args = traceSystoolCommand logger "llc" $ do args1 = map Option (getOpts dflags opt_lc) runSomething logger "LLVM Compiler" p (args0 ++ args1 ++ args) --- | Run the clang compiler (used as an assembler for the LLVM --- backend on OS X as LLVM doesn't support the OS X system --- assembler) -runClang :: Logger -> DynFlags -> [Option] -> IO () -runClang logger dflags args = traceSystoolCommand logger "clang" $ do - let (clang,_) = pgm_lcc dflags - -- be careful what options we call clang with - -- see #5903 and #7617 for bugs caused by this. - (_,args0) = pgm_a dflags - args1 = map Option (getOpts dflags opt_a) - args2 = args0 ++ args1 ++ args - mb_env <- getGccEnv args2 - catchException - (runSomethingFiltered logger id "Clang (Assembler)" clang args2 Nothing mb_env) - (\(err :: SomeException) -> do - errorMsg logger $ - text ("Error running clang! you need clang installed to use the" ++ - " LLVM backend") $+$ - text "(or GHC tried to execute clang incorrectly)" - throwIO err - ) - runEmscripten :: Logger -> DynFlags -> [Option] -> IO () runEmscripten logger dflags args = traceSystoolCommand logger "emcc" $ do let (p,args0) = pgm_a dflags ===================================== configure.ac ===================================== @@ -545,13 +545,6 @@ sUPPORTED_LLVM_VERSION_MAX=$(echo \($LlvmMaxVersion\) | sed 's/\./,/') AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MIN], ${sUPPORTED_LLVM_VERSION_MIN}, [The minimum supported LLVM version number]) AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MAX], ${sUPPORTED_LLVM_VERSION_MAX}, [The maximum supported LLVM version number]) -dnl ** Which LLVM clang to use? -dnl -------------------------------------------------------------- -AC_ARG_VAR(CLANG,[Use as the path to clang [default=autodetect]]) -AC_CHECK_TARGET_TOOL([CLANG], [clang]) -ClangCmd="$CLANG" -AC_SUBST([ClangCmd]) - dnl ** Which LLVM llc to use? dnl -------------------------------------------------------------- AC_ARG_VAR(LLC,[Use as the path to LLVM's llc [default=autodetect]]) @@ -1286,7 +1279,6 @@ echo "\ libdw : $USING_LIBDW Using LLVM tools - clang : $ClangCmd llc : $LlcCmd opt : $OptCmd" ===================================== hadrian/bindist/Makefile ===================================== @@ -120,7 +120,6 @@ lib/settings : config.mk @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ - @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@ @echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@ @echo @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -275,7 +275,6 @@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ -SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -159,7 +159,6 @@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ -settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -126,7 +126,6 @@ data SettingsFileSetting | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand - | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand | SettingsFileSetting_DistroMinGW @@ -224,7 +223,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" - SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" SettingsFileSetting_DistroMinGW -> "settings-use-distro-mingw" ===================================== hadrian/src/Oracles/TestSettings.hs ===================================== @@ -37,7 +37,6 @@ data TestSetting = TestHostOS | TestGhcDynamic | TestGhcProfiled | TestAR - | TestCLANG | TestLLC | TestTEST_CC | TestTEST_CC_OPTS @@ -69,7 +68,6 @@ testSetting key = do TestGhcDynamic -> "GhcDynamic" TestGhcProfiled -> "GhcProfiled" TestAR -> "AR" - TestCLANG -> "CLANG" TestLLC -> "LLC" TestTEST_CC -> "TEST_CC" TestTEST_CC_OPTS -> "TEST_CC_OPTS" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -479,7 +479,6 @@ generateSettings = do , ("LLVM target", getSetting LlvmTarget) , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand) , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand) - , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand) , ("Use inplace MinGW toolchain", expr $ settingsFileSetting SettingsFileSetting_DistroMinGW) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) ===================================== m4/fp_settings.m4 ===================================== @@ -75,12 +75,6 @@ AC_DEFUN([FP_SETTINGS], fi fi - # Platform-agnostic tools - if test -z "$ClangCmd"; then - ClangCmd="clang" - fi - SettingsClangCommand="$ClangCmd" - # LLVM backend tools if test -z "$LlcCmd"; then LlcCmd="llc" @@ -124,7 +118,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) - AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) AC_SUBST(SettingsUseDistroMINGW) ===================================== testsuite/ghc-config/ghc-config.hs ===================================== @@ -33,7 +33,6 @@ main = do getGhcFieldOrDefault fields "LeadingUnderscore" "Leading underscore" "NO" getGhcFieldOrDefault fields "GhcTablesNextToCode" "Tables next to code" "NO" getGhcFieldProgWithDefault fields "AR" "ar command" "ar" - getGhcFieldProgWithDefault fields "CLANG" "LLVM clang command" "clang" getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc" getGhcFieldProgWithDefault fields "TEST_CC" "C compiler command" "gcc" getGhcFieldProgWithDefault fields "TEST_CC_OPTS" "C compiler flags" "" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26f962914755e1acd97f0fa8d6630de50191f3f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26f962914755e1acd97f0fa8d6630de50191f3f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 19:51:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 15:51:53 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 9 commits: configure: Drop Clang command from settings Message-ID: <64a4785959ec3_399dfe727d5b025021e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 63cab7d9 by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 2a8240b8 by Ben Gamari at 2023-07-04T20:51:42+01:00 ghc-toolchain: Initial commit - - - - - 966d92e2 by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 97f055b3 by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - 44e42b72 by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - 7440ddc0 by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - b4125633 by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - e4c8f5bd by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 Use ghc-platform instead of ghc-boot - - - - - df2ad230 by Rodrigo Mesquita at 2023-07-04T20:51:42+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47ca1ddd9a3c0ec117f2bd0a7d32ed1955b6354f...df2ad230da0fb393b874a01157bcb1aa384ae5b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/47ca1ddd9a3c0ec117f2bd0a7d32ed1955b6354f...df2ad230da0fb393b874a01157bcb1aa384ae5b9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 20:08:58 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 16:08:58 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-clangcmd] configure: Drop Clang command from settings Message-ID: <64a47c5abc0eb_399dfead23c2513fc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-clangcmd at Glasgow Haskell Compiler / GHC Commits: fb4ace14 by Rodrigo Mesquita at 2023-07-04T21:08:47+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 13 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - testsuite/ghc-config/ghc-config.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -108,7 +108,6 @@ module GHC.Driver.Session ( sPgm_ranlib, sPgm_lo, sPgm_lc, - sPgm_lcc, sPgm_i, sOpt_L, sOpt_P, @@ -122,7 +121,6 @@ module GHC.Driver.Session ( sOpt_windres, sOpt_lo, sOpt_lc, - sOpt_lcc, sOpt_i, sExtraGccViaCFlags, sTargetPlatformString, @@ -138,10 +136,10 @@ module GHC.Driver.Session ( extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, pgm_windres, pgm_ar, - pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, + pgm_ranlib, pgm_lo, pgm_lc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, - opt_windres, opt_lo, opt_lc, opt_lcc, + opt_windres, opt_lo, opt_lc, updatePlatformConstants, -- ** Manipulating DynFlags @@ -410,8 +408,6 @@ pgm_T :: DynFlags -> String pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags -pgm_lcc :: DynFlags -> (String,[Option]) -pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags pgm_ranlib :: DynFlags -> String @@ -452,8 +448,6 @@ opt_lm :: DynFlags -> [String] opt_lm dflags= toolSettings_opt_lm $ toolSettings dflags opt_windres :: DynFlags -> [String] opt_windres dflags= toolSettings_opt_windres $ toolSettings dflags -opt_lcc :: DynFlags -> [String] -opt_lcc dflags= toolSettings_opt_lcc $ toolSettings dflags opt_lo :: DynFlags -> [String] opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags opt_lc :: DynFlags -> [String] ===================================== compiler/GHC/Settings.hs ===================================== @@ -42,7 +42,6 @@ module GHC.Settings , sPgm_ranlib , sPgm_lo , sPgm_lc - , sPgm_lcc , sPgm_i , sOpt_L , sOpt_P @@ -56,7 +55,6 @@ module GHC.Settings , sOpt_windres , sOpt_lo , sOpt_lc - , sOpt_lcc , sOpt_i , sExtraGccViaCFlags , sTargetPlatformString @@ -121,8 +119,6 @@ data ToolSettings = ToolSettings toolSettings_pgm_lo :: (String, [Option]) , -- | LLVM: llc static compiler toolSettings_pgm_lc :: (String, [Option]) - , -- | LLVM: c compiler - toolSettings_pgm_lcc :: (String, [Option]) , toolSettings_pgm_i :: String -- options for particular phases @@ -142,8 +138,6 @@ data ToolSettings = ToolSettings toolSettings_opt_lo :: [String] , -- | LLVM: llc static compiler toolSettings_opt_lc :: [String] - , -- | LLVM: c compiler - toolSettings_opt_lcc :: [String] , -- | iserv options toolSettings_opt_i :: [String] @@ -242,8 +236,6 @@ sPgm_lo :: Settings -> (String, [Option]) sPgm_lo = toolSettings_pgm_lo . sToolSettings sPgm_lc :: Settings -> (String, [Option]) sPgm_lc = toolSettings_pgm_lc . sToolSettings -sPgm_lcc :: Settings -> (String, [Option]) -sPgm_lcc = toolSettings_pgm_lcc . sToolSettings sPgm_i :: Settings -> String sPgm_i = toolSettings_pgm_i . sToolSettings sOpt_L :: Settings -> [String] @@ -270,8 +262,6 @@ sOpt_lo :: Settings -> [String] sOpt_lo = toolSettings_opt_lo . sToolSettings sOpt_lc :: Settings -> [String] sOpt_lc = toolSettings_opt_lc . sToolSettings -sOpt_lcc :: Settings -> [String] -sOpt_lcc = toolSettings_opt_lcc . sToolSettings sOpt_i :: Settings -> [String] sOpt_i = toolSettings_opt_i . sToolSettings ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -151,7 +151,6 @@ initSettings top_dir = do -- We just assume on command line lc_prog <- getSetting "LLVM llc command" lo_prog <- getSetting "LLVM opt command" - lcc_prog <- getSetting "LLVM clang command" let iserv_prog = libexec "ghc-iserv" @@ -199,7 +198,6 @@ initSettings top_dir = do , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) - , toolSettings_pgm_lcc = (lcc_prog,[]) , toolSettings_pgm_i = iserv_prog , toolSettings_opt_L = [] , toolSettings_opt_P = [] @@ -211,7 +209,6 @@ initSettings top_dir = do , toolSettings_opt_l = [] , toolSettings_opt_lm = [] , toolSettings_opt_windres = [] - , toolSettings_opt_lcc = [] , toolSettings_opt_lo = [] , toolSettings_opt_lc = [] , toolSettings_opt_i = [] ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -12,7 +12,6 @@ module GHC.SysTools.Tasks where import GHC.Prelude import GHC.Platform import GHC.ForeignSrcLang -import GHC.IO (catchException) import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound) @@ -217,28 +216,6 @@ runLlvmLlc logger dflags args = traceSystoolCommand logger "llc" $ do args1 = map Option (getOpts dflags opt_lc) runSomething logger "LLVM Compiler" p (args0 ++ args1 ++ args) --- | Run the clang compiler (used as an assembler for the LLVM --- backend on OS X as LLVM doesn't support the OS X system --- assembler) -runClang :: Logger -> DynFlags -> [Option] -> IO () -runClang logger dflags args = traceSystoolCommand logger "clang" $ do - let (clang,_) = pgm_lcc dflags - -- be careful what options we call clang with - -- see #5903 and #7617 for bugs caused by this. - (_,args0) = pgm_a dflags - args1 = map Option (getOpts dflags opt_a) - args2 = args0 ++ args1 ++ args - mb_env <- getGccEnv args2 - catchException - (runSomethingFiltered logger id "Clang (Assembler)" clang args2 Nothing mb_env) - (\(err :: SomeException) -> do - errorMsg logger $ - text ("Error running clang! you need clang installed to use the" ++ - " LLVM backend") $+$ - text "(or GHC tried to execute clang incorrectly)" - throwIO err - ) - runEmscripten :: Logger -> DynFlags -> [Option] -> IO () runEmscripten logger dflags args = traceSystoolCommand logger "emcc" $ do let (p,args0) = pgm_a dflags ===================================== configure.ac ===================================== @@ -545,13 +545,6 @@ sUPPORTED_LLVM_VERSION_MAX=$(echo \($LlvmMaxVersion\) | sed 's/\./,/') AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MIN], ${sUPPORTED_LLVM_VERSION_MIN}, [The minimum supported LLVM version number]) AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MAX], ${sUPPORTED_LLVM_VERSION_MAX}, [The maximum supported LLVM version number]) -dnl ** Which LLVM clang to use? -dnl -------------------------------------------------------------- -AC_ARG_VAR(CLANG,[Use as the path to clang [default=autodetect]]) -AC_CHECK_TARGET_TOOL([CLANG], [clang]) -ClangCmd="$CLANG" -AC_SUBST([ClangCmd]) - dnl ** Which LLVM llc to use? dnl -------------------------------------------------------------- AC_ARG_VAR(LLC,[Use as the path to LLVM's llc [default=autodetect]]) @@ -1286,7 +1279,6 @@ echo "\ libdw : $USING_LIBDW Using LLVM tools - clang : $ClangCmd llc : $LlcCmd opt : $OptCmd" ===================================== hadrian/bindist/Makefile ===================================== @@ -120,7 +120,6 @@ lib/settings : config.mk @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ - @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@ @echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@ @echo @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -275,7 +275,6 @@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ -SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -159,7 +159,6 @@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ -settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -126,7 +126,6 @@ data SettingsFileSetting | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand - | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand | SettingsFileSetting_DistroMinGW @@ -224,7 +223,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" - SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" SettingsFileSetting_DistroMinGW -> "settings-use-distro-mingw" ===================================== hadrian/src/Oracles/TestSettings.hs ===================================== @@ -37,7 +37,6 @@ data TestSetting = TestHostOS | TestGhcDynamic | TestGhcProfiled | TestAR - | TestCLANG | TestLLC | TestTEST_CC | TestTEST_CC_OPTS @@ -69,7 +68,6 @@ testSetting key = do TestGhcDynamic -> "GhcDynamic" TestGhcProfiled -> "GhcProfiled" TestAR -> "AR" - TestCLANG -> "CLANG" TestLLC -> "LLC" TestTEST_CC -> "TEST_CC" TestTEST_CC_OPTS -> "TEST_CC_OPTS" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -479,7 +479,6 @@ generateSettings = do , ("LLVM target", getSetting LlvmTarget) , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand) , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand) - , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand) , ("Use inplace MinGW toolchain", expr $ settingsFileSetting SettingsFileSetting_DistroMinGW) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) ===================================== m4/fp_settings.m4 ===================================== @@ -75,12 +75,6 @@ AC_DEFUN([FP_SETTINGS], fi fi - # Platform-agnostic tools - if test -z "$ClangCmd"; then - ClangCmd="clang" - fi - SettingsClangCommand="$ClangCmd" - # LLVM backend tools if test -z "$LlcCmd"; then LlcCmd="llc" @@ -124,7 +118,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) - AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) AC_SUBST(SettingsUseDistroMINGW) ===================================== testsuite/ghc-config/ghc-config.hs ===================================== @@ -33,7 +33,6 @@ main = do getGhcFieldOrDefault fields "LeadingUnderscore" "Leading underscore" "NO" getGhcFieldOrDefault fields "GhcTablesNextToCode" "Tables next to code" "NO" getGhcFieldProgWithDefault fields "AR" "ar command" "ar" - getGhcFieldProgWithDefault fields "CLANG" "LLVM clang command" "clang" getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc" getGhcFieldProgWithDefault fields "TEST_CC" "C compiler command" "gcc" getGhcFieldProgWithDefault fields "TEST_CC_OPTS" "C compiler flags" "" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb4ace144dd9ac24f2475d1800c693f20475c665 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb4ace144dd9ac24f2475d1800c693f20475c665 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 20:09:31 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 04 Jul 2023 16:09:31 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 9 commits: configure: Drop Clang command from settings Message-ID: <64a47c7ba3b4d_399dfead1ec251780@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 19fe8618 by Rodrigo Mesquita at 2023-07-04T21:09:23+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - e388f6ad by Ben Gamari at 2023-07-04T21:09:23+01:00 ghc-toolchain: Initial commit - - - - - 438cfab4 by Rodrigo Mesquita at 2023-07-04T21:09:23+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - a4954073 by Rodrigo Mesquita at 2023-07-04T21:09:23+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - 8a5247f2 by Rodrigo Mesquita at 2023-07-04T21:09:23+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - a197530a by Rodrigo Mesquita at 2023-07-04T21:09:23+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - b98a5d78 by Rodrigo Mesquita at 2023-07-04T21:09:23+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - ee596937 by Rodrigo Mesquita at 2023-07-04T21:09:24+01:00 Use ghc-platform instead of ghc-boot - - - - - 6b3d4b33 by Rodrigo Mesquita at 2023-07-04T21:09:24+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - 30 changed files: - + TODO - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df2ad230da0fb393b874a01157bcb1aa384ae5b9...6b3d4b33d6be50dd63047f65ad54533b42a19ddd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df2ad230da0fb393b874a01157bcb1aa384ae5b9...6b3d4b33d6be50dd63047f65ad54533b42a19ddd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 4 22:12:50 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 04 Jul 2023 18:12:50 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 57 commits: Stop configuring unused Ld command in `settings` Message-ID: <64a499622e2d3_399dfead1c42620b2@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - 2c92d89d by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 Inline more, sooner - - - - - cf51dbd2 by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 One more Simplifier optimistaions Inline in exprIsConAppMaybe - - - - - 3f77a684 by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 Further improvements - - - - - b5f42ed6 by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 Remove trace - - - - - 15fde9c9 by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 Add a strategic inline pragma - - - - - 095ebff7 by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 Two improvements to coercion optimisation One (mkSymCo) makes a big difference in GHC.Read The other (in zapSubstEnv) makes a big diffference in T18223 - - - - - f7928e68 by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 Optimise every time we do mkTransCo - - - - - d676ff21 by Simon Peyton Jones at 2023-07-03T16:42:22+01:00 Wibble: remove unused field - - - - - 759f1bf8 by Simon Peyton Jones at 2023-07-04T14:57:41+01:00 Fix a total bug in mkSelCo: wrong role We were simply giving an outright-wrong role to a Refl coercion in mkSelCo. - - - - - 1c5f3a99 by Simon Peyton Jones at 2023-07-04T23:07:55+01:00 Add assert back into mkCast - - - - - 8efcee73 by Simon Peyton Jones at 2023-07-04T23:08:42+01:00 Don't repeatedly optimise coercions in simplCast This matters when we have (case x of (a,b) -> (case x of (a,b) -> e |> co1 ) |> co2 ) |> co3 Those casts end up successively pushed onto the continuation stack, and we don't want to optimise (co1;co2) and then (co1;co2;co3) etc. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe7f28f1c55115ec3b2289dd60e55372c8e14d5d...8efcee737e8dfb7287a5ef9cdca0590a80b70750 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe7f28f1c55115ec3b2289dd60e55372c8e14d5d...8efcee737e8dfb7287a5ef9cdca0590a80b70750 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:04:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:04:21 -0400 Subject: [Git][ghc/ghc][master] configure: Rip out Solaris dyld check Message-ID: <64a4cfa57ad13_399dfead26429728c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 5 changed files: - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - m4/fp_hs_cpp_cmd_with_args.m4 - mk/project.mk.in Changes: ===================================== configure.ac ===================================== @@ -298,23 +298,6 @@ then exit 1 fi -# Testing if we shall enable shared libs support on Solaris. -# Anything older than SunOS 5.11 aka Solaris 11 (Express) is broken. - -SOLARIS_BROKEN_SHLD=NO - -case $host in - i386-*-solaris2) - # here we go with the test - MINOR=`uname -r|cut -d '.' -f 2-` - if test "$MINOR" -lt "11"; then - SOLARIS_BROKEN_SHLD=YES - fi - ;; -esac - -AC_SUBST(SOLARIS_BROKEN_SHLD) - dnl ** Do an unregisterised build? dnl -------------------------------------------------------------- ===================================== hadrian/cfg/system.config.in ===================================== @@ -51,7 +51,6 @@ hs-cpp-args = @HaskellCPPArgs@ # Build options: #=============== -solaris-broken-shld = @SOLARIS_BROKEN_SHLD@ ghc-unregisterised = @Unregisterised@ tables-next-to-code = @TablesNextToCode@ use-libffi-for-adjustors = @UseLibffiForAdjustors@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -28,7 +28,6 @@ data Flag = ArSupportsAtFile | GmpInTree | GmpFrameworkPref | LeadingUnderscore - | SolarisBrokenShld | UseSystemFfi | BootstrapThreadedRts | BootstrapEventLoggingRts @@ -60,7 +59,6 @@ flag f = do GmpInTree -> "intree-gmp" GmpFrameworkPref -> "gmp-framework-preferred" LeadingUnderscore -> "leading-underscore" - SolarisBrokenShld -> "solaris-broken-shld" UseSystemFfi -> "use-system-ffi" BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" @@ -105,8 +103,7 @@ platformSupportsSharedLibs = do ppc_linux <- anyTargetPlatform [ "powerpc-unknown-linux" ] solaris <- anyTargetPlatform [ "i386-unknown-solaris2" ] javascript <- anyTargetArch [ "javascript" ] - solarisBroken <- flag SolarisBrokenShld - return $ not (windows || wasm || javascript || ppc_linux || solaris && solarisBroken) + return $ not (windows || wasm || javascript || ppc_linux || solaris) -- | Does the target support threaded RTS? targetSupportsThreadedRts :: Action Bool ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -25,36 +25,6 @@ AC_ARG_WITH(hs-cpp, # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". HS_CPP_CMD=$CC - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi ] ) ===================================== mk/project.mk.in ===================================== @@ -156,10 +156,6 @@ else Windows_Target=NO endif -# In case of Solaris OS, does it provide broken shared libs -# linker or not? -SOLARIS_BROKEN_SHLD=@SOLARIS_BROKEN_SHLD@ - # Is the stage0 compiler affected by Bug #9439? GHC_LLVM_AFFECTED_BY_9439 = @GHC_LLVM_AFFECTED_BY_9439@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de5830d0d3983b551d7c9abbcc4e5d13155a2c8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de5830d0d3983b551d7c9abbcc4e5d13155a2c8c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:05:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:05:21 -0400 Subject: [Git][ghc/ghc][master] CI: add JS release and debug builds, regen CI jobs Message-ID: <64a4cfe1eea19_399dfead200300696@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 4 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - testsuite/config/ghc - testsuite/driver/testlib.py Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -228,6 +228,16 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +jsDebug :: BuildConfig -> BuildConfig +jsDebug c = c { bignumBackend = Native + -- make the job a debug job + , buildFlavour = SlowValidate + , withAssertions = True + } + +jsPerf :: BuildConfig -> BuildConfig +jsPerf c = c { bignumBackend = Native } + zstdIpe :: BuildConfig zstdIpe = vanilla { withZstd = True } @@ -920,10 +930,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) - , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") - ) - { bignumBackend = Native - } + , standardBuildsWithConfig Amd64 (Linux Debian11) (jsPerf $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) + , validateBuilds Amd64 (Linux Debian11) (jsDebug $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) , make_wasm_jobs wasm_build_config , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {bignumBackend = Native} @@ -998,7 +1006,7 @@ platform_mapping = Map.map go $ hasReleaseBuild (StandardTriple{}) = True hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { bindistName :: String } +data BindistInfo = BindistInfo { _bindistName :: String } instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] @@ -1013,6 +1021,7 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" +write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -1510,6 +1510,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "native", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", + "BUILD_FLAVOUR": "slow-validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", + "CROSS_TARGET": "javascript-unknown-ghcjs", + "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -2855,6 +2917,70 @@ "XZ_OPT": "-9" } }, + "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "1 year", + "paths": [ + "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "native", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", + "BUILD_FLAVOUR": "release", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", + "CROSS_TARGET": "javascript-unknown-ghcjs", + "HADRIAN_ARGS": "--hash-unit-ids", + "IGNORE_PERF_FAILURES": "all", + "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", + "XZ_OPT": "-9" + } + }, "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4428,6 +4554,67 @@ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, + "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "2 weeks", + "paths": [ + "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", + "junit.xml" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb11-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "native", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", + "BUILD_FLAVOUR": "slow-validate", + "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_WRAPPER": "emconfigure", + "CROSS_EMULATOR": "js-emulator", + "CROSS_TARGET": "javascript-unknown-ghcjs", + "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" + } + }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== testsuite/config/ghc ===================================== @@ -80,6 +80,7 @@ if not config.arch == "javascript": config.compile_ways.append('hpc') config.run_ways.append('hpc') +# WASM if config.arch == "wasm32": config.have_process = False config.supports_dynamic_libs = False @@ -269,7 +270,12 @@ def get_compiler_info(): config.have_vanilla = compiler_supports_way([]) config.have_dynamic = compiler_supports_way(['-dynamic']) - config.have_profiling = compiler_supports_way(['-prof']) + + # JavaScript doesn't support profiling yet. See #22261 + if config.arch == "javascript": + config.have_profiling = False + else: + config.have_profiling = compiler_supports_way(['-prof']) if config.have_profiling: config.compile_ways.append('profasm') ===================================== testsuite/driver/testlib.py ===================================== @@ -236,6 +236,11 @@ def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: opts.expect = 'fail' + # many profiling tests must be skipped for the JS backend. That is + # because they unexpectedly pass even though the JS backend does not + # support profiling yet. See #22251 + if js_arch(): + js_skip(name, opts) # JS backend doesn't support profiling yet if arch("js"): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59c5fe1d4b624423b1c37891710f2757bb58d6af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59c5fe1d4b624423b1c37891710f2757bb58d6af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:05:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:05:50 -0400 Subject: [Git][ghc/ghc][master] testsuite: Do not require CUSKs Message-ID: <64a4cffe8134e_399dfee127678304542@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 30 changed files: - testsuite/tests/dependent/should_compile/Dep2.hs - testsuite/tests/dependent/should_compile/DkNameRes.hs - testsuite/tests/dependent/should_compile/KindEqualities2.hs - testsuite/tests/dependent/should_compile/RaeBlogPost.hs - testsuite/tests/dependent/should_compile/RaeJobTalk.hs - testsuite/tests/dependent/should_compile/T11711.hs - testsuite/tests/dependent/should_compile/T12442.hs - testsuite/tests/dependent/should_compile/T14066a.hs - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/dependent/should_compile/T14556.hs - testsuite/tests/dependent/should_compile/T14749.hs - testsuite/tests/dependent/should_compile/T16326_Compile1.hs - testsuite/tests/dependent/should_compile/TypeLevelVec.hs - testsuite/tests/dependent/should_compile/dynamic-paper.hs - testsuite/tests/dependent/should_compile/mkGADTVars.hs - testsuite/tests/dependent/should_fail/T13601.hs - testsuite/tests/dependent/should_fail/T13780c.hs - testsuite/tests/dependent/should_fail/T13780c.stderr - testsuite/tests/dependent/should_fail/T15380.hs - testsuite/tests/ghci/scripts/T7939.hs - testsuite/tests/ghci/scripts/T7939.stdout - testsuite/tests/indexed-types/should_compile/T14554.hs - testsuite/tests/indexed-types/should_compile/T15122.hs - testsuite/tests/indexed-types/should_compile/T15352.hs - testsuite/tests/indexed-types/should_compile/T16356_Compile1.hs - testsuite/tests/indexed-types/should_compile/T17008b.hs - testsuite/tests/indexed-types/should_fail/ClosedFam3.hs - testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot - testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr - testsuite/tests/indexed-types/should_fail/T14246.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/679bbc9705371af8ca65a5bfeb702e14bc406f51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/679bbc9705371af8ca65a5bfeb702e14bc406f51 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:06:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:06:30 -0400 Subject: [Git][ghc/ghc][master] gitlab: Drop backport-for-8.8 MR template Message-ID: <64a4d0265b0ac_399dfead2143079aa@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 1 changed file: - − .gitlab/merge_request_templates/backport-for-8.8.md Changes: ===================================== .gitlab/merge_request_templates/backport-for-8.8.md deleted ===================================== @@ -1,11 +0,0 @@ -Thank you for help in maintaining GHC's stable branch! - -Please take a few moments to verify the following: - - * [ ] the issue that this backport fixes is milestoned for the target release. - -If you have any questions don't hesitate to open your merge request and inquire -in a comment. - -/label ~backport -/milestone %8.8.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/945d359942ea17594138a90801c45fbb098c7a5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/945d359942ea17594138a90801c45fbb098c7a5c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:07:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:07:08 -0400 Subject: [Git][ghc/ghc][master] EPA: Simplify GHC/Parser.y comb2 Message-ID: <64a4d04c8e512_399dfead1c4311988@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 3 changed files: - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -14,6 +14,7 @@ {-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- For the HasLoc instances {- Main functions for .hie file generation @@ -541,43 +542,26 @@ bax (x :: a) = ... -- a is in scope here This case in handled in the instance for HsPatSigType -} -class HasLoc a where - -- ^ conveniently calculate locations for things without locations attached - loc :: a -> SrcSpan - instance HasLoc thing => HasLoc (PScoped thing) where - loc (PS _ _ _ a) = loc a - -instance HasLoc (Located a) where - loc (L l _) = l - -instance HasLoc (LocatedA a) where - loc (L la _) = locA la - -instance HasLoc (LocatedN a) where - loc (L la _) = locA la - -instance HasLoc a => HasLoc [a] where - loc [] = noSrcSpan - loc xs = foldl1' combineSrcSpans $ map loc xs + getHasLoc (PS _ _ _ a) = getHasLoc a instance HasLoc a => HasLoc (DataDefnCons a) where - loc = loc . toList + getHasLoc = getHasLocList . toList instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where - loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of + getHasLoc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of HsOuterImplicit{} -> - foldl1' combineSrcSpans [loc a, loc b, loc c] + foldl1' combineSrcSpans [getHasLoc a, getHasLocList b, getHasLoc c] HsOuterExplicit{hso_bndrs = tvs} -> - foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c] + foldl1' combineSrcSpans [getHasLoc a, getHasLocList tvs, getHasLocList b, getHasLoc c] instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg p tm ty) where - loc (HsValArg tm) = loc tm - loc (HsTypeArg _ ty) = loc ty - loc (HsArgPar sp) = sp + getHasLoc (HsValArg tm) = getHasLoc tm + getHasLoc (HsTypeArg _ ty) = getHasLoc ty + getHasLoc (HsArgPar sp) = sp instance HasLoc (HsDataDefn GhcRn) where - loc def@(HsDataDefn{}) = loc $ dd_cons def + getHasLoc def@(HsDataDefn{}) = getHasLoc $ dd_cons def -- Only used for data family instances, so we only need rhs -- Most probably the rest will be unhelpful anyway @@ -1370,7 +1354,7 @@ instance ( ToHie (RFContext label) ) => ToHie (RContext (LocatedA (HsFieldBind label arg))) where toHie (RC c (L span recfld)) = concatM $ makeNode recfld (locA span) : case recfld of HsFieldBind _ label expr _ -> - [ toHie $ RFC c (getRealSpan $ loc expr) label + [ toHie $ RFC c (getRealSpan $ getHasLoc expr) label , toHie expr ] @@ -1514,7 +1498,7 @@ instance ToHie (LocatedA (TyClDecl GhcRn)) where where context_scope = mkLScopeA $ fromMaybe (noLocA []) context rhs_scope = foldl1' combineScopes $ map mkScope - [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps] + [ getHasLocList deps, getHasLocList sigs, getHasLocList (bagToList meths), getHasLocList typs, getHasLocList deftyps] instance ToHie (LocatedA (FamilyDecl GhcRn)) where toHie (L span decl) = concatM $ makeNodeA decl span : case decl of @@ -1567,14 +1551,14 @@ instance ToHie (TScoped (FamEqn GhcRn (LocatedA (HsType GhcRn)))) where instance (ToHie rhs, HasLoc rhs) => ToHie (FamEqn GhcRn rhs) where toHie fe@(FamEqn _ var outer_bndrs pats _ rhs) = concatM $ - [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var + [ toHie $ C (Decl InstDec $ getRealSpan $ getHasLoc fe) var , toHie $ TVS (ResolvedScopes []) scope outer_bndrs , toHie pats , toHie rhs ] where scope = combineScopes patsScope rhsScope - patsScope = mkScope (loc pats) - rhsScope = mkScope (loc rhs) + patsScope = mkScope (getHasLocList pats) + rhsScope = mkScope (getHasLoc rhs) instance ToHie (LocatedAn NoEpAnns (InjectivityAnn GhcRn)) where toHie (L span ann) = concatM $ makeNodeA ann span : case ann of @@ -1677,14 +1661,14 @@ instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsSigType GhcRn)))) wh [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names , toHie $ TS sc a ] - where span = loc a + where span = getHasLoc a instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsType GhcRn)))) where toHie (TS sc (HsWC names a)) = concatM $ [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names , toHie a ] - where span = loc a + where span = getHasLoc a instance ToHie (LocatedA (StandaloneKindSig GhcRn)) where toHie (L sp sig) = concatM [makeNodeA sig sp, toHie sig] @@ -1855,7 +1839,7 @@ instance ToHie (TScoped (LHsQTyVars GhcRn)) where , toHie $ tvScopes sc NoScope vars ] where - varLoc = loc vars + varLoc = getHasLocList vars bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where @@ -1867,7 +1851,7 @@ instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where instance ToHie (LocatedA (ConDeclField GhcRn)) where toHie (L span field) = concatM $ makeNode field (locA span) : case field of ConDeclField _ fields typ doc -> - [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields + [ toHie $ map (RFC RecFieldDecl (getRealSpan $ getHasLoc typ)) fields , toHie typ , toHie doc ] ===================================== compiler/GHC/Parser.y ===================================== @@ -1030,7 +1030,7 @@ export :: { OrdList (LIE GhcPs) } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) - ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 (reLoc loc)) $1) $2 } + ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) @@ -1115,7 +1115,7 @@ importdecls importdecls_semi :: { [LImportDecl GhcPs] } importdecls_semi : importdecls_semi importdecl semis1 - {% do { i <- amsAl $2 (comb2 (reLoc $2) $3) (reverse $ unLoc $3) + {% do { i <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3) ; return (i : $1)} } | {- empty -} { [] } @@ -1242,7 +1242,7 @@ topdecls :: { OrdList (LHsDecl GhcPs) } -- May have trailing semicolons, can be empty topdecls_semi :: { OrdList (LHsDecl GhcPs) } - : topdecls_semi topdecl semis1 {% do { t <- amsAl $2 (comb2 (reLoc $2) $3) (reverse $ unLoc $3) + : topdecls_semi topdecl semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3) ; return ($1 `snocOL` t) }} | {- empty -} { nilOL } @@ -1255,7 +1255,7 @@ topdecls_cs :: { OrdList (LHsDecl GhcPs) } -- May have trailing semicolons, can be empty topdecls_cs_semi :: { OrdList (LHsDecl GhcPs) } - : topdecls_cs_semi topdecl_cs semis1 {% do { t <- amsAl $2 (comb2 (reLoc $2) $3) (reverse $ unLoc $3) + : topdecls_cs_semi topdecl_cs semis1 {% do { t <- amsAl $2 (comb2 $2 $3) (reverse $ unLoc $3) ; return ($1 `snocOL` t) }} | {- empty -} { nilOL } @@ -1307,7 +1307,7 @@ ty_decl :: { LTyClDecl GhcPs } -- -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkTySynonym (comb2A $1 $4) $2 $4 [mj AnnType $1,mj AnnEqual $3] } + {% mkTySynonym (comb2 $1 $4) $2 $4 [mj AnnType $1,mj AnnEqual $3] } -- type family declarations | 'type' 'family' type opt_tyfam_kind_sig opt_injective_info @@ -1348,7 +1348,7 @@ ty_decl :: { LTyClDecl GhcPs } -- standalone kind signature standalone_kind_sig :: { LStandaloneKindSig GhcPs } : 'type' sks_vars '::' sigktype - {% mkStandaloneKindSig (comb2A $1 $4) (L (gl $2) $ unLoc $2) $4 + {% mkStandaloneKindSig (comb2 $1 $4) (L (gl $2) $ unLoc $2) $4 [mj AnnType $1,mu AnnDcolon $3]} -- See also: sig_vars @@ -1377,7 +1377,7 @@ inst_decl :: { LInstDecl GhcPs } -- type instance declarations | 'type' 'instance' ty_fam_inst_eqn - {% mkTyFamInst (comb2A $1 $3) (unLoc $3) + {% mkTyFamInst (comb2 $1 $3) (unLoc $3) (mj AnnType $1:mj AnnInstance $2:[]) } -- data/newtype instance declaration @@ -1478,11 +1478,11 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } : 'forall' tv_bndrs '.' type '=' ktype {% do { hintExplicitForall $1 ; tvbs <- fromSpecTyVarBndrs $2 - ; let loc = comb2A $1 $> + ; let loc = comb2 $1 $> ; cs <- getCommentsFor loc ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs) $4 $6 [mj AnnEqual $5] }} | type '=' ktype - {% mkTyFamInstEqn (comb2A (reLoc $1) $>) mkHsOuterImplicit $1 $3 (mj AnnEqual $2:[]) } + {% mkTyFamInstEqn (comb2 $1 $>) mkHsOuterImplicit $1 $3 (mj AnnEqual $2:[]) } -- Note the use of type for the head; this allows -- infix type constructors and type patterns @@ -1519,10 +1519,10 @@ at_decl_cls :: { LHsDecl GhcPs } -- default type instances, with optional 'instance' keyword | 'type' ty_fam_inst_eqn - {% liftM mkInstD (mkTyFamInst (comb2A $1 $2) (unLoc $2) + {% liftM mkInstD (mkTyFamInst (comb2 $1 $2) (unLoc $2) [mj AnnType $1]) } | 'type' 'instance' ty_fam_inst_eqn - {% liftM mkInstD (mkTyFamInst (comb2A $1 $3) (unLoc $3) + {% liftM mkInstD (mkTyFamInst (comb2 $1 $3) (unLoc $3) (mj AnnType $1:mj AnnInstance $2:[]) )} opt_family :: { [AddEpAnn] } @@ -1540,7 +1540,7 @@ at_decl_inst :: { LInstDecl GhcPs } : 'type' opt_instance ty_fam_inst_eqn -- Note the use of type for the head; this allows -- infix type constructors and type patterns - {% mkTyFamInst (comb2A $1 $3) (unLoc $3) + {% mkTyFamInst (comb2 $1 $3) (unLoc $3) (mj AnnType $1:$2) } -- data/newtype instance declaration, with optional 'instance' keyword @@ -1615,7 +1615,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs } | 'forall' tv_bndrs '.' type {% do { hintExplicitForall $1 ; tvbs <- fromSpecTyVarBndrs $2 - ; let loc = comb2 $1 (reLoc $>) + ; let loc = comb2 $1 $> ; cs <- getCommentsFor loc ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } @@ -2428,7 +2428,7 @@ gadt_constrlist :: { Located ([AddEpAnn] gadt_constrs :: { Located [LConDecl GhcPs] } : gadt_constr ';' gadt_constrs {% do { h <- addTrailingSemiA $1 (gl $2) - ; return (L (comb2 (reLoc $1) $3) (h : unLoc $3)) }} + ; return (L (comb2 $1 $3) (h : unLoc $3)) }} | gadt_constr { L (glA $1) [$1] } | {- empty -} { noLoc [] } @@ -2443,7 +2443,7 @@ gadt_constr :: { LConDecl GhcPs } -- Returns a list because of: C,D :: ty -- TODO:AZ capture the optSemi. Why leading? : optSemi con_list '::' sigtype - {% mkGadtDecl (comb2A $2 $>) (unLoc $2) (hsUniTok $3) $4 } + {% mkGadtDecl (comb2 $2 $>) (unLoc $2) (hsUniTok $3) $4 } {- Note [Difference in parsing GADT and data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2507,7 +2507,7 @@ fielddecls1 :: { [LConDeclField GhcPs] } fielddecl :: { LConDeclField GhcPs } -- A list because of f,g :: Int : sig_vars '::' ctype - {% acsA (\cs -> L (comb2 $1 (reLoc $3)) + {% acsA (\cs -> L (comb2 $1 $3) (ConDeclField (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reverse (map (\ln@(L l n) -> L (l2l l) $ FieldOcc noExtField ln) (unLoc $1))) $3 Nothing))} @@ -2525,15 +2525,15 @@ derivings :: { Located (HsDeriving GhcPs) } -- know the rightmost extremity of the 'deriving' clause deriving :: { LHsDerivingClause GhcPs } : 'deriving' deriv_clause_types - {% let { full_loc = comb2A $1 $> } + {% let { full_loc = comb2 $1 $> } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) Nothing $2) } | 'deriving' deriv_strategy_no_via deriv_clause_types - {% let { full_loc = comb2A $1 $> } + {% let { full_loc = comb2 $1 $> } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $2) $3) } | 'deriving' deriv_clause_types deriv_strategy_via - {% let { full_loc = comb2 $1 (reLoc $>) } + {% let { full_loc = comb2 $1 $> } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $3) $2) } deriv_clause_types :: { LDerivClauseTys GhcPs } @@ -2574,7 +2574,7 @@ decl_no_th :: { LHsDecl GhcPs } : sigdecl { $1 } | infixexp opt_sig rhs {% runPV (unECP $1) >>= \ $1 -> - do { let { l = comb2Al $1 $> } + do { let { l = comb2 $1 $> } ; r <- checkValDef l $1 $2 $3; -- Depending upon what the pattern looks like we might get either -- a FunBind or PatBind back from checkValDef. See Note @@ -2608,7 +2608,7 @@ gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 -> - acsA (\cs -> sL (comb2A $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mj AnnEqual $3)) cs) (unLoc $2) $4) } + acsA (\cs -> sL (comb2 $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mj AnnEqual $3)) cs) (unLoc $2) $4) } sigdecl :: { LHsDecl GhcPs } : @@ -2712,7 +2712,7 @@ exp :: { ECP } { ECP $ unECP $1 >>= \ $1 -> rejectPragmaPV $1 >> - mkHsTySigPV (noAnnSrcSpan $ comb2Al $1 (reLoc $>)) $1 $3 + mkHsTySigPV (noAnnSrcSpan $ comb2 $1 $>) $1 $3 [(mu AnnDcolon $2)] } | infixexp '-<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> @@ -2747,7 +2747,7 @@ infixexp :: { ECP } unECP $1 >>= \ $1 -> unECP $3 >>= \ $3 -> rejectPragmaPV $1 >> - (mkHsOpAppPV (comb2A (reLoc $1) $3) $1 $2 $3) } + (mkHsOpAppPV (comb2 $1 $3) $1 $2 $3) } -- AnnVal annotation for NPlusKPat, which discards the operator exp10p :: { ECP } @@ -2764,7 +2764,7 @@ exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] : '-' fexp %shift { ECP $ unECP $2 >>= \ $2 -> - mkHsNegAppPV (comb2A $1 $>) $2 + mkHsNegAppPV (comb2 $1 $>) $2 [mj AnnMinus $1] } -- See Note [%shift: exp10 -> fexp] | fexp %shift { $1 } @@ -2836,12 +2836,12 @@ fexp :: { ECP } superFunArg $ unECP $1 >>= \ $1 -> unECP $2 >>= \ $2 -> - mkHsAppPV (noAnnSrcSpan $ comb2A (reLoc $1) $>) $1 $2 } + mkHsAppPV (noAnnSrcSpan $ comb2 $1 $>) $1 $2 } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | fexp PREFIX_AT atype { ECP $ unECP $1 >>= \ $1 -> - mkHsAppTypePV (noAnnSrcSpan $ comb2 (reLoc $1) (reLoc $>)) $1 (hsTok $2) $3 } + mkHsAppTypePV (noAnnSrcSpan $ comb2 $1 $>) $1 (hsTok $2) $3 } | 'static' aexp {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ @@ -2854,45 +2854,45 @@ aexp :: { ECP } : qvar TIGHT_INFIX_AT aexp { ECP $ unECP $3 >>= \ $3 -> - mkHsAsPatPV (comb2 (reLocN $1) (reLoc $>)) $1 (hsTok $2) $3 } + mkHsAsPatPV (comb2 $1 $>) $1 (hsTok $2) $3 } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE aexp { ECP $ unECP $2 >>= \ $2 -> - mkHsLazyPatPV (comb2 $1 (reLoc $>)) $2 [mj AnnTilde $1] } + mkHsLazyPatPV (comb2 $1 $>) $2 [mj AnnTilde $1] } | PREFIX_BANG aexp { ECP $ unECP $2 >>= \ $2 -> - mkHsBangPatPV (comb2 $1 (reLoc $>)) $2 [mj AnnBang $1] } + mkHsBangPatPV (comb2 $1 $>) $2 [mj AnnBang $1] } | PREFIX_MINUS aexp { ECP $ unECP $2 >>= \ $2 -> - mkHsNegAppPV (comb2A $1 $>) $2 [mj AnnMinus $1] } + mkHsNegAppPV (comb2 $1 $>) $2 [mj AnnMinus $1] } | '\\' apats '->' exp { ECP $ unECP $4 >>= \ $4 -> - mkHsLamPV (comb2 $1 (reLoc $>)) (\cs -> mkMatchGroup FromSource + mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource (reLocA $ sLLlA $1 $> [reLocA $ sLLlA $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 - , m_grhss = unguardedGRHSs (comb2 $3 (reLoc $4)) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])) } + , m_grhss = unguardedGRHSs (comb2 $3 $4) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])) } | 'let' binds 'in' exp { ECP $ unECP $4 >>= \ $4 -> - mkHsLetPV (comb2A $1 $>) (hsTok $1) (unLoc $2) (hsTok $3) $4 } + mkHsLetPV (comb2 $1 $>) (hsTok $1) (unLoc $2) (hsTok $3) $4 } | '\\' 'lcase' altslist(pats1) { ECP $ $3 >>= \ $3 -> - mkHsLamCasePV (comb2 $1 (reLoc $>)) LamCase $3 [mj AnnLam $1,mj AnnCase $2] } + mkHsLamCasePV (comb2 $1 $>) LamCase $3 [mj AnnLam $1,mj AnnCase $2] } | '\\' 'lcases' altslist(apats) { ECP $ $3 >>= \ $3 -> - mkHsLamCasePV (comb2 $1 (reLoc $>)) LamCases $3 [mj AnnLam $1,mj AnnCases $2] } + mkHsLamCasePV (comb2 $1 $>) LamCases $3 [mj AnnLam $1,mj AnnCases $2] } | 'if' exp optSemi 'then' exp optSemi 'else' exp {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) -> return $ ECP $ unECP $5 >>= \ $5 -> unECP $8 >>= \ $8 -> - mkHsIfPV (comb2A $1 $>) $2 (snd $3) $5 (snd $6) $8 + mkHsIfPV (comb2 $1 $>) $2 (snd $3) $5 (snd $6) $8 (AnnsIf { aiIf = glAA $1 , aiThen = glAA $4 @@ -2914,13 +2914,13 @@ aexp :: { ECP } hintQualifiedDo $1 return $ ECP $ $2 >>= \ $2 -> - mkHsDoPV (comb2A $1 $2) + mkHsDoPV (comb2 $1 $2) (fmap mkModuleNameFS (getDO $1)) $2 (AnnList (Just $ glAR $2) Nothing Nothing [mj AnnDo $1] []) } | MDO stmtlist {% hintQualifiedDo $1 >> runPV $2 >>= \ $2 -> fmap ecpFromExp $ - acsA (\cs -> L (comb2A $1 $2) + acsA (\cs -> L (comb2 $1 $2) (mkHsDoAnns (MDoExpr $ fmap mkModuleNameFS (getMDO $1)) $2 @@ -2938,7 +2938,7 @@ aexp1 :: { ECP } getBit OverloadedRecordUpdateBit >>= \ overloaded -> unECP $1 >>= \ $1 -> $3 >>= \ $3 -> - mkHsRecordPV overloaded (comb2 (reLoc $1) $>) (comb2 $2 $4) $1 $3 + mkHsRecordPV overloaded (comb2 $1 $>) (comb2 $2 $4) $1 $3 [moc $2,mcc $4] } @@ -2947,7 +2947,7 @@ aexp1 :: { ECP } {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in - mkRdrGetField (noAnnSrcSpan $ comb2 (reLoc $1) (reLoc $>)) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } + mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } | aexp2 { $1 } @@ -3098,13 +3098,13 @@ texp :: { ECP } superInfixOp $ unECP $2 >>= \ $2 -> $1 >>= \ $1 -> - pvA $ mkHsSectionR_PV (comb2 (reLocN $1) (reLoc $>)) (n2l $1) $2 } + pvA $ mkHsSectionR_PV (comb2 $1 $>) (n2l $1) $2 } -- View patterns get parenthesized above | exp '->' texp { ECP $ unECP $1 >>= \ $1 -> unECP $3 >>= \ $3 -> - mkHsViewPatPV (comb2 (reLoc $1) (reLoc $>)) $1 $3 [mu AnnRarrow $2] } + mkHsViewPatPV (comb2 $1 $>) $1 $3 [mu AnnRarrow $2] } -- Always at least one comma or bar. -- Though this can parse just commas (without any expressions), it won't @@ -3338,7 +3338,7 @@ alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) } ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : '->' exp { unECP $2 >>= \ $2 -> - acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 (reLoc $2)) $2)) } + acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } | gdpats { $1 >>= \gdpats -> return $ sL1 gdpats (reverse (unLoc gdpats)) } @@ -3360,7 +3360,7 @@ ifgdpats :: { Located ([AddEpAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) } gdpat :: { forall b. DisambECP b => PV (LGRHS GhcPs (LocatedA b)) } : '|' guardquals '->' exp { unECP $4 >>= \ $4 -> - acsA (\cs -> sL (comb2A $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mu AnnRarrow $3)) cs) (unLoc $2) $4) } + acsA (\cs -> sL (comb2 $1 $>) $ GRHS (EpAnn (glR $1) (GrhsAnn (Just $ glAA $1) (mu AnnRarrow $3)) cs) (unLoc $2) $4) } -- 'pat' recognises a pattern, including one with a bang at the top -- e.g. "!x" or "!(x,y)" or "C a b" etc @@ -3483,13 +3483,13 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } { do let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) - lf' = comb2 $2 (reLoc $ L lf ()) + lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t final = last fields - l = comb2 (reLoc $1) $3 + l = comb2 $1 $3 isPun = False $5 <- unECP $5 - fmap Right $ mkHsProjUpdatePV (comb2 (reLoc $1) (reLoc $5)) (L l fields) $5 isPun + fmap Right $ mkHsProjUpdatePV (comb2 $1 $5) (L l fields) $5 isPun [mj AnnEqual $4] } @@ -3499,10 +3499,10 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } { do let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) - lf' = comb2 $2 (reLoc $ L lf ()) + lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t final = last fields - l = comb2 (reLoc $1) $3 + l = comb2 $1 $3 isPun = True var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final)) fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun [] @@ -4087,18 +4087,8 @@ stringLiteralToHsDocWst :: Located StringLiteral -> Located (WithHsDocIdentifier stringLiteralToHsDocWst = lexStringLiteral parseIdentifier -- Utilities for combining source spans -comb2 :: Located a -> Located b -> SrcSpan -comb2 a b = a `seq` b `seq` combineLocs a b - --- Utilities for combining source spans -comb2A :: Located a -> LocatedAn t b -> SrcSpan -comb2A a b = a `seq` b `seq` combineLocs a (reLoc b) - -comb2N :: Located a -> LocatedN b -> SrcSpan -comb2N a b = a `seq` b `seq` combineLocs a (reLocN b) - -comb2Al :: LocatedAn t a -> Located b -> SrcSpan -comb2Al a b = a `seq` b `seq` combineLocs (reLoc a) b +comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan +comb2 a b = a `seq` b `seq` combineHasLocs a b comb3 :: Located a -> Located b -> Located c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` @@ -4168,11 +4158,11 @@ sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLlA #-} sLLlA :: Located a -> LocatedAn t b -> c -> Located c -sLLlA x y = sL (comb2A x y) -- #define LL sL (comb2 $1 $>) +sLLlA x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAl #-} sLLAl :: LocatedAn t a -> Located b -> c -> Located c -sLLAl x y = sL (comb2A y x) -- #define LL sL (comb2 $1 $>) +sLLAl x y = sL (comb2 y x) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} sLLAsl :: [LocatedAn t a] -> Located b -> c -> Located c @@ -4580,4 +4570,7 @@ adaptWhereBinds :: Maybe (Located (HsLocalBinds GhcPs, Maybe EpAnnComments)) adaptWhereBinds Nothing = noLoc (EmptyLocalBinds noExtField, emptyComments) adaptWhereBinds (Just (L l (b, mc))) = L l (b, maybe emptyComments id mc) +combineHasLocs :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan +combineHasLocs a b = combineSrcSpans (getHasLoc a) (getHasLoc b) + } ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -51,6 +51,7 @@ module GHC.Parser.Annotation ( -- ** we do not care about the annotations. la2na, na2la, n2l, l2n, l2l, la2la, reLoc, reLocA, reLocL, reLocC, reLocN, + HasLoc(..), getHasLocList, srcSpan2e, la2e, realSrcSpan, @@ -90,7 +91,7 @@ import GHC.Prelude import Data.Data import Data.Function (on) -import Data.List (sortBy) +import Data.List (sortBy, foldl1') import Data.Semigroup import GHC.Data.FastString import GHC.Types.Name @@ -916,6 +917,22 @@ reLocN (L (SrcSpanAnn _ l) a) = L l a -- --------------------------------------------------------------------- +class HasLoc a where + -- ^ conveniently calculate locations for things without locations attached + getHasLoc :: a -> SrcSpan + +instance HasLoc (Located a) where + getHasLoc (L l _) = l + +instance HasLoc (LocatedAn t a) where + getHasLoc (L la _) = locA la + +getHasLocList :: HasLoc a => [a] -> SrcSpan +getHasLocList [] = noSrcSpan +getHasLocList xs = foldl1' combineSrcSpans $ map getHasLoc xs + +-- --------------------------------------------------------------------- + realSrcSpan :: SrcSpan -> RealSrcSpan realSrcSpan (RealSrcSpan s _) = s realSrcSpan _ = mkRealSrcSpan l l -- AZ temporary View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c721d33e7317d016bc3e1d077d6a76968c8da8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/66c721d33e7317d016bc3e1d077d6a76968c8da8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:07:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:07:46 -0400 Subject: [Git][ghc/ghc][master] Fix deprecation warning when deprecated identifier is from another module Message-ID: <64a4d072620cb_399dfee12767831718c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 6 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - + testsuite/tests/warnings/should_compile/T23573.hs - + testsuite/tests/warnings/should_compile/T23573.stderr - + testsuite/tests/warnings/should_compile/T23573A.hs - + testsuite/tests/warnings/should_compile/T23573B.hs - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1099,8 +1099,11 @@ instance Diagnostic TcRnMessage where , pprWarningTxtForMsg pragma_warning_msg ] where impMsg = text "imported from" <+> ppr pragma_warning_import_mod <> extra - extra | maybe True (pragma_warning_import_mod ==) pragma_warning_defined_mod = empty - | otherwise = text ", but defined in" <+> ppr pragma_warning_defined_mod + extra = case pragma_warning_defined_mod of + Just def_mod + | def_mod /= pragma_warning_import_mod + -> text ", but defined in" <+> ppr def_mod + _ -> empty TcRnDifferentExportWarnings name locs -> mkSimpleDecorated $ vcat [quotes (ppr name) <+> text "exported with different error messages", text "at" <+> vcat (map ppr $ sortBy leftmost_smallest $ NE.toList locs)] ===================================== testsuite/tests/warnings/should_compile/T23573.hs ===================================== @@ -0,0 +1,5 @@ +module T23573 where + +import T23573A + +foo = deprec ===================================== testsuite/tests/warnings/should_compile/T23573.stderr ===================================== @@ -0,0 +1,5 @@ + +T23573.hs:5:7: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of ‘deprec’ + (imported from T23573A, but defined in T23573B): + Deprecated: "deprec" ===================================== testsuite/tests/warnings/should_compile/T23573A.hs ===================================== @@ -0,0 +1,5 @@ +module T23573A(module T23573B) where + +import T23573B + + ===================================== testsuite/tests/warnings/should_compile/T23573B.hs ===================================== @@ -0,0 +1,4 @@ +module T23573B where + +{-# DEPRECATED deprec "deprec" #-} +deprec = () ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -65,3 +65,4 @@ test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) test('T22702a', normal, compile, ['']) test('T22702b', normal, compile, ['']) test('T22826', normal, compile, ['']) +test('T23573', [extra_files(["T23573.hs", "T23573A.hs", "T23573B.hs"])], multimod_compile, ['T23573', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2be99b7e81e2ae5ef81fef21b0a55cfe77f917a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2be99b7e81e2ae5ef81fef21b0a55cfe77f917a3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:08:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:08:25 -0400 Subject: [Git][ghc/ghc][master] 3 commits: rts: Don't rely on initializers for sigaction_t Message-ID: <64a4d0997a59f_399dfead1c4322893@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 3 changed files: - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - rts/posix/Signals.c Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -142,6 +142,8 @@ werror = [ arg "-optc-Werror" -- clang complains about #pragma GCC pragmas , arg "-optc-Wno-error=unknown-pragmas" + -- rejected inlinings are highly dependent upon toolchain and way + , arg "-optc-Wno-error=inline" ] -- N.B. We currently don't build the boot libraries' C sources with -Werror -- as this tends to be a portability nightmare. ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -2,6 +2,7 @@ module Settings.Warnings (defaultGhcWarningsArgs, ghcWarningsArgs) where import Expression import Oracles.Flag +import Oracles.Setting (isOsxTarget, isWinTarget) import Packages -- See @mk/warnings.mk@ for warning-related arguments in the Make build system. @@ -12,7 +13,11 @@ defaultGhcWarningsArgs = mconcat [ notStage0 ? arg "-Wnoncanonical-monad-instances" , notM (flag CcLlvmBackend) ? arg "-optc-Wno-error=inline" , flag CcLlvmBackend ? arg "-optc-Wno-unknown-pragmas" - , arg "-optP-Wno-nonportable-include-path" -- #17798 + -- Cabal can seemingly produce filepaths with incorrect case on filesystems + -- with case-insensitive names. Ignore such issues for now as they seem benign. + -- See #17798. + , isOsxTarget ? arg "-optP-Wno-nonportable-include-path" + , isWinTarget ? arg "-optP-Wno-nonportable-include-path" ] -- | Package-specific warnings-related arguments, mostly suppressing various warnings. ===================================== rts/posix/Signals.c ===================================== @@ -368,9 +368,11 @@ int stg_sig_install(int sig, int spi, void *mask) { sigset_t signals, osignals; - struct sigaction action; StgInt previous_spi; + struct sigaction action; + memset(&action, 0, sizeof(struct sigaction)); + ACQUIRE_LOCK(&sig_mutex); // Block the signal until we figure out what to do @@ -619,6 +621,7 @@ static void set_sigtstp_action (bool handle) { struct sigaction sa; + memset(&sa, 0, sizeof(struct sigaction)); if (handle) { sa.sa_handler = sigtstp_handler; } else { @@ -635,7 +638,8 @@ set_sigtstp_action (bool handle) void install_vtalrm_handler(int sig, TickProc handle_tick) { - struct sigaction action = {}; + struct sigaction action; + memset(&action, 0, sizeof(struct sigaction)); action.sa_handler = handle_tick; @@ -677,8 +681,11 @@ install_vtalrm_handler(int sig, TickProc handle_tick) void initDefaultHandlers(void) { - struct sigaction action = {}; - struct sigaction oact = {}; + // N.B. We can't use initializers here as CentOS's ancient toolchain throws + // spurious warnings. See #23577. + struct sigaction action, oact; + memset(&oact, 0, sizeof(struct sigaction)); + memset(&action, 0, sizeof(struct sigaction)); // install the SIGINT handler action.sa_handler = shutdown_handler; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2be99b7e81e2ae5ef81fef21b0a55cfe77f917a3...3a09b789102dc0ea20a9af0912bc817ac5cb8c59 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2be99b7e81e2ae5ef81fef21b0a55cfe77f917a3...3a09b789102dc0ea20a9af0912bc817ac5cb8c59 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:09:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:09:00 -0400 Subject: [Git][ghc/ghc][master] Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals Message-ID: <64a4d0bc248a_399dfead214326214@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 3 changed files: - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - testsuite/tests/th/T20454.hs - testsuite/tests/th/T20454.stdout Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Ppr.hs ===================================== @@ -302,27 +302,28 @@ pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#' pprLit _ (BytesPrimL {}) = pprString "" pprLit i (RationalL rat) | withoutFactor 2 (withoutFactor 5 $ denominator rat) /= 1 - -- if the denominator has prime factors other than 2 and 5, show as fraction + -- if the denominator has prime factors other than 2 and 5 + -- or can't be represented as Double, show as fraction = parensIf (i > noPrec) $ integer (numerator rat) <+> char '/' <+> integer (denominator rat) - | rat /= 0 && (zeroes < -1 || zeroes > 7), - let (n, d) = properFraction (rat' / magnitude) - (rat', zeroes') - | abs rat < 1 = (10 * rat, zeroes - 1) - | otherwise = (rat, zeroes) + | rat /= 0 && (zeroes < -2 || zeroes > 6), + let (n, d) = properFraction (rat / magnitude) -- if < 0.01 or >= 100_000_000, use scientific notation = parensIf (i > noPrec && rat < 0) (integer n <> (if d == 0 then empty else char '.' <> decimals (abs d)) - <> char 'e' <> integer zeroes') + <> char 'e' <> integer zeroes) | let (n, d) = properFraction rat = parensIf (i > noPrec && rat < 0) (integer n <> char '.' <> if d == 0 then char '0' else decimals (abs d)) where zeroes :: Integer - zeroes = truncate (logBase 10 (abs (fromRational rat) :: Double) - * (1 - epsilon)) - epsilon = 0.0000001 + zeroes = log10 (abs rat) + log10 :: Rational -> Integer + log10 x + | x >= 10 = 1 + log10 (x / 10) + | x < 1 = -1 + log10 (x * 10) + | otherwise = 0 magnitude :: Rational magnitude = 10 ^^ zeroes withoutFactor :: Integer -> Integer -> Integer ===================================== testsuite/tests/th/T20454.hs ===================================== @@ -8,6 +8,7 @@ e1, e2 :: ExpQ e1 = [| -- Test the Template Haskell pretty-printing of rational literals [0.0, 123.0, -321.0, 9e3, 10000.0, -500000000.0, 345e67, -456e78, + 1e400, -1e400, -- T23571 0.01, -0.002, 0.04e-56, -0.3e-65, 0.33333333333333333333333333333, $(pure $ LitE $ RationalL $ 1/3)] |] ===================================== testsuite/tests/th/T20454.stdout ===================================== @@ -6,6 +6,8 @@ -5e8, 3.45e69, -4.56e80, + 1e400, + -1e400, 0.01, -2e-3, 4e-58, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4af7eac2a00e86c29509c119aacc7511a9c7747d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4af7eac2a00e86c29509c119aacc7511a9c7747d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:09:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:09:36 -0400 Subject: [Git][ghc/ghc][master] compiler: Make OccSet opaque Message-ID: <64a4d0e0612ec_399dfead264330225@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - 1 changed file: - compiler/GHC/Types/Name/Occurrence.hs Changes: ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -809,7 +809,7 @@ forceOccEnv nf (MkOccEnv fs) = seqEltsUFM (seqEltsUFM nf) fs -------------------------------------------------------------------------------- -type OccSet = FastStringEnv (UniqSet NameSpace) +newtype OccSet = OccSet (FastStringEnv (UniqSet NameSpace)) emptyOccSet :: OccSet unitOccSet :: OccName -> OccSet @@ -821,15 +821,15 @@ unionManyOccSets :: [OccSet] -> OccSet elemOccSet :: OccName -> OccSet -> Bool isEmptyOccSet :: OccSet -> Bool -emptyOccSet = emptyFsEnv -unitOccSet (OccName ns s) = unitFsEnv s (unitUniqSet ns) +emptyOccSet = OccSet emptyFsEnv +unitOccSet (OccName ns s) = OccSet $ unitFsEnv s (unitUniqSet ns) mkOccSet = extendOccSetList emptyOccSet -extendOccSet occs (OccName ns s) = extendFsEnv occs s (unitUniqSet ns) -extendOccSetList = foldl extendOccSet -unionOccSets = plusFsEnv_C unionUniqSets +extendOccSet (OccSet occs) (OccName ns s) = OccSet $ extendFsEnv occs s (unitUniqSet ns) +extendOccSetList = foldl' extendOccSet +unionOccSets (OccSet xs) (OccSet ys) = OccSet $ plusFsEnv_C unionUniqSets xs ys unionManyOccSets = foldl' unionOccSets emptyOccSet -elemOccSet (OccName ns s) occs = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s -isEmptyOccSet = isNullUFM +elemOccSet (OccName ns s) (OccSet occs) = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s +isEmptyOccSet (OccSet occs) = isNullUFM occs {- ************************************************************************ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2304c6972fd485de335d1490008fc066055c81c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2304c6972fd485de335d1490008fc066055c81c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:10:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:10:14 -0400 Subject: [Git][ghc/ghc][master] Add Note about why we need forall in Code to be on the right Message-ID: <64a4d1064c1b3_399dfead26433358f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - 1 changed file: - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -380,8 +380,7 @@ The splice will evaluate to (MkAge 3) and you can't add that to -- Code constructor #if __GLASGOW_HASKELL__ >= 909 type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type - -- The nested `forall` makes it possible to assign the arity of 0 to - -- type CodeQ = Code Q + -- See Note [Foralls to the right in Code] #else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type #endif @@ -424,6 +423,23 @@ newtype Code m a = Code -- In the Template Haskell splice $$([|| "foo" ||]) +{- Note [Foralls to the right in Code] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Code has the following type signature: + type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type + +This allows us to write + data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#) + + tcodeq :: T (Code Q) + tcodeq = MkT [||5||] [||5#||] + +If we used the slightly more straightforward signature + type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type + +then the example above would become ill-typed. (See #23592 for some discussion.) +-} + -- | Unsafely convert an untyped code representation into a typed code -- representation. unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m . View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf735db883b2ff83e61f9848a39f1066d3288a43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf735db883b2ff83e61f9848a39f1066d3288a43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:10:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:10:54 -0400 Subject: [Git][ghc/ghc][master] Relax the constraint about the foreign function's calling convention of... Message-ID: <64a4d12e45e07_399dfead1b033709d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 1 changed file: - libraries/base/GHC/ForeignPtr.hs Changes: ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -228,7 +228,7 @@ instance Show (ForeignPtr a) where -- finalisation time, gets as an argument a plain pointer variant of the -- foreign pointer that the finalizer is associated with. -- --- Note that the foreign function /must/ use the @ccall@ calling convention. +-- Note that the foreign function /must/ either use the @ccall@ or the @capi@ calling convention. -- type FinalizerPtr a = FunPtr (Ptr a -> IO ()) type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> IO ()) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb140f822392cd38ce275451d33e818fcdcab81c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb140f822392cd38ce275451d33e818fcdcab81c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 02:42:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 04 Jul 2023 22:42:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 16 commits: configure: Rip out Solaris dyld check Message-ID: <64a4d88921823_399dfead1b034250@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - ac7b4da1 by meooow25 at 2023-07-04T22:42:06-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - c4eb4850 by Jaro Reinders at 2023-07-04T22:42:12-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 63d348f3 by Brandon Chinn at 2023-07-04T22:42:12-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 21 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcdb1900411e3a5908a5956f179173526b4f4f0e...63d348f38cab68a80a9616f3c8f0953413a7bbbe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bcdb1900411e3a5908a5956f179173526b4f4f0e...63d348f38cab68a80a9616f3c8f0953413a7bbbe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 03:19:46 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Tue, 04 Jul 2023 23:19:46 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to enable/disable incoherent instances Message-ID: <64a4e15235b6a_399dfead1d83536e1@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 864266e0 by Gergő Érdi at 2023-07-05T04:19:32+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 15 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/Basic.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/simplCore/should_run/T22448.hs Changes: ===================================== compiler/GHC/Builtin/Names/TH.hs ===================================== @@ -137,7 +137,7 @@ templateHaskellNames = [ allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName, -- Overlap overlappableDataConName, overlappingDataConName, overlapsDataConName, - incoherentDataConName, + incoherentDataConName, noncanonicalDataConName, -- DerivStrategy stockStrategyName, anyclassStrategyName, newtypeStrategyName, viaStrategyName, @@ -641,11 +641,13 @@ beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey overlappableDataConName, overlappingDataConName, overlapsDataConName, - incoherentDataConName :: Name + incoherentDataConName, + noncanonicalDataConName :: Name overlappableDataConName = thCon (fsLit "Overlappable") overlappableDataConKey overlappingDataConName = thCon (fsLit "Overlapping") overlappingDataConKey overlapsDataConName = thCon (fsLit "Overlaps") overlapsDataConKey incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey +noncanonicalDataConName = thCon (fsLit "NonCanonical") noncanonicalDataConKey {- ********************************************************************* * * @@ -748,11 +750,13 @@ beforePhaseDataConKey = mkPreludeDataConUnique 208 overlappableDataConKey, overlappingDataConKey, overlapsDataConKey, - incoherentDataConKey :: Unique + incoherentDataConKey, + noncanonicalDataConKey :: Unique overlappableDataConKey = mkPreludeDataConUnique 209 overlappingDataConKey = mkPreludeDataConUnique 210 overlapsDataConKey = mkPreludeDataConUnique 211 incoherentDataConKey = mkPreludeDataConUnique 212 +noncanonicalDataConKey = mkPreludeDataConUnique 213 {- ********************************************************************* * * ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -122,10 +122,11 @@ fuzzyClsInstCmp x y = cmp (RM_KnownTc _, RM_WildCard) = GT cmp (RM_KnownTc x, RM_KnownTc y) = stableNameCmp x y -isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool +isOverlappable, isOverlapping, isIncoherent, isNonCanonical :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i)) isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i)) +isNonCanonical i = hasNonCanonicalFlag (overlapMode (is_flag i)) {- Note [ClsInst laziness and the rough-match fields] @@ -812,8 +813,19 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. However, the +specialiser crucially depends on evidence dictionaries being +singletons. Something has to give: either we avoid specialising +dictionaries that were incoherently constructed, leaving optimisation +opportunities on the table (see discussions in #23287); or we assume +that the choice of instance doesn't matter for the behaviour of the +program, leaving this as a proof obligation to the user. The flags +`-fspecialise-incoherents` (on by default) selects the second +behaviour, i.e. enables specialisation on incoherent evidence. The +rest of this note describes what happens with +`-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -955,7 +967,18 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +data Coherence = + -- | Coherent evidence that is always safe to specialise on + IsCoherent + | + -- | Incoherent evidence. The user might decide that they're OK with + -- specialising these. See Note [Coherence and specialisation: overview] + -- for the subtleties of this situation. + IsIncoherent + | + -- | Non-canonical evidence, a la `withDict`. Never OK to specialise. + -- See Note [withDict] in GHC.Tc.Instance.Class for details. + IsNonCanonical -- See Note [Recording coherence information in `PotentialUnifiers`] data PotentialUnifiers = NoUnifiers Coherence @@ -983,6 +1006,7 @@ potential unifiers is otherwise empty. instance Outputable Coherence where ppr IsCoherent = text "coherent" ppr IsIncoherent = text "incoherent" + ppr IsNonCanonical = text "non-canonical" instance Outputable PotentialUnifiers where ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c @@ -990,6 +1014,8 @@ instance Outputable PotentialUnifiers where instance Semigroup Coherence where IsCoherent <> IsCoherent = IsCoherent + IsNonCanonical <> _ = IsNonCanonical + _ <> IsNonCanonical = IsNonCanonical _ <> _ = IsIncoherent instance Semigroup PotentialUnifiers where @@ -1039,9 +1065,9 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys = acc - incoherently_matched :: PotentialUnifiers -> PotentialUnifiers - incoherently_matched (NoUnifiers _) = NoUnifiers IsIncoherent - incoherently_matched u = u + noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers + noncanonically_matched (NoUnifiers _) = NoUnifiers IsNonCanonical + noncanonically_matched u = u check_unifier :: [ClsInst] -> PotentialUnifiers check_unifier [] = NoUnifiers IsCoherent @@ -1051,10 +1077,12 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys | Just {} <- tcMatchTys tpl_tys tys = check_unifier items -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] + -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview] + | isNonCanonical item + = noncanonically_matched $ check_unifier items -- Ignore ones that are incoherent: Note [Incoherent instances] - -- Record that we encountered incoherent instances: Note [Coherence and specialisation: overview] | isIncoherent item - = incoherently_matched $ check_unifier items + = check_unifier items | otherwise = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set) ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -1201,20 +1201,23 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring incoherent evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1242,34 +1245,35 @@ dsEvBinds ev_binds thing_inside where go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False + is_specable IsCoherent = True + is_specable IsIncoherent = True + is_specable IsNonCanonical = False - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + transitively_unspecable = not (is_specable this_coherence) || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where (pairs, direct_coherence) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not (is_specable this_coherence) || any is_unspecable_remote deps | (this_coherence, deps) <- direct_coherence ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring incoherent evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -357,7 +357,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +413,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -2628,6 +2628,7 @@ repOverlap mb = Overlapping _ -> just =<< dataCon overlappingDataConName Overlaps _ -> just =<< dataCon overlapsDataConName Incoherent _ -> just =<< dataCon incoherentDataConName + NonCanonical _ -> just =<< dataCon noncanonicalDataConName where nothing = coreNothing overlapTyConName just = coreJust overlapTyConName ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -79,9 +79,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar + , dsl_unspecables :: S.Set EvVar -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2514,6 +2514,7 @@ reifyClassInstance is_poly_tvs i Overlapping _ -> Just TH.Overlapping Overlaps _ -> Just TH.Overlaps Incoherent _ -> Just TH.Incoherent + NonCanonical _ -> Just TH.NonCanonical ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -448,7 +448,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_coherence = IsNonCanonical -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, RecursiveDo #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -820,16 +821,27 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt LangExt.OverlappingInstances dflags - incoherent_ok = xopt LangExt.IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags + noncanonical_incoherence = not $ gopt Opt_SpecialiseIncoherents dflags + use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent NoSourceText) | overlap_ok = use (Overlaps NoSourceText) | otherwise = use (NoOverlap NoSourceText) - final_oflag = setOverlapModeMaybe default_oflag overlap_mode + oflag = setOverlapModeMaybe default_oflag overlap_mode + final_oflag = effective_oflag noncanonical_incoherence oflag ; return final_oflag } + where + effective_oflag noncanonical_incoherence oflag at OverlapFlag{ overlapMode = overlap_mode } + = oflag { overlapMode = effective_overlap_mode noncanonical_incoherence overlap_mode } + + effective_overlap_mode noncanonical_incoherence = \case + Incoherent s | noncanonical_incoherence -> NonCanonical s + overlap_mode -> overlap_mode + tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, - hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, + hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag, Boxity(..), isBoxed, @@ -628,6 +628,7 @@ hasIncoherentFlag :: OverlapMode -> Bool hasIncoherentFlag mode = case mode of Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappableFlag :: OverlapMode -> Bool @@ -636,6 +637,7 @@ hasOverlappableFlag mode = Overlappable _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappingFlag :: OverlapMode -> Bool @@ -644,8 +646,14 @@ hasOverlappingFlag mode = Overlapping _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False +hasNonCanonicalFlag :: OverlapMode -> Bool +hasNonCanonicalFlag = \case + NonCanonical{} -> True + _ -> False + data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv = NoOverlap SourceText -- See Note [Pragma source text] @@ -700,6 +708,8 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv -- instantiating 'b' would change which instance -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv" + | NonCanonical SourceText + deriving (Eq, Data) @@ -712,6 +722,7 @@ instance Outputable OverlapMode where ppr (Overlapping _) = text "[overlapping]" ppr (Overlaps _) = text "[overlap ok]" ppr (Incoherent _) = text "[incoherent]" + ppr (NonCanonical _) = text "[noncanonical]" instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s @@ -719,6 +730,7 @@ instance Binary OverlapMode where put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s + put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s get bh = do h <- getByte bh case h of @@ -727,6 +739,7 @@ instance Binary OverlapMode where 2 -> (get bh) >>= \s -> return $ Incoherent s 3 -> (get bh) >>= \s -> return $ Overlapping s 4 -> (get bh) >>= \s -> return $ Overlappable s + 5 -> (get bh) >>= \s -> return $ NonCanonical s _ -> panic ("get OverlapMode" ++ show h) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -2512,6 +2512,8 @@ data Overlap = Overlappable -- ^ May be overlapped by more specific instances | Incoherent -- ^ Both 'Overlapping' and 'Overlappable', and -- pick an arbitrary one if multiple choices are -- available. + | NonCanonical -- ^ Incoherent, and different instance choices + -- can lead to different observable behaviour. deriving( Show, Eq, Ord, Data, Generic ) -- | A single @deriving@ clause at the end of a datatype. ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/864266e04c739ebf058dc8f18daa230630f3aaf9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/864266e04c739ebf058dc8f18daa230630f3aaf9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 07:58:16 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Wed, 05 Jul 2023 03:58:16 -0400 Subject: [Git][ghc/ghc][wip/or-pats] 70 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64a5229892b3a_399dfead2503652be@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 314ae17c by David Knothe at 2023-07-05T09:57:50+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. stuff Implement empty one of Prohibit TyApps Remove unused update submodule haddock Update tests Parser.y - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/740e73fffeccbc94c3a6fec28ba4ec19124f7b77...314ae17cb431d7bf26a34fab388ff8db5908ec8e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/740e73fffeccbc94c3a6fec28ba4ec19124f7b77...314ae17cb431d7bf26a34fab388ff8db5908ec8e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 08:07:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 05 Jul 2023 04:07:53 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 22 commits: configure: Rip out Solaris dyld check Message-ID: <64a524d98b76f_399dfead264366285@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 6a58ad2a by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - c653ee1f by Ben Gamari at 2023-07-05T09:07:32+01:00 ghc-toolchain: Initial commit - - - - - aaa7f9a4 by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 0ade0ad4 by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - 3d7244bb by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - 8d74813f by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 67a3e879 by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 72c45e27 by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 Use ghc-platform instead of ghc-boot - - - - - a53d9c7b by Rodrigo Mesquita at 2023-07-05T09:07:32+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - 30 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - + TODO - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Platform.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Types/Name/Occurrence.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b3d4b33d6be50dd63047f65ad54533b42a19ddd...a53d9c7b95a021655869b5598ed14ec5b0c53b28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b3d4b33d6be50dd63047f65ad54533b42a19ddd...a53d9c7b95a021655869b5598ed14ec5b0c53b28 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 09:30:25 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 05 Jul 2023 05:30:25 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] FixeWs Message-ID: <64a53831cdb7c_399dfead1c437978d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f8462308 by Rodrigo Mesquita at 2023-07-05T10:30:19+01:00 FixeWs - - - - - 3 changed files: - hadrian/src/Oracles/Setting.hs - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -259,10 +259,11 @@ libsuf st way return (suffix ++ "-ghc" ++ version ++ extension) targetStage :: Stage -> Action Target --- ROMES:TODO: First iteration, only make it work for BUILD=HOST=TARGET --- What are the correct targets here? +-- TODO: We currently only support cross-compiling a stage1 compiler, +-- but the cross compiler should really be stage2 (#19174) +-- When we get there, we'll need to change the definition here. targetStage (Stage0 {}) = getBuildTarget targetStage (Stage1 {}) = getHostTarget -targetStage (Stage2 {}) = getHostTarget +targetStage (Stage2 {}) = getTargetTarget targetStage (Stage3 {}) = getTargetTarget ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -251,16 +251,18 @@ registerisedSupported archOs = ArchARM _ _ _ -> True ArchAArch64 -> True ArchRISCV64 -> True + ArchWasm32 -> True + ArchJavaScript -> True _ -> False determineUnregisterised :: ArchOS -> Maybe Bool -> M Bool determineUnregisterised archOs userReq = case userReq of - Just False + Just False -- user requested registerised build | not regSupported -> throwE "GHC doesn't support registerised compilation on this architecture" | otherwise -> return False Just True -> return True - Nothing + Nothing -- user wasn't explicit, do registerised if we support it | regSupported -> return False | otherwise -> return True where ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -53,7 +53,7 @@ getEnv :: M Env getEnv = M $ lift Reader.ask makeM :: IO (Either [Error] a) -> M a -makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io))) +makeM io = M (Except.ExceptT (Reader.ReaderT (\_env -> io))) data Error = Error { errorMessage :: String , errorLogContexts :: [String] @@ -116,6 +116,8 @@ appendFile path s = liftIO $ Prelude.appendFile path s createFile :: FilePath -> M () createFile path = writeFile path "" +-- | Branch on whether we're cross-compiling, that is, if the Target we're +-- producing differs from the platform we're producing it on. ifCrossCompiling :: M a -- ^ what to do when cross-compiling -> M a -- ^ what to do otherwise View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8462308790dad5e763172c7a5cf9857606bf2af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8462308790dad5e763172c7a5cf9857606bf2af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 11:33:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 05 Jul 2023 07:33:42 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] FixeWs Message-ID: <64a55516264b5_399dfead200409362@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 87177664 by Rodrigo Mesquita at 2023-07-05T12:33:30+01:00 FixeWs - - - - - 9 changed files: - TODO - default.target.in - hadrian/src/Oracles/Setting.hs - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== TODO ===================================== @@ -1,2 +1,5 @@ +Things that might get done on this or another MR +[ ] Drop SettingsXXXX altogether, now we just have the toolchain (well, this goes with deleting a good part of configure) +[ ] Readelf is only used to find cc link, that OK? [ ] In hadrian/src/Rules/Generate.hs, generateGhcPlatformH, factor out the query into an argument to chooseSetting, to deduplicate it [ ] Get rid of all the ToolchainSettings in Hadrian still (e.g. settings-clang-command) ===================================== default.target.in ===================================== @@ -1,6 +1,6 @@ Target -{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} -, tgtVendor = @HostVendor_CPPMaybeStr@ +{ tgtArchOs = ArchOS {archOS_arch = @HaskellTargetArch@, archOS_OS = @HaskellTargetOs@} +, tgtVendor = @TargetVendor_CPPMaybeStr@ , tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ , tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ , tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ @@ -34,6 +34,6 @@ Target , tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@SettingsRanlibCommand@", prgFlags = []}}) , tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} , tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}, mergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFilesBool@}) -, tgtDllwrap = @SettingsDllWrapCommandMaybeProg@ -, tgtWindres = @SettingsWindresCommandMaybeProg@ +, tgtDllwrap = @DllWrapCmdMaybeProg@ +, tgtWindres = @WindresCmdMaybeProg@ } ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -82,6 +82,8 @@ data Setting = CursesIncludeDir -- This used to be defined by 'FP_SETTINGS' in aclocal.m4. -- -- TODO: We should be able to drop this completely, after moving all the toolchain settings to ghc-toolchain +-- +-- TODO: For the next person, move to ghc-toolchain and to the Target files generated by configure and ghc-toolchain data ToolchainSetting = ToolchainSetting_OtoolCommand | ToolchainSetting_InstallNameToolCommand @@ -259,10 +261,11 @@ libsuf st way return (suffix ++ "-ghc" ++ version ++ extension) targetStage :: Stage -> Action Target --- ROMES:TODO: First iteration, only make it work for BUILD=HOST=TARGET --- What are the correct targets here? +-- TODO: We currently only support cross-compiling a stage1 compiler, +-- but the cross compiler should really be stage2 (#19174) +-- When we get there, we'll need to change the definition here. targetStage (Stage0 {}) = getBuildTarget targetStage (Stage1 {}) = getHostTarget -targetStage (Stage2 {}) = getHostTarget +targetStage (Stage2 {}) = getTargetTarget targetStage (Stage3 {}) = getTargetTarget ===================================== m4/ghc_toolchain.m4 ===================================== @@ -78,14 +78,17 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--output=default.ghc-toolchain.target" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs echo "--cc=$CC" >> acargs - echo "--readelf=$READELF" >> acargs + echo "--cxx=$CXX" >> acargs echo "--cpp=$CPPCmd" >> acargs echo "--hs-cpp=$HaskellCPPCmd" >> acargs echo "--cc-link=$CC" >> acargs - echo "--cxx=$CXX" >> acargs echo "--ar=$AR" >> acargs echo "--ranlib=$RANLIB" >> acargs echo "--nm=$NM" >> acargs + echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs + echo "--readelf=$READELF" >> acargs + echo "--windres=$WindresCmd" >> acargs + echo "--dllwrap=$DllWrapCmd" >> acargs ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ===================================== m4/prep_target_file.m4 ===================================== @@ -7,14 +7,11 @@ # # $1 = optional value AC_DEFUN([PREP_MAYBE_SIMPLE_PROGRAM],[ - case "$$1" in - /bin/false) + if test -z "$$1"; then $1MaybeProg=Nothing - ;; - *) + else $1MaybeProg="Just (Program {prgPath = \"$$1\", prgFlags = @<:@@:>@})" - ;; - esac + fi AC_SUBST([$1MaybeProg]) ]) @@ -113,9 +110,9 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_LIST([SettingsCPPFlags]) PREP_LIST([SettingsCxxCompilerFlags]) PREP_LIST([SettingsCCompilerFlags]) - PREP_MAYBE_SIMPLE_PROGRAM([SettingsDllWrapCommand]) - PREP_MAYBE_SIMPLE_PROGRAM([SettingsWindresCommand]) - PREP_MAYBE_STRING([HostVendor_CPP]) + PREP_MAYBE_SIMPLE_PROGRAM([DllWrapCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) + PREP_MAYBE_STRING([TargetVendor_CPP]) dnl PREP_ENDIANNESS case "$TargetWordBigEndian" in ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -251,16 +251,18 @@ registerisedSupported archOs = ArchARM _ _ _ -> True ArchAArch64 -> True ArchRISCV64 -> True + ArchWasm32 -> True + ArchJavaScript -> True _ -> False determineUnregisterised :: ArchOS -> Maybe Bool -> M Bool determineUnregisterised archOs userReq = case userReq of - Just False + Just False -- user requested registerised build | not regSupported -> throwE "GHC doesn't support registerised compilation on this architecture" | otherwise -> return False Just True -> return True - Nothing + Nothing -- user wasn't explicit, do registerised if we support it | regSupported -> return False | otherwise -> return True where ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -53,7 +53,7 @@ getEnv :: M Env getEnv = M $ lift Reader.ask makeM :: IO (Either [Error] a) -> M a -makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io))) +makeM io = M (Except.ExceptT (Reader.ReaderT (\_env -> io))) data Error = Error { errorMessage :: String , errorLogContexts :: [String] @@ -116,6 +116,8 @@ appendFile path s = liftIO $ Prelude.appendFile path s createFile :: FilePath -> M () createFile path = writeFile path "" +-- | Branch on whether we're cross-compiling, that is, if the Target we're +-- producing differs from the platform we're producing it on. ifCrossCompiling :: M a -- ^ what to do when cross-compiling -> M a -- ^ what to do otherwise ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -141,37 +141,36 @@ compileAsm = compile "S" ["-c"] _ccProgram addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc addPlatformDepCcFlags archOs cc0 = do let cc1 = addWorkaroundFor7799 archOs cc0 - cc2 <- addOSMinGW32CcFlags archOs cc1 -- As per FPTOOLS_SET_C_LD_FLAGS case archOs of ArchOS ArchX86 OSMinGW32 -> - return $ cc2 & _ccFlags %++ "-march=i686" + return $ cc1 & _ccFlags %++ "-march=i686" ArchOS ArchX86 OSFreeBSD -> - return $ cc2 & _ccFlags %++ "-march=i686" + return $ cc1 & _ccFlags %++ "-march=i686" ArchOS ArchX86_64 OSSolaris2 -> -- Solaris is a multi-lib platform, providing both 32- and 64-bit -- user-land. It appears to default to 32-bit builds but we of course want to -- compile for 64-bits on x86-64. - return $ cc2 & _ccFlags %++ "-m64" + return $ cc1 & _ccFlags %++ "-m64" ArchOS ArchAlpha _ -> -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. - return $ cc2 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"]) + return $ cc1 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"]) -- ArchOS ArchHPPA? _ -> ArchOS ArchARM{} OSFreeBSD -> -- On arm/freebsd, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ cc2 & _ccFlags %++ "-marm" + return $ cc1 & _ccFlags %++ "-marm" ArchOS ArchARM{} OSLinux -> -- On arm/linux and arm/android, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ cc2 & _ccFlags %++ "-marm" + return $ cc1 & _ccFlags %++ "-marm" ArchOS ArchPPC OSAIX -> -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. - return $ cc2 & _ccFlags %++ "-D_THREAD_SAFE" + return $ cc1 & _ccFlags %++ "-D_THREAD_SAFE" _ -> - return cc2 + return cc1 -- | Workaround for #7799 @@ -180,18 +179,3 @@ addWorkaroundFor7799 archOs cc | ArchX86 <- archOS_arch archOs = cc & _ccFlags %++ "-U__i686" | otherwise = cc --- | Adds flags specific to mingw32 -addOSMinGW32CcFlags :: ArchOS -> Cc -> M Cc -addOSMinGW32CcFlags archOs cc - | ArchOS _ OSMinGW32 <- archOs = do - checkFStackCheck cc <|> throwE "Windows requires -fstack-check support yet the C compiler appears not to support it" - | otherwise = return cc - --- | Check that @cc@ supports @-fstack-check at . --- See Note [Windows stack allocations]. -checkFStackCheck :: Cc -> M Cc -checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works" $ do - let cc' = cc & _ccFlags %++ "-Wl,-fstack-checkzz" - compileC cc' (dir "test.o") "int main(int argc, char **argv) { return 0; }" - return cc' - ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -166,8 +166,11 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do compileC cc main_o "int f(int a); int main(int argc, char **argv) { return f(0); }" let out = dir "test" + err = "linker didn't produce any output" callProgram ccLink ["-o", out, test_o, main_o] - expectFileExists out "linker didn't produce any output" + expectFileExists out err + -- Linking in windows might produce an executable with an ".exe" extension + <|> expectFileExists (out <.> "exe") err checkLinkIsGnu :: Program -> M Bool checkLinkIsGnu ccLink = do @@ -244,6 +247,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program addPlatformDepLinkFlags archOs cc ccLink0 = do ccLink1 <- addNoAsNeeded archOs cc ccLink0 + ccLink2 <- addOSMinGW32CcFlags archOs cc ccLink1 -- As per FPTOOLS_SET_C_LD_FLAGS case archOs of -- ROMES:TODO: Consider dropping this alongside other configuration for solaris that was dropped @@ -254,32 +258,47 @@ addPlatformDepLinkFlags archOs cc ccLink0 = do -- -- On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris -- implementation, which rather uses the -64 flag. - return $ ccLink1 & _prgFlags %++ "-m64" + return $ ccLink2 & _prgFlags %++ "-m64" ArchOS ArchAlpha _ -> -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. - return $ ccLink1 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"]) + return $ ccLink2 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"]) -- ArchOS ArchHPPA? _ -> ArchOS ArchARM{} OSFreeBSD -> -- On arm/freebsd, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchARM{} OSLinux -> -- On arm/linux and arm/android, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchAArch64 OSFreeBSD -> - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchAArch64 OSLinux -> - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchAArch64 OSNetBSD -> - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchPPC OSAIX -> -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. - return $ ccLink1 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) + return $ ccLink2 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) _ -> - return ccLink1 + return ccLink2 + +-- | Adds flags specific to mingw32 +addOSMinGW32CcFlags :: ArchOS -> Cc -> Program -> M Program +addOSMinGW32CcFlags archOs cc link + | ArchOS _ OSMinGW32 <- archOs = do + checkFStackCheck cc link <|> throwE "Windows requires -fstack-check support yet the C compiler linker appears not to support it" + | otherwise = return link + +-- | Check that @cc@ supports @-fstack-check at . +-- See Note [Windows stack allocations]. +checkFStackCheck :: Cc -> Program -> M Program +checkFStackCheck cc link = checking "that -fstack-check works" $ do + let link' = link & _prgFlags %++ "-fstack-check" + checkLinkWorks cc link' + return link' -- | See Note [ELF needed shared libs] addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87177664e31be26ec5dfb56790d792412d0a9168 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87177664e31be26ec5dfb56790d792412d0a9168 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 11:59:47 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 05 Jul 2023 07:59:47 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 3 commits: Better documentation Message-ID: <64a55b338b2f6_399dfee127678415128@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 028734fc by Simon Peyton Jones at 2023-07-05T12:47:48+01:00 Better documentation - - - - - b02c67b7 by Simon Peyton Jones at 2023-07-05T12:48:09+01:00 Improve pretty printing of InstCo - - - - - 99d011f8 by Simon Peyton Jones at 2023-07-05T12:48:44+01:00 More improvements * Make opt_co4 (SelCo cs Refl) work properly. It wasn't! * Deal well with (ax ty ; sym (ax ty)). Bizarrely that didn't work. I just put the ax/sym-ax rule first. * Make (mkInstCo Refl ty) work. Bizarrely it didn't! - - - - - 6 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Iface/Type.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkSelCo, getNthFun, getNthFromType, mkLRCo, + mkSelCo, mkSelCoResRole, getNthFun, getNthFromType, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo, mkNakedFunCo, @@ -556,20 +556,28 @@ splitFunCo_maybe (FunCo { fco_arg = arg, fco_res = res }) = Just (arg, res) splitFunCo_maybe _ = Nothing splitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, Coercion, Coercion) -splitForAllCo_maybe (ForAllCo tv k_co co) = Just (tv, k_co, co) -splitForAllCo_maybe _ = Nothing +splitForAllCo_maybe (ForAllCo tv k_co co) + = Just (tv, k_co, co) +splitForAllCo_maybe co + | Just (ty, r) <- isReflCo_maybe co + , Just (tcv, body_ty) <- splitForAllTyCoVar_maybe ty + = Just (tcv, mkNomReflCo (varType tcv), mkReflCo r body_ty) +splitForAllCo_maybe _ + = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder splitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion) -splitForAllCo_ty_maybe (ForAllCo tv k_co co) - | isTyVar tv = Just (tv, k_co, co) -splitForAllCo_ty_maybe _ = Nothing +splitForAllCo_ty_maybe co + | Just stuff@(tv,_,_) <- splitForAllCo_maybe co + , isTyVar tv = Just stuff + | otherwise = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for covar binder splitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion) -splitForAllCo_co_maybe (ForAllCo cv k_co co) - | isCoVar cv = Just (cv, k_co, co) -splitForAllCo_co_maybe _ = Nothing +splitForAllCo_co_maybe co + | Just stuff@(cv,_,_) <- splitForAllCo_maybe co + , isCoVar cv = Just stuff + | otherwise = Nothing ------------------------------------------------------- -- and some coercion kind stuff @@ -1166,13 +1174,7 @@ mkSelCo_maybe cs co go cs co | Just (ty, r) <- isReflCo_maybe co - = Just (mkReflCo (mk_res_role r cs) (getNthFromType cs ty)) - where - -- The result role is not just the role of co! - -- c.f. the SelCo case of coercionRole - mk_res_role _ SelForAll = Nominal - mk_res_role _ (SelTyCon _ r') = r' - mk_res_role r (SelFun fs) = funRole r fs + = Just (mkReflCo (mkSelCoResRole cs r) (getNthFromType cs ty)) go SelForAll (ForAllCo _ kind_co _) = Just kind_co @@ -1223,6 +1225,14 @@ mkSelCo_maybe cs co good_call _ = False +mkSelCoResRole :: CoSel -> Role -> Role +-- What is the role of (SelCo cs co), if co has role 'r'? +-- It is not just 'r'! +-- c.f. the SelCo case of coercionRole +mkSelCoResRole SelForAll _ = Nominal +mkSelCoResRole (SelTyCon _ r') _ = r' +mkSelCoResRole (SelFun fs) r = funRole r fs + -- | Extract the nth field of a FunCo getNthFun :: FunSel -> a -- ^ multiplicity @@ -1241,11 +1251,14 @@ mkLRCo lr co = LRCo lr co -- | Instantiates a 'Coercion'. +-- Works for both tyvar and covar mkInstCo :: Coercion -> CoercionN -> Coercion -mkInstCo (ForAllCo tcv _kind_co body_co) co - | Just (arg, _) <- isReflCo_maybe co - -- works for both tyvar and covar - = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co +mkInstCo co_fun co_arg + | Just (tcv, kind_co, body_co) <- splitForAllCo_maybe co_fun + , Just (arg, _) <- isReflCo_maybe co_arg + = assertPpr (isReflexiveCo kind_co) (ppr co_fun $$ ppr co_arg) $ + -- If the arg is Refl, then kind_co must be reflexive too + substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co mkInstCo co arg = InstCo co arg -- | Given @ty :: k1@, @co :: k1 ~ k2@, ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Core.Unify import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Types.Unique.Set +-- import GHC.Types.Unique.Set import GHC.Data.Pair import GHC.Data.List.SetOps ( getNth ) @@ -136,42 +136,48 @@ optCoercion opts env co {- = pprTrace "optCoercion {" (text "Co:" <> ppr (coercionSize co)) $ let result = optCoercion' env co in - pprTrace "optCoercion }" (vcat [ text "Co:" <+> ppr (coercionSize co) - , text "Optco:" <+> ppr (coercionSize result) ]) $ + pprTrace "optCoercion }" + (vcat [ text "Co:" <+> ppr (coercionSize co) + , text "Optco:" <+> ppWhen (isReflCo result) (text "(refl)") + <+> ppr (coercionSize result) ]) $ result -} | otherwise = substCo env co - optCoercion' :: Subst -> Coercion -> NormalCo optCoercion' env co | debugIsOn = let out_co = opt_co1 lc False co (Pair in_ty1 in_ty2, in_role) = coercionKindRole co (Pair out_ty1 out_ty2, out_role) = coercionKindRole out_co + + details = vcat [ text "in_co:" <+> ppr co + , text "in_ty1:" <+> ppr in_ty1 + , text "in_ty2:" <+> ppr in_ty2 + , text "out_co:" <+> ppr out_co + , text "out_ty1:" <+> ppr out_ty1 + , text "out_ty2:" <+> ppr out_ty2 + , text "in_role:" <+> ppr in_role + , text "out_role:" <+> ppr out_role +-- , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co +-- , text "subst:" <+> ppr env + ] in + warnPprTrace (not (isReflCo out_co) && isReflexiveCo out_co) + "optCoercion: reflexive but not refl" details $ assertPpr (substTyUnchecked env in_ty1 `eqType` out_ty1 && substTyUnchecked env in_ty2 `eqType` out_ty2 && in_role == out_role) - (hang (text "optCoercion changed types!") - 2 (vcat [ text "in_co:" <+> ppr co - , text "in_ty1:" <+> ppr in_ty1 - , text "in_ty2:" <+> ppr in_ty2 - , text "out_co:" <+> ppr out_co - , text "out_ty1:" <+> ppr out_ty1 - , text "out_ty2:" <+> ppr out_ty2 - , text "in_role:" <+> ppr in_role - , text "out_role:" <+> ppr out_role - , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co - , text "subst:" <+> ppr env ])) - out_co - - | otherwise = opt_co1 lc False co + (hang (text "optCoercion changed types!") 2 details) $ + out_co + + | otherwise + = opt_co1 lc False co where lc = mkSubstLiftingContext env - ppr_one cv = ppr cv <+> dcolon <+> ppr (coVarKind cv) +-- ppr_one cv = ppr cv <+> dcolon <+> ppr (coVarKind cv) type NormalCo = Coercion @@ -394,11 +400,17 @@ opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo _ eta _)) -- works for both tyvar and covar = opt_co4_wrap env sym rep Nominal eta -opt_co4 env sym rep r (SelCo n co) - | Just nth_co <- case (co', n) of - (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n) - (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) - (ForAllCo _ eta _, SelForAll) -> Just eta +-- So the /input/ coercion isn't ForAllCo or Refl; +-- instead look at the /output/ coercion +opt_co4 env sym rep r (SelCo cs co) + | Just (ty, co_role) <- isReflCo_maybe co' + = mkReflCo (chooseRole rep (mkSelCoResRole cs co_role)) + (getNthFromType cs ty) + + | Just nth_co <- case (co', cs) of + (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n) + (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) + (ForAllCo _ eta _, SelForAll) -> Just eta _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo @@ -406,7 +418,7 @@ opt_co4 env sym rep r (SelCo n co) else nth_co | otherwise - = wrapRole rep r $ SelCo n co' + = wrapRole rep r $ SelCo cs co' where co' = opt_co1 env sym co @@ -601,7 +613,6 @@ opt_univ env sym prov role oty1 oty2 (env', tv1', eta') = optForAllCoBndr env sym tv1 eta in mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2') - | Just (cv1, ty1) <- splitForAllCoVar_maybe oty1 , Just (cv2, ty2) <- splitForAllCoVar_maybe oty2 -- NB: prov isn't interesting here either @@ -835,6 +846,32 @@ opt_trans_rule is co1 co2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 + -- TrPushAxSym/TrPushSymAx + -- Put this first! Otherwise we get + -- newtype N a = MkN a + -- axN :: forall a. N a ~ a + -- Now consider (axN ty ; sym (axN ty)) + -- If we put TrPushSymAxR first, we'll get + -- (axN ty ; sym (axN ty)) :: N ty ~ N ty -- Obviously Refl + -- --> axN (sym (axN ty)) :: N ty ~ N ty -- Very stupid + | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe + , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe + , con1 == con2 + , ind1 == ind2 + , sym1 == not sym2 + , let branch = coAxiomNthBranch con1 ind1 + qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch + lhs = coAxNthLHS con1 ind1 + rhs = coAxBranchRHS branch + pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs) + , all (`elemVarSet` pivot_tvs) qtvs + = fireTransRule "TrPushAxSym" co1 co2 $ + if sym2 + -- TrPushAxSym + then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs + -- TrPushSymAx + else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs + -- See Note [Push transitivity inside axioms] and -- Note [Push transitivity inside newtype axioms only] -- TrPushSymAxR @@ -869,24 +906,6 @@ opt_trans_rule is co1 co2 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) = fireTransRule "TrPushAxL" co1 co2 newAxInst - -- TrPushAxSym/TrPushSymAx - | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe - , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe - , con1 == con2 - , ind1 == ind2 - , sym1 == not sym2 - , let branch = coAxiomNthBranch con1 ind1 - qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch - lhs = coAxNthLHS con1 ind1 - rhs = coAxBranchRHS branch - pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs) - , all (`elemVarSet` pivot_tvs) qtvs - = fireTransRule "TrPushAxSym" co1 co2 $ - if sym2 - -- TrPushAxSym - then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs - -- TrPushSymAx - else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs where co1_is_axiom_maybe = isAxiom_maybe co1 co2_is_axiom_maybe = isAxiom_maybe co2 ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -23,7 +23,7 @@ module GHC.Core.Opt.Simplify.Env ( getInScope, setInScopeFromE, setInScopeFromF, setInScopeSet, modifyInScope, addNewInScopeIds, getSimplRules, enterRecGroupRHSs, - bumpCallDepth, reSimplifying, + reSimplifying, -- * Substitution results SimplSR(..), mkContEx, substId, lookupRecBndr, @@ -156,6 +156,17 @@ following table: | Set by user | SimplMode | TopEnvConfig | | Computed on initialization | SimplEnv | SimplTopEnv | +Note [Inline depth] +~~~~~~~~~~~~~~~~~~~ +When we inline an /already-simplified/ unfolding, we +* Zap the substitution environment; the inlined thing is an OutExpr +* Bump the seInlineDepth in the SimplEnv +Both these tasks are done in zapSubstEnv. + +The seInlineDepth tells us how deep in inlining we are. Currently, +seInlineDepth is used for just one purpose: when we encounter a +coercion we don't apply optCoercion to it if seInlineDepth>0. +Reason: it has already been optimised once, no point in doing so again. -} data SimplEnv @@ -185,9 +196,11 @@ data SimplEnv -- They are all OutVars, and all bound in this module , seInScope :: !InScopeSet -- OutVars only - , seCaseDepth :: !Int -- Depth of multi-branch case alternatives - , seCallDepth :: !Int -- 0 initially, 1 when we inline an already-simplified - -- unfolding, and simplify again; and so on + , seCaseDepth :: !Int -- Depth of multi-branch case alternatives + + , seInlineDepth :: !Int -- 0 initially, 1 when we inline an already-simplified + -- unfolding, and simplify again; and so on + -- See Note [Inline depth] } seArityOpts :: SimplEnv -> ArityOpts @@ -495,15 +508,15 @@ points we're substituting. -} mkSimplEnv :: SimplMode -> (FamInstEnv, FamInstEnv) -> SimplEnv mkSimplEnv mode fam_envs - = SimplEnv { seMode = mode - , seFamEnvs = fam_envs - , seInScope = init_in_scope - , seTvSubst = emptyVarEnv - , seCvSubst = emptyVarEnv - , seIdSubst = emptyVarEnv - , seRecIds = emptyUnVarSet - , seCaseDepth = 0 - , seCallDepth = 0 } + = SimplEnv { seMode = mode + , seFamEnvs = fam_envs + , seInScope = init_in_scope + , seTvSubst = emptyVarEnv + , seCvSubst = emptyVarEnv + , seIdSubst = emptyVarEnv + , seRecIds = emptyUnVarSet + , seCaseDepth = 0 + , seInlineDepth = 0 } -- The top level "enclosing CC" is "SUBSUMED". init_in_scope :: InScopeSet @@ -539,11 +552,8 @@ updMode upd env bumpCaseDepth :: SimplEnv -> SimplEnv bumpCaseDepth env = env { seCaseDepth = seCaseDepth env + 1 } -bumpCallDepth :: SimplEnv -> SimplEnv -bumpCallDepth env = env { seCallDepth = seCallDepth env + 1 } - reSimplifying :: SimplEnv -> Bool -reSimplifying (SimplEnv { seCallDepth = n }) = n>0 +reSimplifying (SimplEnv { seInlineDepth = n }) = n>0 --------------------- extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv @@ -630,9 +640,12 @@ setInScopeFromE. --------------------- zapSubstEnv :: SimplEnv -> SimplEnv -zapSubstEnv env@(SimplEnv { seCallDepth = n }) +-- See Note [Inline depth] +-- We call zapSubstEnv precisely when we are about to +-- simplify an already-simplified term +zapSubstEnv env@(SimplEnv { seInlineDepth = n }) = env { seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv - , seCallDepth = n+1 } + , seInlineDepth = n+1 } setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids } ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -423,8 +423,7 @@ simplAuxBind _str env bndr new_rhs -- have no NOLINE pragmas, nor RULEs | exprIsTrivial new_rhs -- Short-cut for let x = y in ... || case (idOccInfo bndr) of - OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> -- pprTrace ("simplAuxBind:"++_str) (ppr bndr <+> equals <+> ppr new_rhs) $ - True + OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> True _ -> False = return ( emptyFloats env , case new_rhs of @@ -1334,13 +1333,16 @@ simplCoercionF env co cont simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co - = do { let opt_co | reSimplifying env - = substCo env co - | otherwise - = optCoercion opts (getSubst env) co + = do { let opt_co | reSimplifying env = substCo env co + | otherwise = optCoercion opts subst co + -- If (reSimplifying env) is True we have already + -- simplified this coercion once, and we don't + -- want do so again; doing so repeatedly risks + -- non-linear behaviour ; seqCo opt_co `seq` return opt_co } where - opts = seOptCoercionOpts env + subst = getSubst env + opts = seOptCoercionOpts env ----------------------------------- -- | Push a TickIt context outwards past applications and cases, as @@ -1639,10 +1641,8 @@ simplCast env body co0 cont0 addCoerce :: OutCoercion -> Bool -> SimplCont -> SimplM SimplCont addCoerce co1 _ (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity] - | isReflCo co' = return cont - | otherwise = addCoerce co' False cont - where -- False: co' is not fully optimised - co' = mkTransCo co1 co2 + = addCoerce (mkTransCo co1 co2) False cont + -- False: (mkTransCo co1 co2) is not fully optimised addCoerce co opt (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty @@ -1661,6 +1661,9 @@ simplCast env body co0 cont0 addCoerce co opt cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup, sc_cont = tail , sc_hole_ty = fun_ty }) + | not opt -- pushCoValArg duplicates the coercion, so optimise first + = addCoerce (optOutCoercion env co opt) True cont + | Just (m_co1, m_co2) <- pushCoValArg co , fixed_rep m_co1 = {-#SCC "addCoerce-pushCoValArg" #-} @@ -1685,10 +1688,10 @@ simplCast env body co0 cont0 , sc_hole_ty = coercionLKind co }) } } } addCoerce co opt cont - | isReflexiveCo co = return cont -- Having this at the end makes a huge - -- difference in T12227, for some reason - -- See Note [Optimising reflexivity] - | otherwise = return (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }) + | isReflCo co = return cont -- Having this at the end makes a huge + -- difference in T12227, for some reason + -- See Note [Optimising reflexivity] + | otherwise = return (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }) fixed_rep :: MCoercionR -> Bool fixed_rep MRefl = True @@ -3901,6 +3904,7 @@ mkDupableAlt env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) -- See Note [Duplicated env] ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool +-- See Note [Duplicating alternatives] ok_to_dup_alt case_bndr alt_bndrs alt_rhs | (Var v, args) <- collectArgs alt_rhs , all exprIsTrivial args @@ -3913,6 +3917,27 @@ ok_to_dup_alt case_bndr alt_bndrs alt_rhs bndr_set = mkVarSet (case_bndr : alt_bndrs) {- +Note [Duplicating alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When should we duplicate an alternative, and when should we make a join point? +We don't want to make a join point if it will /definitely/ be inlined; that +takes extra work to build, and an extra Simplifier iteration to do the inlining. +So consider + + case (case x of True -> e2; False -> e2) of + K1 a b -> f b a + K2 x -> g x v + K3 v -> Just v + +The (f b a) would turn into a join point like + $j1 a b = f b a +which would immediately inline again because the call is not smaller than the RHS. +On the other hand, the (g x v) turns into + $j2 x = g x v +which won't imediately inline. Finally the (Just v) would turn into + $j3 v = Just v +and you might think that would immediately inline. + Note [Fusing case continuations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important to fuse two successive case continuations when the ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -152,7 +152,7 @@ data Type -- for example unsaturated type synonyms -- can appear as the right hand side of a type synonym. - | ForAllTy + | ForAllTy -- See Note [Weird typing rule for ForAllTy] {-# UNPACK #-} !ForAllTyBinder Type -- ^ A Π type. -- Note [When we quantify over a coercion variable] @@ -1173,11 +1173,11 @@ because the kinds of the bound tyvars can be different. The typing rule is: - kind_co : k1 ~ k2 - tv1:k1 |- co : t1 ~ t2 + kind_co : k1 ~N k2 + tv1:k1 |- co : t1 ~r t2 ------------------------------------------------------------------- - ForAllCo tv1 kind_co co : all tv1:k1. t1 ~ - all tv1:k2. (t2[tv1 |-> tv1 |> sym kind_co]) + ForAllCo tv1 kind_co co : all tv1:k1. t1 ~r + all tv1:k2. (t2[tv1 := (tv1 |> sym kind_co)]) First, the TyCoVar stored in a ForAllCo is really an optimisation: this field should be a Name, as its kind is redundant. Thinking of the field as a Name ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1875,8 +1875,8 @@ ppr_co _ (IfaceUnivCo prov role ty1 ty2) ppr_co ctxt_prec (IfaceInstCo co ty) = maybeParen ctxt_prec appPrec $ - text "Inst" <+> pprParendIfaceCoercion co - <+> pprParendIfaceCoercion ty + text "Inst" <+> sep [ pprParendIfaceCoercion co + , pprParendIfaceCoercion ty ] ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos) = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8efcee737e8dfb7287a5ef9cdca0590a80b70750...99d011f850d8d5bc408e2e7abfb955554f869738 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8efcee737e8dfb7287a5ef9cdca0590a80b70750...99d011f850d8d5bc408e2e7abfb955554f869738 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 12:47:59 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 05 Jul 2023 08:47:59 -0400 Subject: [Git][ghc/ghc][wip/T23576] Remove whitespace and add temporary quottish cases Message-ID: <64a5667ed169d_399dfead1c44266b6@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: b23d95b8 by Jaro Reinders at 2023-07-05T14:47:51+02:00 Remove whitespace and add temporary quottish cases - - - - - 3 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/StgToCmm/Prim.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -637,7 +637,7 @@ iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do Reg64 rohi rolo <- getNewReg64 let ocode = code `appOL` - toOL [ MOV II32 (OpReg rlo) (OpReg rolo), + toOL [ MOV II32 (OpReg rlo) (OpReg rolo), XOR II32 (OpReg rohi) (OpReg rohi), NEGI II32 (OpReg rolo), SBB II32 (OpReg rhi) (OpReg rohi) ] @@ -1857,7 +1857,7 @@ condIntCode' platform cond x y MOV II32 (OpReg r2hi) (OpReg tmp), SBB II32 (OpReg r1hi) (OpReg tmp) ] - + return (CondCode False cond code) -- memory vs immediate ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -734,7 +734,7 @@ pprInstr platform i = case i of SHR format src dst -> pprShift (text "shr") format src dst - + SHLD format src dst1 dst2 -> pprShift2 (text "shld") format src dst1 dst2 ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1684,6 +1684,33 @@ emitPrimOp cfg primop = isQuottishOp MO_I64_Rem = True isQuottishOp MO_W64_Quot = True isQuottishOp MO_W64_Rem = True + + isQuottishOp MO_I64_ToI = True + isQuottishOp MO_I64_FromI = True + isQuottishOp MO_W64_ToW = True + isQuottishOp MO_W64_FromW = True + + isQuottishOp MO_x64_Eq = True + isQuottishOp MO_x64_Ne = True + isQuottishOp MO_I64_Ge = True + isQuottishOp MO_I64_Gt = True + isQuottishOp MO_I64_Le = True + isQuottishOp MO_I64_Lt = True + isQuottishOp MO_W64_Ge = True + isQuottishOp MO_W64_Gt = True + isQuottishOp MO_W64_Le = True + isQuottishOp MO_W64_Lt = True + + isQuottishOp MO_UF_Conv{} = True + + isQuottishOp MO_x64_And = True + isQuottishOp MO_x64_Or = True + isQuottishOp MO_x64_Xor = True + isQuottishOp MO_x64_Not = True + isQuottishOp MO_x64_Shl = True + isQuottishOp MO_I64_Shr = True + isQuottishOp MO_W64_Shr = True + isQuottishOp _ = False opTranslate64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b23d95b8b3f56fa70b9715ae2b16ee2d6a2e95db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b23d95b8b3f56fa70b9715ae2b16ee2d6a2e95db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 13:26:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 05 Jul 2023 09:26:42 -0400 Subject: [Git][ghc/ghc][ghc-9.8] 5 commits: Bump deepseq bound to allow 1.5 Message-ID: <64a56f92437b0_399dfead1ec4325aa@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: afbdcbb7 by Ben Gamari at 2023-07-01T17:47:10-04:00 Bump deepseq bound to allow 1.5 - - - - - b66c4692 by Ben Gamari at 2023-07-05T09:26:15-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 692afb12 by Ben Gamari at 2023-07-05T09:26:32-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - d93c1d86 by Ben Gamari at 2023-07-05T09:26:32-04:00 template-haskell: Bump version to 2.21.0.0 - - - - - d2224ad0 by Ben Gamari at 2023-07-05T09:26:32-04:00 template-haskell - - - - - 30 changed files: - compiler/ghc.cabal.in - configure.ac - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/array - libraries/base/base.cabal - libraries/containers - libraries/deepseq - libraries/directory - libraries/exceptions - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/ghc-compact.cabal - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/hpc - libraries/parsec - libraries/process - libraries/semaphore-compat - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/text - libraries/unix - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout - testsuite/tests/gadt/T19847a.stderr - utils/haddock - utils/hpc - utils/hsc2hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18658545ce45254a4679c13de5dcc56a4c8373f...d2224ad00d71de83ba75ac6d6a82487cf4ba9061 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18658545ce45254a4679c13de5dcc56a4c8373f...d2224ad00d71de83ba75ac6d6a82487cf4ba9061 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 14:13:43 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Wed, 05 Jul 2023 10:13:43 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] 70 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64a57a9767ac6_399dfead200443865@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 98d4c480 by David Knothe at 2023-07-05T16:13:28+02:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24e374e658acbb80d6b4c70f3efb9f3cdb6ea269...98d4c4802da922ff86f1ee7aee5ae773a44ecba2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24e374e658acbb80d6b4c70f3efb9f3cdb6ea269...98d4c4802da922ff86f1ee7aee5ae773a44ecba2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 14:34:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 05 Jul 2023 10:34:54 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 348 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <64a57f8e3d2b3_399dfead1d845867c@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 4766752c by Ben Gamari at 2023-07-05T10:34:44-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - dba0ba8e by Ben Gamari at 2023-07-05T10:34:44-04:00 compiler: Record original thunk info tables on stack - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a02756b537b75acba0942381789850662ed6eab3...dba0ba8e487086e31f4bfab2f1eb6576c3e9859a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a02756b537b75acba0942381789850662ed6eab3...dba0ba8e487086e31f4bfab2f1eb6576c3e9859a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 14:55:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 05 Jul 2023 10:55:40 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: FixeWs Message-ID: <64a5846c66f9a_399dfead1b04723af@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 72264bb6 by Rodrigo Mesquita at 2023-07-05T15:13:15+01:00 FixeWs Fixes2 - - - - - 465d92b1 by Rodrigo Mesquita at 2023-07-05T15:55:24+01:00 Try to add locally-executable arg - - - - - 13 changed files: - TODO - default.target.in - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/Cabal.hs - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== TODO ===================================== @@ -1,2 +1,6 @@ +Things that might get done on this or another MR +[ ] Guarantee flags passed to configure are eventually passed to ghc-toolchain (like CFLAGS=...) explicitly specified +[ ] Drop SettingsXXXX altogether, now we just have the toolchain (well, this goes with deleting a good part of configure) +[ ] Readelf is only used to find cc link, that OK? [ ] In hadrian/src/Rules/Generate.hs, generateGhcPlatformH, factor out the query into an argument to chooseSetting, to deduplicate it [ ] Get rid of all the ToolchainSettings in Hadrian still (e.g. settings-clang-command) ===================================== default.target.in ===================================== @@ -1,6 +1,7 @@ Target -{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} -, tgtVendor = @HostVendor_CPPMaybeStr@ +{ tgtArchOs = ArchOS {archOS_arch = @HaskellTargetArch@, archOS_OS = @HaskellTargetOs@} +, tgtVendor = @TargetVendor_CPPMaybeStr@ +, tgtLocallyExecutable = Just @NotCrossCompilingBool@ , tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ , tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ , tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ @@ -11,9 +12,9 @@ Target , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ -, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} -, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} -, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @SettingsCPPFlagsList@}} +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @CFLAGSList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @CXXFLAGSList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @CPPFLAGSList@}} , tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@SettingsHaskellCPPCommand@", prgFlags = @SettingsHaskellCPPFlagsList@}} , tgtCCompilerLink = CcLink { ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} @@ -34,6 +35,6 @@ Target , tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@SettingsRanlibCommand@", prgFlags = []}}) , tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} , tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}, mergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFilesBool@}) -, tgtDllwrap = @SettingsDllWrapCommandMaybeProg@ -, tgtWindres = @SettingsWindresCommandMaybeProg@ +, tgtDllwrap = @DllWrapCmdMaybeProg@ +, tgtWindres = @WindresCmdMaybeProg@ } ===================================== hadrian/src/Builder.hs ===================================== @@ -28,7 +28,7 @@ import Hadrian.Builder.Tar import Hadrian.Oracles.Path import Hadrian.Oracles.TextFile import Hadrian.Utilities -import Oracles.Setting (bashPath) +import Oracles.Setting (bashPath,targetStage) import System.Exit import System.IO (stderr) @@ -423,11 +423,9 @@ isOptional target = \case systemBuilderPath :: Builder -> Action FilePath systemBuilderPath builder = case builder of Alex -> fromKey "alex" - Ar _ (Stage0 {})-> fromHostTC "system-ar" (Toolchain.arMkArchive . tgtAr) - Ar _ _ -> fromTargetTC "ar" (Toolchain.arMkArchive . tgtAr) + Ar _ stage -> fromStageTC stage "ar" (Toolchain.arMkArchive . tgtAr) Autoreconf _ -> stripExe =<< fromKey "autoreconf" - Cc _ (Stage0 {}) -> fromHostTC "system-cc" (Toolchain.ccProgram . tgtCCompiler) - Cc _ _ -> fromTargetTC "cc" (Toolchain.ccProgram . tgtCCompiler) + Cc _ stage -> fromStageTC stage "cc" (Toolchain.ccProgram . tgtCCompiler) -- We can't ask configure for the path to configure! Configure _ -> return "configure" Ghc _ (Stage0 {}) -> fromKey "system-ghc" @@ -443,8 +441,7 @@ systemBuilderPath builder = case builder of -- parameters. E.g. building a cross-compiler on and for x86_64 -- which will target ppc64 means that MergeObjects Stage0 will use -- x86_64 linker and MergeObject _ will use ppc64 linker. - MergeObjects (Stage0 {}) -> fromHostTC "system-merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs) - MergeObjects _ -> fromTargetTC "merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs) + MergeObjects st -> fromStageTC st "merge-objects" (maybeProg Toolchain.mergeObjsProgram . tgtMergeObjs) Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromTargetTC "nm" (Toolchain.nmProgram . tgtNm) @@ -469,9 +466,9 @@ systemBuilderPath builder = case builder of path <- unpack <$> lookupValue configFile key validate key path - -- Get program from the host's target configuration - fromHostTC keyname key = do - path <- queryHostTarget (prgPath . key) + -- Get program from a certain stage's target configuration + fromStageTC stage keyname key = do + path <- prgPath . key <$> targetStage stage validate keyname path -- Get program from the target's target configuration ===================================== hadrian/src/Context.hs ===================================== @@ -20,7 +20,6 @@ import Hadrian.Expression import Hadrian.Haskell.Cabal import Oracles.Setting import GHC.Toolchain.Target (Target(..)) -import Hadrian.Oracles.TextFile import GHC.Platform.ArchOS -- | Most targets are built only one way, hence the notion of 'vanillaContext'. @@ -65,12 +64,9 @@ libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib")) -- conventions (see 'cabalOsString' and 'cabalArchString'). distDir :: Stage -> Action FilePath distDir st = do - let queryStageTarget = case st of - Stage0 {} -> queryBuildTarget - _ -> queryHostTarget version <- ghcVersionStage st - hostOs <- cabalOsString <$> queryStageTarget (stringEncodeOS . archOS_OS . tgtArchOs) - hostArch <- cabalArchString <$> queryStageTarget (stringEncodeArch . archOS_arch . tgtArchOs) + hostOs <- cabalOsString . stringEncodeOS . archOS_OS . tgtArchOs <$> targetStage st + hostArch <- cabalArchString . stringEncodeArch . archOS_arch . tgtArchOs <$> targetStage st return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version pkgFileName :: Context -> Package -> String -> String -> Action FilePath ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -82,6 +82,8 @@ data Setting = CursesIncludeDir -- This used to be defined by 'FP_SETTINGS' in aclocal.m4. -- -- TODO: We should be able to drop this completely, after moving all the toolchain settings to ghc-toolchain +-- +-- TODO: For the next person, move to ghc-toolchain and to the Target files generated by configure and ghc-toolchain data ToolchainSetting = ToolchainSetting_OtoolCommand | ToolchainSetting_InstallNameToolCommand @@ -259,10 +261,11 @@ libsuf st way return (suffix ++ "-ghc" ++ version ++ extension) targetStage :: Stage -> Action Target --- ROMES:TODO: First iteration, only make it work for BUILD=HOST=TARGET --- What are the correct targets here? +-- TODO: We currently only support cross-compiling a stage1 compiler, +-- but the cross compiler should really be stage2 (#19174) +-- When we get there, we'll need to change the definition here. targetStage (Stage0 {}) = getBuildTarget targetStage (Stage1 {}) = getHostTarget -targetStage (Stage2 {}) = getHostTarget +targetStage (Stage2 {}) = getTargetTarget targetStage (Stage3 {}) = getTargetTarget ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -204,6 +204,7 @@ configureArgs cFlags' ldFlags' = do , conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir , conf "--with-gmp-libraries" $ arg =<< getSetting GmpLibDir , conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir + -- ROMES:TODO: how is the Host set to TargetPlatformFull? That would be the target , conf "--host" $ arg =<< getSetting TargetPlatformFull , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage , notStage0 ? arg "--ghc-option=-ghcversion-file=rts/include/ghcversion.h" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -17,6 +17,15 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], fi ]) +AC_DEFUN([ENABLE_GHC_TOOLCHAIN_NOT_ARG], +[ + if test "$2" = "NO"; then + echo "--enable-$1" >> acargs + elif test "$2" = "YES"; then + echo "--disable-$1" >> acargs + fi +]) + AC_DEFUN([INVOKE_GHC_TOOLCHAIN], [ ( @@ -78,14 +87,18 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--output=default.ghc-toolchain.target" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs echo "--cc=$CC" >> acargs - echo "--readelf=$READELF" >> acargs + echo "--cxx=$CXX" >> acargs echo "--cpp=$CPPCmd" >> acargs echo "--hs-cpp=$HaskellCPPCmd" >> acargs echo "--cc-link=$CC" >> acargs - echo "--cxx=$CXX" >> acargs echo "--ar=$AR" >> acargs echo "--ranlib=$RANLIB" >> acargs echo "--nm=$NM" >> acargs + echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs + echo "--readelf=$READELF" >> acargs + echo "--windres=$WindresCmd" >> acargs + echo "--dllwrap=$DllWrapCmd" >> acargs + ENABLE_GHC_TOOLCHAIN_NOT_ARG([locally-executable], [$CrossCompiling]) ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ===================================== m4/prep_target_file.m4 ===================================== @@ -7,14 +7,11 @@ # # $1 = optional value AC_DEFUN([PREP_MAYBE_SIMPLE_PROGRAM],[ - case "$$1" in - /bin/false) + if test -z "$$1"; then $1MaybeProg=Nothing - ;; - *) + else $1MaybeProg="Just (Program {prgPath = \"$$1\", prgFlags = @<:@@:>@})" - ;; - esac + fi AC_SUBST([$1MaybeProg]) ]) @@ -55,6 +52,26 @@ AC_DEFUN([PREP_BOOLEAN],[ AC_SUBST([$1Bool]) ]) +# PREP_NOT_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [Not$1Bool] when $1 has NO/YES value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_NOT_BOOLEAN],[ + case "$$1" in + NO) + Not$1Bool=True + ;; + YES) + Not$1Bool=False + ;; + *) + AC_MSG_ERROR([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([Not$1Bool]) +]) + # PREP_LIST # ============ # @@ -106,16 +123,17 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_BOOLEAN([UseLibffiForAdjustors]) PREP_BOOLEAN([ArIsGNUAr]) PREP_BOOLEAN([ArNeedsRanLib]) + PREP_NOT_BOOLEAN([CrossCompiling]) PREP_LIST([SettingsMergeObjectsFlags]) PREP_LIST([ArArgs]) PREP_LIST([SettingsCCompilerLinkFlags]) PREP_LIST([SettingsHaskellCPPFlags]) - PREP_LIST([SettingsCPPFlags]) - PREP_LIST([SettingsCxxCompilerFlags]) - PREP_LIST([SettingsCCompilerFlags]) - PREP_MAYBE_SIMPLE_PROGRAM([SettingsDllWrapCommand]) - PREP_MAYBE_SIMPLE_PROGRAM([SettingsWindresCommand]) - PREP_MAYBE_STRING([HostVendor_CPP]) + PREP_LIST([CPPFLAGS]) + PREP_LIST([CXXFLAGS]) + PREP_LIST([CFLAGS]) + PREP_MAYBE_SIMPLE_PROGRAM([DllWrapCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) + PREP_MAYBE_STRING([TargetVendor_CPP]) dnl PREP_ENDIANNESS case "$TargetWordBigEndian" in ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Toolchain.Tools.Readelf data Opts = Opts { optTriple :: String , optTargetPrefix :: Maybe String + , optLocallyExecutable :: Maybe Bool , optLlvmTriple :: Maybe String , optOutput :: String , optCc :: ProgOpt @@ -59,6 +60,7 @@ emptyOpts :: Opts emptyOpts = Opts { optTriple = "" , optTargetPrefix = Nothing + , optLocallyExecutable = Nothing , optLlvmTriple = Nothing , optOutput = "" , optCc = po0 @@ -111,16 +113,11 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x}) _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) -_optUnregisterised :: Lens Opts (Maybe Bool) +_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool) +_optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x}) _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) - -_optTablesNextToCode :: Lens Opts (Maybe Bool) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) - -_optUseLibFFIForAdjustors :: Lens Opts (Maybe Bool) _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) - -_optLdOvveride :: Lens Opts (Maybe Bool) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) _optVerbosity :: Lens Opts Int @@ -143,6 +140,7 @@ options = , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode , enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride + , enableDisable "locally-executable" "A target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -191,6 +189,7 @@ options = targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX") "A target prefix which will be added to all tool names when searching for toolchain components" + verbosityOpt = Option ['v'] ["verbose"] (OptArg f "N") "set output verbosity" where f mb = set _optVerbosity (parseVerbosity mb) @@ -219,6 +218,7 @@ main = do Just prefix -> Just prefix Nothing -> Just $ optTriple opts ++ "-" , keepTemp = optKeepTemp opts + , canLocallyExecute = fromMaybe True (optLocallyExecutable opts) , logContexts = [] } r <- runM env (run opts) @@ -251,16 +251,18 @@ registerisedSupported archOs = ArchARM _ _ _ -> True ArchAArch64 -> True ArchRISCV64 -> True + ArchWasm32 -> True + ArchJavaScript -> True _ -> False determineUnregisterised :: ArchOS -> Maybe Bool -> M Bool determineUnregisterised archOs userReq = case userReq of - Just False + Just False -- user requested registerised build | not regSupported -> throwE "GHC doesn't support registerised compilation on this architecture" | otherwise -> return False Just True -> return True - Nothing + Nothing -- user wasn't explicit, do registerised if we support it | regSupported -> return False | otherwise -> return True where @@ -370,6 +372,7 @@ mkTarget opts = do let t = Target { tgtArchOs = archOs , tgtVendor + , tgtLocallyExecutable = fromMaybe True (optLocallyExecutable opts) , tgtCCompiler = cc , tgtCxxCompiler = cxx , tgtCPreprocessor = cpp ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -39,6 +39,7 @@ import System.IO hiding (readFile, writeFile, appendFile) data Env = Env { verbosity :: Int , targetPrefix :: Maybe String , keepTemp :: Bool + , canLocallyExecute :: Bool , logContexts :: [String] } @@ -53,7 +54,7 @@ getEnv :: M Env getEnv = M $ lift Reader.ask makeM :: IO (Either [Error] a) -> M a -makeM io = M (Except.ExceptT (Reader.ReaderT (\env -> io))) +makeM io = M (Except.ExceptT (Reader.ReaderT (\_env -> io))) data Error = Error { errorMessage :: String , errorLogContexts :: [String] @@ -116,8 +117,13 @@ appendFile path s = liftIO $ Prelude.appendFile path s createFile :: FilePath -> M () createFile path = writeFile path "" +-- | Branch on whether we're cross-compiling, that is, if the Target we're +-- producing differs from the platform we're producing it on. ifCrossCompiling :: M a -- ^ what to do when cross-compiling -> M a -- ^ what to do otherwise -> M a -ifCrossCompiling cross other = other -- TODO +ifCrossCompiling cross other = do + canExec <- canLocallyExecute <$> getEnv + if not canExec then cross -- can't execute, this is a cross target + else other -- can execute, run the other action ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -42,7 +42,7 @@ data Target = Target { -- Platform tgtArchOs :: ArchOS , tgtVendor :: Maybe String - -- , tgtHostCanExecute :: Bool -- TODO: Rename hostCanExecute? We might need this to determine whether or not we can execute a program when configuring it + , tgtLocallyExecutable :: Bool , tgtSupportsGnuNonexecStack :: Bool , tgtSupportsSubsectionsViaSymbols :: Bool , tgtSupportsIdentDirective :: Bool @@ -79,6 +79,7 @@ instance Show Target where [ "Target" , "{ tgtArchOs = " ++ show tgtArchOs , ", tgtVendor = " ++ show tgtVendor + , ", tgtLocallyExecutable = " ++ show tgtLocallyExecutable , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -141,37 +141,36 @@ compileAsm = compile "S" ["-c"] _ccProgram addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc addPlatformDepCcFlags archOs cc0 = do let cc1 = addWorkaroundFor7799 archOs cc0 - cc2 <- addOSMinGW32CcFlags archOs cc1 -- As per FPTOOLS_SET_C_LD_FLAGS case archOs of ArchOS ArchX86 OSMinGW32 -> - return $ cc2 & _ccFlags %++ "-march=i686" + return $ cc1 & _ccFlags %++ "-march=i686" ArchOS ArchX86 OSFreeBSD -> - return $ cc2 & _ccFlags %++ "-march=i686" + return $ cc1 & _ccFlags %++ "-march=i686" ArchOS ArchX86_64 OSSolaris2 -> -- Solaris is a multi-lib platform, providing both 32- and 64-bit -- user-land. It appears to default to 32-bit builds but we of course want to -- compile for 64-bits on x86-64. - return $ cc2 & _ccFlags %++ "-m64" + return $ cc1 & _ccFlags %++ "-m64" ArchOS ArchAlpha _ -> -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. - return $ cc2 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"]) + return $ cc1 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"]) -- ArchOS ArchHPPA? _ -> ArchOS ArchARM{} OSFreeBSD -> -- On arm/freebsd, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ cc2 & _ccFlags %++ "-marm" + return $ cc1 & _ccFlags %++ "-marm" ArchOS ArchARM{} OSLinux -> -- On arm/linux and arm/android, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ cc2 & _ccFlags %++ "-marm" + return $ cc1 & _ccFlags %++ "-marm" ArchOS ArchPPC OSAIX -> -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. - return $ cc2 & _ccFlags %++ "-D_THREAD_SAFE" + return $ cc1 & _ccFlags %++ "-D_THREAD_SAFE" _ -> - return cc2 + return cc1 -- | Workaround for #7799 @@ -180,18 +179,3 @@ addWorkaroundFor7799 archOs cc | ArchX86 <- archOS_arch archOs = cc & _ccFlags %++ "-U__i686" | otherwise = cc --- | Adds flags specific to mingw32 -addOSMinGW32CcFlags :: ArchOS -> Cc -> M Cc -addOSMinGW32CcFlags archOs cc - | ArchOS _ OSMinGW32 <- archOs = do - checkFStackCheck cc <|> throwE "Windows requires -fstack-check support yet the C compiler appears not to support it" - | otherwise = return cc - --- | Check that @cc@ supports @-fstack-check at . --- See Note [Windows stack allocations]. -checkFStackCheck :: Cc -> M Cc -checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works" $ do - let cc' = cc & _ccFlags %++ "-Wl,-fstack-checkzz" - compileC cc' (dir "test.o") "int main(int argc, char **argv) { return 0; }" - return cc' - ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -166,8 +166,11 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do compileC cc main_o "int f(int a); int main(int argc, char **argv) { return f(0); }" let out = dir "test" + err = "linker didn't produce any output" callProgram ccLink ["-o", out, test_o, main_o] - expectFileExists out "linker didn't produce any output" + expectFileExists out err + -- Linking in windows might produce an executable with an ".exe" extension + <|> expectFileExists (out <.> "exe") err checkLinkIsGnu :: Program -> M Bool checkLinkIsGnu ccLink = do @@ -244,6 +247,7 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program addPlatformDepLinkFlags archOs cc ccLink0 = do ccLink1 <- addNoAsNeeded archOs cc ccLink0 + ccLink2 <- addOSMinGW32CcFlags archOs cc ccLink1 -- As per FPTOOLS_SET_C_LD_FLAGS case archOs of -- ROMES:TODO: Consider dropping this alongside other configuration for solaris that was dropped @@ -254,32 +258,47 @@ addPlatformDepLinkFlags archOs cc ccLink0 = do -- -- On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris -- implementation, which rather uses the -64 flag. - return $ ccLink1 & _prgFlags %++ "-m64" + return $ ccLink2 & _prgFlags %++ "-m64" ArchOS ArchAlpha _ -> -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. - return $ ccLink1 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"]) + return $ ccLink2 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"]) -- ArchOS ArchHPPA? _ -> ArchOS ArchARM{} OSFreeBSD -> -- On arm/freebsd, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchARM{} OSLinux -> -- On arm/linux and arm/android, tell gcc to generate Arm -- instructions (ie not Thumb). - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchAArch64 OSFreeBSD -> - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchAArch64 OSLinux -> - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchAArch64 OSNetBSD -> - return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + return $ ccLink2 & _prgFlags %++ "-Wl,-z,noexecstack" ArchOS ArchPPC OSAIX -> -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. - return $ ccLink1 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) + return $ ccLink2 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) _ -> - return ccLink1 + return ccLink2 + +-- | Adds flags specific to mingw32 +addOSMinGW32CcFlags :: ArchOS -> Cc -> Program -> M Program +addOSMinGW32CcFlags archOs cc link + | ArchOS _ OSMinGW32 <- archOs = do + checkFStackCheck cc link <|> throwE "Windows requires -fstack-check support yet the C compiler linker appears not to support it" + | otherwise = return link + +-- | Check that @cc@ supports @-fstack-check at . +-- See Note [Windows stack allocations]. +checkFStackCheck :: Cc -> Program -> M Program +checkFStackCheck cc link = checking "that -fstack-check works" $ do + let link' = link & _prgFlags %++ "-fstack-check" + checkLinkWorks cc link' + return link' -- | See Note [ELF needed shared libs] addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87177664e31be26ec5dfb56790d792412d0a9168...465d92b1b0564d044d863b90eeeb0b5b99e1556a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87177664e31be26ec5dfb56790d792412d0a9168...465d92b1b0564d044d863b90eeeb0b5b99e1556a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 15:43:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 05 Jul 2023 11:43:05 -0400 Subject: [Git][ghc/ghc][master] Improve the situation with the stimes cycle Message-ID: <64a58f894164a_399dfead25049827f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 10 changed files: - libraries/base/Data/Semigroup/Internal.hs - − libraries/base/Data/Semigroup/Internal.hs-boot - libraries/base/GHC/Base.hs - libraries/base/GHC/Base.hs-boot → libraries/base/GHC/Enum.hs-boot - + libraries/base/GHC/Num.hs-boot - libraries/base/GHC/Real.hs-boot - libraries/base/changelog.md - + testsuite/tests/simplCore/should_compile/T23074.hs - + testsuite/tests/simplCore/should_compile/T23074.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== libraries/base/Data/Semigroup/Internal.hs ===================================== @@ -14,8 +14,7 @@ -- 'Semigroup' class some. -- -- This module exists mostly to simplify or workaround import-graph --- issues; there is also a .hs-boot file to allow "GHC.Base" and other --- modules to import method default implementations for 'stimes' +-- issues. -- -- @since 4.11.0.0 module Data.Semigroup.Internal where @@ -67,43 +66,12 @@ stimesMonoid n x0 = case compare n 0 of | y == 1 = x `mappend` z | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z) -- See Note [Half of y - 1] --- this is used by the class definition in GHC.Base; --- it lives here to avoid cycles -stimesDefault :: (Integral b, Semigroup a) => b -> a -> a -stimesDefault y0 x0 - | y0 <= 0 = errorWithoutStackTrace "stimes: positive multiplier expected" - | otherwise = f x0 y0 - where - f x y - | even y = f (x <> x) (y `quot` 2) - | y == 1 = x - | otherwise = g (x <> x) (y `quot` 2) x -- See Note [Half of y - 1] - g x y z - | even y = g (x <> x) (y `quot` 2) z - | y == 1 = x <> z - | otherwise = g (x <> x) (y `quot` 2) (x <> z) -- See Note [Half of y - 1] - {- Note [Half of y - 1] ~~~~~~~~~~~~~~~~~~~~~ Since y is guaranteed to be odd and positive here, half of y - 1 can be computed as y `quot` 2, optimising subtraction away. -} -stimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a -stimesMaybe _ Nothing = Nothing -stimesMaybe n (Just a) = case compare n 0 of - LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier" - EQ -> Nothing - GT -> Just (stimes n a) - -stimesList :: Integral b => b -> [a] -> [a] -stimesList n x - | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier" - | otherwise = rep n - where - rep 0 = [] - rep i = x ++ rep (i - 1) - -- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'. -- -- >>> getDual (mappend (Dual "Hello") (Dual "World")) ===================================== libraries/base/Data/Semigroup/Internal.hs-boot deleted ===================================== @@ -1,13 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} - -module Data.Semigroup.Internal where - -import {-# SOURCE #-} GHC.Real (Integral) -import {-# SOURCE #-} GHC.Base (Semigroup,Monoid,Maybe) -import GHC.Num.Integer () -- See Note [Depend on GHC.Num.Integer] in GHC.Base - -stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a - -stimesDefault :: (Integral b, Semigroup a) => b -> a -> a -stimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a -stimesList :: Integral b => b -> [a] -> [a] ===================================== libraries/base/GHC/Base.hs ===================================== @@ -127,13 +127,9 @@ import {-# SOURCE #-} GHC.IO (mkUserError, mplusIO) import GHC.Tuple (Solo (MkSolo)) -- Note [Depend on GHC.Tuple] import GHC.Num.Integer () -- Note [Depend on GHC.Num.Integer] --- for 'class Semigroup' -import {-# SOURCE #-} GHC.Real (Integral) -import {-# SOURCE #-} Data.Semigroup.Internal ( stimesDefault - , stimesMaybe - , stimesList - , stimesIdempotentMonoid - ) +-- See Note [Semigroup stimes cycle] +import {-# SOURCE #-} GHC.Num (Num (..)) +import {-# SOURCE #-} GHC.Real (Integral (..)) -- $setup -- >>> import GHC.Num @@ -181,6 +177,38 @@ GHC.Tuple, so we use the same rule as for Integer --- see Note [Depend on GHC.Num.Integer] --- to explain this to the build system. We make GHC.Base depend on GHC.Tuple, and everything else depends on GHC.Base or Prelude. + +Note [Semigroup stimes cycle] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Semigroup is defined in this module, GHC.Base, with the method +stimes :: (Semigroup a, Integral b) => b -> a -> a + +This presents a problem. +* We use Integral methods (quot, rem) and Num methods (-) in stimes definitions + in this module. Num is a superclass of Integral. +* Num is defined in GHC.Num, which imports GHC.Base. +* Enum is defined in GHC.Enum, which imports GHC.Base and GHC.Num. Enum is a + superclass of Integral. We don't use any Enum methods here, but it is relevant + (read on). +* Integral is defined in GHC.Real, which imports GHC.Base, GHC.Num, and + GHC.Enum. + +We resolve this web of dependencies with hs-boot files. The rules +https://ghc.gitlab.haskell.org/ghc/doc/users_guide/separate_compilation.html#how-to-compile-mutually-recursive-modules +require us to put either the full declarations or only the instance head for +classes in a hs-boot file. +So we put the full class decls for Num and Integral in Num.hs-boot and +Real.hs-boot respectively. This also forces us to have an Enum.hs-boot. + +An obvious alternative is to move the class decls for Num, Enum, Real, and +Integral here. We don't do that because we would then need to move all the +instances (for Int, Word, Integer, etc.) here as well, or leave those instances +as orphans, which is generally bad. + +We previously resolved this problem in a different way, with an hs-boot for +Semigroup.Internal that provided stimes implementations. This made them +impossible to inline or specialize when used in this module. We no longer have +that problem because we only import classes and not implementations. -} #if 0 @@ -282,10 +310,26 @@ class Semigroup a where -- >>> stimes 4 [1] -- [1,1,1,1] stimes :: Integral b => b -> a -> a - stimes = stimesDefault + stimes y0 x0 + | y0 <= 0 = errorWithoutStackTrace "stimes: positive multiplier expected" + | otherwise = f x0 y0 + where + f x y + | y `rem` 2 == 0 = f (x <> x) (y `quot` 2) + | y == 1 = x + | otherwise = g (x <> x) (y `quot` 2) x -- See Note [Half of y - 1] + g x y z + | y `rem` 2 == 0 = g (x <> x) (y `quot` 2) z + | y == 1 = x <> z + | otherwise = g (x <> x) (y `quot` 2) (x <> z) -- See Note [Half of y - 1] {-# MINIMAL (<>) | sconcat #-} +{- Note [Half of y - 1] + ~~~~~~~~~~~~~~~~~~~~~ + Since y is guaranteed to be odd and positive here, + half of y - 1 can be computed as y `quot` 2, optimising subtraction away. +-} -- | The class of monoids (types with an associative binary operation that -- has an identity). Instances should satisfy the following: @@ -351,7 +395,12 @@ instance Semigroup [a] where (<>) = (++) {-# INLINE (<>) #-} - stimes = stimesList + stimes n x + | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier" + | otherwise = rep n + where + rep 0 = [] + rep i = x ++ rep (i - 1) -- | @since 2.01 instance Monoid [a] where @@ -471,7 +520,10 @@ instance Semigroup Ordering where EQ <> y = y GT <> _ = GT - stimes = stimesIdempotentMonoid + stimes n x = case compare n 0 of + LT -> errorWithoutStackTrace "stimes: Ordering, negative multiplier" + EQ -> EQ + GT -> x -- lexicographical ordering -- | @since 2.01 @@ -484,7 +536,11 @@ instance Semigroup a => Semigroup (Maybe a) where a <> Nothing = a Just a <> Just b = Just (a <> b) - stimes = stimesMaybe + stimes _ Nothing = Nothing + stimes n (Just a) = case compare n 0 of + LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier" + EQ -> Nothing + GT -> Just (stimes n a) -- | Lift a semigroup into 'Maybe' forming a 'Monoid' according to -- : \"Any semigroup @S@ may be ===================================== libraries/base/GHC/Base.hs-boot → libraries/base/GHC/Enum.hs-boot ===================================== @@ -1,9 +1,10 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Base (Maybe, Semigroup, Monoid) where +module GHC.Enum (Enum) where + +-- For why this file exists +-- See Note [Semigroup stimes cycle] in GHC.Base -import GHC.Maybe (Maybe) import GHC.Types () -class Semigroup a -class Monoid a +class Enum a ===================================== libraries/base/GHC/Num.hs-boot ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GHC.Num (Num (..)) where + +-- For why this file exists +-- See Note [Semigroup stimes cycle] in GHC.Base + +import GHC.Num.Integer (Integer) +import GHC.Types () + +infixl 7 * +infixl 6 +, - + +class Num a where + {-# MINIMAL (+), (*), abs, signum, fromInteger, (negate | (-)) #-} + + (+), (-), (*) :: a -> a -> a + negate :: a -> a + abs :: a -> a + signum :: a -> a + fromInteger :: Integer -> a + + x - y = x + negate y + negate x = 0 - x ===================================== libraries/base/GHC/Real.hs-boot ===================================== @@ -1,7 +1,36 @@ {-# LANGUAGE NoImplicitPrelude #-} -module GHC.Real where +module GHC.Real (Integral (..)) where +-- For why this file exists +-- See Note [Semigroup stimes cycle] in GHC.Base + +import GHC.Classes (Ord) +import GHC.Num.Integer (Integer) import GHC.Types () -class Integral a +import {-# SOURCE #-} GHC.Num (Num) +import {-# SOURCE #-} GHC.Enum (Enum) + +data Ratio a +type Rational = Ratio Integer + +class (Num a, Ord a) => Real a where + toRational :: a -> Rational + +class (Real a, Enum a) => Integral a where + quot :: a -> a -> a + rem :: a -> a -> a + div :: a -> a -> a + mod :: a -> a -> a + quotRem :: a -> a -> (a,a) + divMod :: a -> a -> (a,a) + toInteger :: a -> Integer + + n `quot` d = q where (q,_) = quotRem n d + n `rem` d = r where (_,r) = quotRem n d + n `div` d = q where (q,_) = divMod n d + n `mod` d = r where (_,r) = divMod n d + + divMod n d = if signum r == negate (signum d) then (q-1, r+d) else qr + where qr@(q,r) = quotRem n d ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) + * Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== testsuite/tests/simplCore/should_compile/T23074.hs ===================================== @@ -0,0 +1,14 @@ +module T23074 where + +import Data.Semigroup + +-- Test that stimes for SumInt is specialized + +newtype SumInt = SumInt Int + +instance Semigroup SumInt where + SumInt x <> SumInt y = SumInt (x + y) + + +foo :: Int -> SumInt -> SumInt +foo = stimes ===================================== testsuite/tests/simplCore/should_compile/T23074.stderr ===================================== @@ -0,0 +1,8 @@ + +==================== Tidy Core rules ==================== +"SPEC $cstimes @Int" + forall ($dIntegral :: Integral Int). + $fSemigroupSumInt_$cstimes @Int $dIntegral + = foo + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -484,8 +484,8 @@ test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppres test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) test('T23426', normal, compile, ['-O']) - test('T23491a', [extra_files(['T23491.hs']), grep_errmsg(r'Float out')], multimod_compile, ['T23491', '-ffull-laziness -ddump-full-laziness']) test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], multimod_compile, ['T23491', '-ffloat-in -ddump-float-in']) test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], multimod_compile, ['T23491', '-fliberate-case -ddump-liberate-case']) test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) +test('T23074', normal, compile, ['-O -ddump-rules']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ce44336ce8344ea640fdb88e47b13fd4a249ddd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ce44336ce8344ea640fdb88e47b13fd4a249ddd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 15:43:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 05 Jul 2023 11:43:55 -0400 Subject: [Git][ghc/ghc][master] Refactor Unique to be represented by Word64 Message-ID: <64a58fbb96c0c_399dfead20050342c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 18 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9edcb1fb02d799acd4a7d0c145796aecb6e54ea3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9edcb1fb02d799acd4a7d0c145796aecb6e54ea3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 15:44:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 05 Jul 2023 11:44:36 -0400 Subject: [Git][ghc/ghc][master] Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro Message-ID: <64a58fe42a991_399dfead1b05070dd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -386,10 +386,13 @@ defined by your local GHC installation, the following trick is useful: ``__GLASGOW_HASKELL_FULL_VERSION__`` .. index:: single: __GLASGOW_HASKELL_FULL_VERSION__ + This macro exposes the full version string. For instance: ``__GLASGOW_HASKELL_FULL_VERSION__==8.11.0.20200319``. Its value comes from the ``ProjectVersion`` Autotools variable. + Added in GHC 9.0.1 + ``__GLASGOW_HASKELL_PATCHLEVEL1__``; \ ``__GLASGOW_HASKELL_PATCHLEVEL2__`` .. index:: single: __GLASGOW_HASKELL_PATCHLEVEL2__ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b9db7d43fa08bc6de45af728e7dc20735f7cc34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b9db7d43fa08bc6de45af728e7dc20735f7cc34 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 15:57:50 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 05 Jul 2023 11:57:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/unfolding-loop-patch Message-ID: <64a592feda941_399dfead250517456@gitlab.mail> Matthew Pickering pushed new branch wip/unfolding-loop-patch at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/unfolding-loop-patch You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 16:16:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 05 Jul 2023 12:16:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Improve the situation with the stimes cycle Message-ID: <64a5974b35a6f_399dfead2145255b7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - d5dae649 by Torsten Schmits at 2023-07-05T12:15:55-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 07f8af22 by sheaf at 2023-07-05T12:16:01-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 723a1d8f by Rodrigo Mesquita at 2023-07-05T12:16:02-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 20 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63d348f38cab68a80a9616f3c8f0953413a7bbbe...723a1d8f81cd2aa973508afd2fb8e1b04cde2f6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63d348f38cab68a80a9616f3c8f0953413a7bbbe...723a1d8f81cd2aa973508afd2fb8e1b04cde2f6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 16:32:44 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 05 Jul 2023 12:32:44 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fixes Message-ID: <64a59b2c97014_399dfead200535383@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 5e7bd939 by Jaro Reinders at 2023-07-05T18:32:35+02:00 Fixes - - - - - 2 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -591,7 +591,7 @@ iselExpr64 (CmmMachOp (MO_Sub _) [e1,e2]) = do SBB II32 (OpReg r2hi) (OpReg rhi) ] return (RegCode64 code rhi rlo) -iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do +iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do code <- getAnyReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code r_dst_lo `snocOL` @@ -865,13 +865,13 @@ getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W8) [x]) | is32Bit = do RegCode64 code _rhi rlo <- iselExpr64 x ro <- getNewRegNat II8 - return $ Fixed II8 ro (code `appOL` toOL [ MOV II8 (OpReg rlo) (OpReg ro) ]) + return $ Fixed II8 ro (code `appOL` toOL [ MOVZxL II8 (OpReg rlo) (OpReg ro) ]) getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W16) [x]) | is32Bit = do RegCode64 code _rhi rlo <- iselExpr64 x ro <- getNewRegNat II16 - return $ Fixed II16 ro (code `appOL` toOL [ MOV II16 (OpReg rlo) (OpReg ro) ]) + return $ Fixed II16 ro (code `appOL` toOL [ MOVZxL II16 (OpReg rlo) (OpReg ro) ]) getRegister' _ _ (CmmLit lit@(CmmFloat f w)) = float_const_sse2 where ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -572,10 +572,10 @@ patchRegsOfInstr instr env BSWAP fmt reg -> BSWAP fmt (env reg) NEGI fmt op -> patch1 (NEGI fmt) op SHL fmt imm dst -> patch1 (SHL fmt imm) dst - SAL fmt imm dst -> patch1 (SAR fmt imm) dst + SAL fmt imm dst -> patch1 (SAL fmt imm) dst SAR fmt imm dst -> patch1 (SAR fmt imm) dst SHR fmt imm dst -> patch1 (SHR fmt imm) dst - SHLD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2 + SHLD fmt imm dst1 dst2 -> patch2 (SHLD fmt imm) dst1 dst2 SHRD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2 BT fmt imm src -> patch1 (BT fmt imm) src TEST fmt src dst -> patch2 (TEST fmt) src dst View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e7bd939f0c709911b7176e47ee0a602999b4e5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e7bd939f0c709911b7176e47ee0a602999b4e5a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:22:19 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 05 Jul 2023 13:22:19 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-comb3] 33 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a5a6cbdd76e_399dfe2b77f968549234@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-comb3 at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 7ef0df43 by Alan Zimmerman at 2023-07-05T18:11:34+01:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9aacd650341205ac32ceafe77501ad99a78a12d8...7ef0df43a826586f4c0e10b7a4b5a08fae31cf4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9aacd650341205ac32ceafe77501ad99a78a12d8...7ef0df43a826586f4c0e10b7a4b5a08fae31cf4c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:32:12 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Wed, 05 Jul 2023 13:32:12 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] Update Match Datatype Message-ID: <64a5a91cddfc7_399dfead2005512ea@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: d987917b by David Knothe at 2023-07-05T19:31:46+02:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 6 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -203,11 +203,8 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss -- ==> case rhs of C x# y# -> body do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas - ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } - ; var <- selectMatchVar ManyTy upat + ; let eqn = EqnMatch { eqn_pat = pat, eqn_rest = EqnDone (cantFailMatchResult body) } + ; var <- selectMatchVar ManyTy (unLoc pat) -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -192,11 +191,7 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineEqnRhss (NEL.fromList eqns) match (v:vs) ty eqns -- Eqns *can* be empty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ @@ -279,7 +274,7 @@ matchBangs (var :| vars) ty eqns matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Apply the coercion to the match variable and then match that -matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) +matchCoercion (var :| vars) ty eqns@(eqn1 :| _) = do { let XPat (CoPat co pat _) = firstPat eqn1 ; let pat_ty' = hsPatType pat ; var' <- newUniqueId var (idMult var) pat_ty' @@ -291,7 +286,7 @@ matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Apply the view function to the match variable and then match that -matchView (var :| vars) ty (eqns@(eqn1 :| _)) +matchView (var :| vars) ty eqns@(eqn1 :| _) = do { -- we could pass in the expr from the PgView, -- but this needs to extract the pat anyway -- to figure out the type of the fresh variable @@ -309,8 +304,7 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _)) -- decompose the first pattern and leave the rest alone decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} +decomposeFirstPat extract eqn@(EqnMatch { eqn_pat = pat }) = eqn{eqn_pat = fmap extract pat} decomposeFirstPat _ _ = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc @@ -404,15 +398,14 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ eqn@(EqnDone {}) = return (idDsWrapper, eqn) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v eqn@(EqnMatch { eqn_pat = (L loc pat) }) = do + (wrap, pat') <- tidy1 v (isGeneratedSrcSpan (locA loc)) pat + return (wrap, eqn{eqn_pat = L loc pat' }) tidy1 :: Id -- The Id being scrutinised - -> Origin -- Was this a pattern the user wrote? + -> Bool -- `True` if the pattern was generated, `False` if it was user-written -> Pat GhcTc -- The pattern against which it is to be matched -> DsM (DsWrapper, -- Extra bindings to do before the match Pat GhcTc) -- Equivalent pattern @@ -423,10 +416,10 @@ tidy1 :: Id -- The Id being scrutinised -- It eliminates many pattern forms (as-patterns, variable patterns, -- list patterns, etc) and returns any created bindings in the wrapper. -tidy1 v o (ParPat _ _ pat _) = tidy1 v o (unLoc pat) -tidy1 v o (SigPat _ pat _) = tidy1 v o (unLoc pat) +tidy1 v g (ParPat _ _ pat _) = tidy1 v g (unLoc pat) +tidy1 v g (SigPat _ pat _) = tidy1 v g (unLoc pat) tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty) -tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p +tidy1 v g (BangPat _ (L l p)) = tidy_bang_pat v g l p -- case v of { x -> mr[] } -- = case v of { _ -> let x=v in mr[] } @@ -435,8 +428,8 @@ tidy1 v _ (VarPat _ (L _ var)) -- case v of { x at p -> mr[] } -- = case v of { p -> let x=v in mr[] } -tidy1 v o (AsPat _ (L _ var) _ pat) - = do { (wrap, pat') <- tidy1 v o (unLoc pat) +tidy1 v g (AsPat _ (L _ var) _ pat) + = do { (wrap, pat') <- tidy1 v g (unLoc pat) ; return (wrapBind var v . wrap, pat') } {- now, here we handle lazy patterns: @@ -488,22 +481,22 @@ tidy1 _ _ (SumPat tys pat alt arity) -- See Note [Unboxed tuple RuntimeRep vars] in TyCon -- LitPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (LitPat _ lit) - = do { unless (isGenerated o) $ +tidy1 _ g (LitPat _ lit) + = do { unless g $ warnAboutOverflowedLit lit ; return (idDsWrapper, tidyLitPat lit) } -- NPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) - = do { unless (isGenerated o) $ +tidy1 _ g (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) + = do { unless g $ let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v } | otherwise = lit in warnAboutOverflowedOverLit lit' ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) } -- NPlusKPat: we may want to warn about the literals -tidy1 _ o n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) - = do { unless (isGenerated o) $ do +tidy1 _ g n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) + = do { unless g $ do warnAboutOverflowedOverLit lit1 warnAboutOverflowedOverLit lit2 ; return (idDsWrapper, n) } @@ -513,28 +506,28 @@ tidy1 _ _ non_interesting_pat = return (idDsWrapper, non_interesting_pat) -------------------- -tidy_bang_pat :: Id -> Origin -> SrcSpanAnnA -> Pat GhcTc +tidy_bang_pat :: Id -> Bool -> SrcSpanAnnA -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc) -- Discard par/sig under a bang -tidy_bang_pat v o _ (ParPat _ _ (L l p) _) = tidy_bang_pat v o l p -tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p +tidy_bang_pat v g _ (ParPat _ _ (L l p) _) = tidy_bang_pat v g l p +tidy_bang_pat v g _ (SigPat _ (L l p) _) = tidy_bang_pat v g l p -- Push the bang-pattern inwards, in the hope that -- it may disappear next time -tidy_bang_pat v o l (AsPat x v' at p) - = tidy1 v o (AsPat x v' at (L l (BangPat noExtField p))) -tidy_bang_pat v o l (XPat (CoPat w p t)) - = tidy1 v o (XPat $ CoPat w (BangPat noExtField (L l p)) t) +tidy_bang_pat v g l (AsPat x v' at p) + = tidy1 v g (AsPat x v' at (L l (BangPat noExtField p))) +tidy_bang_pat v g l (XPat (CoPat w p t)) + = tidy1 v g (XPat $ CoPat w (BangPat noExtField (L l p)) t) -- Discard bang around strict pattern -tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(ListPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(TuplePat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p +tidy_bang_pat v g _ p@(LitPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(ListPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(TuplePat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(SumPat {}) = tidy1 v g p -- Data/newtype constructors -tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) +tidy_bang_pat v g l p@(ConPat { pat_con = L _ (RealDataCon dc) , pat_args = args , pat_con_ext = ConPatTc { cpt_arg_tys = arg_tys @@ -543,8 +536,8 @@ tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) -- Newtypes: push bang inwards (#9844) = if isNewTyCon (dataConTyCon dc) - then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) - else tidy1 v o p -- Data types: discard the bang + then tidy1 v g (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) + else tidy1 v g p -- Data types: discard the bang where (ty:_) = dataConInstArgTys dc arg_tys @@ -807,16 +800,14 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags - ; let upats = map (unLoc . decideBangHood dflags) pats + ; let upats = map (decideBangHood dflags) pats -- pat_nablas is the covered set *after* matching the pattern, but -- before any of the GRHSs. We extend the environment with pat_nablas -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats match_result } discard_warnings_if_generated orig = if isGenerated orig @@ -953,9 +944,8 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result addCoreScrutTmCs (maybeToList mb_scrut) [var] $ pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = match_result } + ; let eqn_info = EqnMatch { eqn_pat = decideBangHood dflags pat + , eqn_rest = EqnDone match_result } ; match [var] ty [eqn_info] } @@ -984,6 +974,13 @@ data PatGroup -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors @@ -1148,8 +1145,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2' -- the fixities have been straightened out by now, so it's safe -- to ignore them? - exp (OpApp _ l o ri) (OpApp _ l' o' ri') = - lexp l l' && lexp o o' && lexp ri ri' + exp (OpApp _ l g ri) (OpApp _ l' o' ri') = + lexp l l' && lexp g o' && lexp ri ri' exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n' exp (SectionL _ e1 e2) (SectionL _ e1' e2') = lexp e1 e1' && lexp e2 e2' @@ -1230,8 +1227,8 @@ patGroup :: Platform -> Pat GhcTc -> PatGroup patGroup _ (ConPat { pat_con = L _ con , pat_con_ext = ConPatTc { cpt_arg_tys = tys } }) - | RealDataCon dcon <- con = PgCon dcon - | PatSynCon psyn <- con = PgSyn psyn tys + | RealDataCon dcon <- con = PgCon dcon + | PatSynCon psyn <- con = PgSyn psyn tys patGroup _ (WildPat {}) = PgAny patGroup _ (BangPat {}) = PgBang patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -153,24 +153,21 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, EqnMatch { + eqn_pat = L _ (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind }}) + , eqn_rest = rest }) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , prependEqn (map (L (SrcSpanAnn EpAnnNotUsed generatedSrcSpan)) $ conArgPats val_arg_tys args) rest ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we @@ -208,6 +205,10 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ex_tvs = conLikeExTyCoVars con1 + prependEqn :: [LPat GhcTc] -> EquationInfo -> EquationInfo + prependEqn [] eqn = eqn + prependEqn (pat:pats) eqn = EqnMatch { eqn_pat = pat, eqn_rest = prependEqn pats eqn } + -- Choose the right arg_vars in the right order for this group -- Note [Record patterns] select_arg_vars :: [Id] -> NonEmpty (ConArgPats, EquationInfo) -> [Id] ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -625,10 +625,10 @@ matchLiterals (var :| vars) ty sub_groups } where match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let EqnMatch { eqn_pat = L _ (LitPat _ hs_lit) } = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -726,7 +726,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 (EqnMatch { eqn_pat = L _ (NPlusKPat _ (L _ n) _ _ _ _), eqn_rest = rest }) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -48,7 +48,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), mkEqnInfo, eqnMatchResult, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -91,7 +92,6 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) @@ -131,27 +131,35 @@ instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match data EquationInfo - = EqnInfo { eqn_pats :: [Pat GhcTc] - -- ^ The patterns for an equation - -- - -- NB: We have /already/ applied 'decideBangHood' to - -- these patterns. See Note [decideBangHood] in "GHC.HsToCore.Utils" - - , eqn_orig :: Origin - -- ^ Was this equation present in the user source? - -- - -- This helps us avoid warnings on patterns that GHC elaborated. - -- - -- For instance, the pattern @-1 :: Word@ gets desugared into - -- @W# -1## :: Word@, but we shouldn't warn about an overflowed - -- literal for /both/ of these cases. - - , eqn_rhs :: MatchResult CoreExpr - -- ^ What to do after match - } + = EqnMatch { eqn_pat :: LPat GhcTc + -- ^ The first pattern of the equation + -- + -- NB: The location info is used to determine whether the + -- pattern is generated or not. + -- This helps us avoid warnings on patterns that GHC elaborated. + -- + -- NB: We have /already/ applied 'decideBangHood' to this + -- pattern. See Note [decideBangHood] in "GHC.HsToCore.Utils" + + , eqn_rest :: EquationInfo } + -- ^ The rest of the equation after its first pattern + + -- The empty tail of an equation having no more patterns + | EqnDone (MatchResult CoreExpr) + -- ^ What to do after match + +mkEqnInfo :: [LPat GhcTc] -> MatchResult CoreExpr -> EquationInfo +mkEqnInfo [] rhs = EqnDone rhs +mkEqnInfo (pat:pats) rhs = EqnMatch { eqn_pat = pat, eqn_rest = mkEqnInfo pats rhs } + +eqnMatchResult :: EquationInfo -> MatchResult CoreExpr +eqnMatchResult (EqnDone rhs) = rhs +eqnMatchResult (EqnMatch { eqn_rest = eq }) = eqnMatchResult eq instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . allEqnPats where + allEqnPats (EqnDone {}) = [] + allEqnPats (EqnMatch { eqn_pat = pat, eqn_rest = eq }) = unLoc pat : allEqnPats eq type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, maybeFirstPat, shiftEqns, combineEqnRhss, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -87,7 +87,7 @@ import GHC.Tc.Types.Evidence import Control.Monad ( zipWithM ) import Data.List.NonEmpty (NonEmpty(..)) -import Data.Maybe (maybeToList) +import Data.Maybe (maybeToList, fromMaybe) import qualified Data.List.NonEmpty as NEL {- @@ -195,11 +195,18 @@ worthy of a type synonym and a few handy functions. -} firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat = fromMaybe (error "firstPat: no patterns") . maybeFirstPat + +maybeFirstPat :: EquationInfo -> Maybe (Pat GhcTc) +maybeFirstPat (EqnMatch { eqn_pat = pat }) = Just (unLoc pat) +maybeFirstPat (EqnDone {}) = Nothing shiftEqns :: Functor f => f EquationInfo -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap eqn_rest + +combineEqnRhss :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineEqnRhss eqns = return $ foldr1 combineMatchResults $ map eqnMatchResult (NEL.toList eqns) -- Functions on MatchResult CoreExprs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d987917b9c3ab1d751f80794da3b9258a543422b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d987917b9c3ab1d751f80794da3b9258a543422b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:34:00 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 05 Jul 2023 13:34:00 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-sll] 34 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a5a988a9cd7_399dfead2005519df@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-sll at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 7ef0df43 by Alan Zimmerman at 2023-07-05T18:11:34+01:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - 57d22fd5 by Alan Zimmerman at 2023-07-05T18:30:15+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f773ffc44dbb6b04ba51e63dba6fdf73941af4c8...57d22fd582386fa7a9a1a39a89d7108f1cb94ffa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f773ffc44dbb6b04ba51e63dba6fdf73941af4c8...57d22fd582386fa7a9a1a39a89d7108f1cb94ffa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:37:29 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 05 Jul 2023 13:37:29 -0400 Subject: [Git][ghc/ghc][wip/az/epa-annlist-decls] 35 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a5aa5965d7c_399dfe2b77f814552181@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-annlist-decls at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 7ef0df43 by Alan Zimmerman at 2023-07-05T18:11:34+01:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - 57d22fd5 by Alan Zimmerman at 2023-07-05T18:30:15+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 313c0865 by Alan Zimmerman at 2023-07-05T18:35:14+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21062c4da42098a8ee37bdd90008925c4749ddd0...313c0865390e2d900e3cd7f1b73f5227517f19fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/21062c4da42098a8ee37bdd90008925c4749ddd0...313c0865390e2d900e3cd7f1b73f5227517f19fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:40:35 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 05 Jul 2023 13:40:35 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 2 commits: EPA: Fix simple tests Message-ID: <64a5ab1321160_399dfead1d855276d@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 2c369aa6 by Alan Zimmerman at 2023-07-04T20:54:17+01:00 EPA: Fix simple tests - - - - - 90b2ee28 by Alan Zimmerman at 2023-07-04T23:31:36+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 14 changed files: - compiler/GHC/Parser.y - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/parser/should_compile/T20452.stderr - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/printer/Test20297.stdout - testsuite/tests/typecheck/should_compile/T15242.stderr - utils/check-exact/Transform.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -2415,7 +2415,7 @@ gadt_constrlist :: { Located ([AddEpAnn] ,[LConDecl GhcPs]) } -- Returned in order : 'where' '{' gadt_constrs '}' {% checkEmptyGADTs $ - L (comb2 $1 $3) + L (comb2 $1 $4) ([mj AnnWhere $1 ,moc $2 ,mcc $4] ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr ===================================== @@ -10,7 +10,7 @@ (AnnsModule [(AddEpAnn AnnModule (EpaSpan { T17544.hs:3:1-6 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:3:15-19 }))] - [] + [] (Just ((,) { T17544.hs:57:1 } @@ -99,7 +99,7 @@ []))) (ClassOpSig (EpAnn - (EpaSpan { T17544.hs:6:3-4 }) + (EpaSpan { T17544.hs:6:3-16 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:6:6-7 })) []) @@ -135,7 +135,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { T17544.hs:6:9 }) + (EpaSpan { T17544.hs:6:9-16 }) (NoEpAnns) (EpaComments [])) @@ -282,7 +282,7 @@ []))) (ClassOpSig (EpAnn - (EpaSpan { T17544.hs:10:3-4 }) + (EpaSpan { T17544.hs:10:3-16 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:10:6-7 })) []) @@ -318,7 +318,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { T17544.hs:10:9 }) + (EpaSpan { T17544.hs:10:9-16 }) (NoEpAnns) (EpaComments [])) @@ -463,7 +463,7 @@ []))) (ClassOpSig (EpAnn - (EpaSpan { T17544.hs:14:3-4 }) + (EpaSpan { T17544.hs:14:3-16 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:14:6-7 })) []) @@ -499,7 +499,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { T17544.hs:14:9 }) + (EpaSpan { T17544.hs:14:9-16 }) (NoEpAnns) (EpaComments [])) @@ -647,7 +647,7 @@ []))) (ClassOpSig (EpAnn - (EpaSpan { T17544.hs:18:3-4 }) + (EpaSpan { T17544.hs:18:3-16 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:18:6-7 })) []) @@ -683,7 +683,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { T17544.hs:18:9 }) + (EpaSpan { T17544.hs:18:9-16 }) (NoEpAnns) (EpaComments [])) @@ -747,7 +747,7 @@ []))) (ClassOpSig (EpAnn - (EpaSpan { T17544.hs:20:3-4 }) + (EpaSpan { T17544.hs:20:3-16 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:20:6-7 })) []) @@ -783,7 +783,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { T17544.hs:20:9 }) + (EpaSpan { T17544.hs:20:9-16 }) (NoEpAnns) (EpaComments [])) @@ -985,7 +985,7 @@ (ClsInstDecl ((,) (EpAnn - (EpaSpan { T17544.hs:23:1-8 }) + (EpaSpan { T17544.hs:(23,1)-(25,18) }) [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:23:1-8 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:23:17-21 }))] (EpaComments @@ -1359,7 +1359,7 @@ (ClsInstDecl ((,) (EpAnn - (EpaSpan { T17544.hs:29:1-8 }) + (EpaSpan { T17544.hs:(29,1)-(31,18) }) [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:29:1-8 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:29:17-21 }))] (EpaComments @@ -1733,7 +1733,7 @@ (ClsInstDecl ((,) (EpAnn - (EpaSpan { T17544.hs:35:1-8 }) + (EpaSpan { T17544.hs:(35,1)-(37,18) }) [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:35:1-8 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:35:17-21 }))] (EpaComments @@ -2107,7 +2107,7 @@ (ClsInstDecl ((,) (EpAnn - (EpaSpan { T17544.hs:41:1-8 }) + (EpaSpan { T17544.hs:(41,1)-(43,18) }) [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:41:1-8 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:41:17-21 }))] (EpaComments @@ -2481,7 +2481,7 @@ (ClsInstDecl ((,) (EpAnn - (EpaSpan { T17544.hs:47:1-8 }) + (EpaSpan { T17544.hs:(47,1)-(49,18) }) [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:47:1-8 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:47:17-21 }))] (EpaComments @@ -2855,7 +2855,7 @@ (ClsInstDecl ((,) (EpAnn - (EpaSpan { T17544.hs:53:1-8 }) + (EpaSpan { T17544.hs:(53,1)-(55,20) }) [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:53:1-8 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:53:18-22 }))] (EpaComments ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr ===================================== @@ -10,7 +10,7 @@ (AnnsModule [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 })) ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))] - [] + [] (Just ((,) { T17544_kw.hs:25:1 } @@ -247,7 +247,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { T17544_kw.hs:19:18 }) + (EpaSpan { T17544_kw.hs:19:18-19 }) (AnnParen (AnnParens) (EpaSpan { T17544_kw.hs:19:18 }) @@ -359,7 +359,7 @@ []))) (ClassOpSig (EpAnn - (EpaSpan { T17544_kw.hs:24:5-13 }) + (EpaSpan { T17544_kw.hs:24:5-18 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:24:15-16 })) []) ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -251,7 +251,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { DumpParsedAst.hs:11:10 }) + (EpaSpan { DumpParsedAst.hs:11:10-17 }) (AnnParen (AnnParens) (EpaSpan { DumpParsedAst.hs:11:10 }) @@ -365,7 +365,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { DumpParsedAst.hs:11:26 }) + (EpaSpan { DumpParsedAst.hs:11:26-36 }) (AnnParen (AnnParens) (EpaSpan { DumpParsedAst.hs:11:26 }) @@ -461,7 +461,7 @@ []))) (HsExplicitListTy (EpAnn - (EpaSpan { DumpParsedAst.hs:12:10 }) + (EpaSpan { DumpParsedAst.hs:12:10-12 }) [(AddEpAnn AnnSimpleQuote (EpaSpan { DumpParsedAst.hs:12:10 })) ,(AddEpAnn AnnOpenS (EpaSpan { DumpParsedAst.hs:12:11 })) ,(AddEpAnn AnnCloseS (EpaSpan { DumpParsedAst.hs:12:12 }))] @@ -539,7 +539,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { DumpParsedAst.hs:10:27 }) + (EpaSpan { DumpParsedAst.hs:10:27-29 }) (AnnParen (AnnParensSquare) (EpaSpan { DumpParsedAst.hs:10:27 }) @@ -751,7 +751,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { DumpParsedAst.hs:15:25 }) + (EpaSpan { DumpParsedAst.hs:15:25-29 }) (AnnParen (AnnParens) (EpaSpan { DumpParsedAst.hs:15:25 }) @@ -1155,7 +1155,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpParsedAst.hs:17:31 }) + (EpaSpan { DumpParsedAst.hs:17:31-39 }) (NoEpAnns) (EpaComments [])) @@ -1290,7 +1290,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpParsedAst.hs:20:20 }) + (EpaSpan { DumpParsedAst.hs:20:20-33 }) (NoEpAnns) (EpaComments [])) @@ -1331,7 +1331,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpParsedAst.hs:20:25 }) + (EpaSpan { DumpParsedAst.hs:20:25-33 }) (NoEpAnns) (EpaComments [])) @@ -1429,7 +1429,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { DumpParsedAst.hs:21:22 }) + (EpaSpan { DumpParsedAst.hs:21:22-37 }) (AnnParen (AnnParens) (EpaSpan { DumpParsedAst.hs:21:22 }) @@ -1445,7 +1445,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { DumpParsedAst.hs:21:23 }) + (EpaSpan { DumpParsedAst.hs:21:23-36 }) [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:21:25-26 }))] (EpaComments [])) @@ -1481,7 +1481,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpParsedAst.hs:21:28 }) + (EpaSpan { DumpParsedAst.hs:21:28-36 }) (NoEpAnns) (EpaComments [])) @@ -1551,7 +1551,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpParsedAst.hs:21:42-52 }) + (EpaSpan { DumpParsedAst.hs:21:42-60 }) (NoEpAnns) (EpaComments [])) @@ -1569,7 +1569,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { DumpParsedAst.hs:21:42 }) + (EpaSpan { DumpParsedAst.hs:21:42-52 }) (AnnParen (AnnParens) (EpaSpan { DumpParsedAst.hs:21:42 }) @@ -1585,7 +1585,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpParsedAst.hs:21:43 }) + (EpaSpan { DumpParsedAst.hs:21:43-51 }) (NoEpAnns) (EpaComments [])) @@ -1718,7 +1718,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { DumpParsedAst.hs:22:10 }) + (EpaSpan { DumpParsedAst.hs:22:10-34 }) (AnnParen (AnnParens) (EpaSpan { DumpParsedAst.hs:22:10 }) @@ -1736,7 +1736,7 @@ (NoExtField) (HsForAllInvis (EpAnn - (EpaSpan { DumpParsedAst.hs:22:11-16 }) + (EpaSpan { DumpParsedAst.hs:22:11-20 }) ((,) (AddEpAnn AnnForall (EpaSpan { DumpParsedAst.hs:22:11-16 })) (AddEpAnn AnnDot (EpaSpan { DumpParsedAst.hs:22:20 }))) @@ -1774,7 +1774,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpParsedAst.hs:22:22-25 }) + (EpaSpan { DumpParsedAst.hs:22:22-33 }) (NoEpAnns) (EpaComments [])) ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -502,7 +502,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:12:27 }) + (EpaSpan { DumpRenamedAst.hs:12:27-29 }) (AnnParen (AnnParensSquare) (EpaSpan { DumpRenamedAst.hs:12:27 }) @@ -598,7 +598,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:16:20 }) + (EpaSpan { DumpRenamedAst.hs:16:20-33 }) (NoEpAnns) (EpaComments [])) @@ -634,7 +634,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:16:25 }) + (EpaSpan { DumpRenamedAst.hs:16:25-33 }) (NoEpAnns) (EpaComments [])) @@ -724,7 +724,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { DumpRenamedAst.hs:19:23 }) + (EpaSpan { DumpRenamedAst.hs:19:23-36 }) [(AddEpAnn AnnDcolon (EpaSpan { DumpRenamedAst.hs:19:25-26 }))] (EpaComments [])) @@ -755,7 +755,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:19:28 }) + (EpaSpan { DumpRenamedAst.hs:19:28-36 }) (NoEpAnns) (EpaComments [])) @@ -815,7 +815,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:19:42-52 }) + (EpaSpan { DumpRenamedAst.hs:19:42-60 }) (NoEpAnns) (EpaComments [])) @@ -842,7 +842,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:19:43 }) + (EpaSpan { DumpRenamedAst.hs:19:43-51 }) (NoEpAnns) (EpaComments [])) @@ -998,7 +998,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:20:22-25 }) + (EpaSpan { DumpRenamedAst.hs:20:22-33 }) (NoEpAnns) (EpaComments [])) @@ -1644,7 +1644,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:24:31 }) + (EpaSpan { DumpRenamedAst.hs:24:31-39 }) (NoEpAnns) (EpaComments [])) @@ -1905,7 +1905,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:30:12 }) + (EpaSpan { DumpRenamedAst.hs:30:12-14 }) (AnnParen (AnnParensSquare) (EpaSpan { DumpRenamedAst.hs:30:12 }) @@ -1968,7 +1968,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { DumpRenamedAst.hs:31:10 }) + (EpaSpan { DumpRenamedAst.hs:31:10-12 }) (AnnParen (AnnParensSquare) (EpaSpan { DumpRenamedAst.hs:31:10 }) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -152,7 +152,7 @@ (NoExtField) (TypeSig (EpAnn - (EpaSpan { DumpSemis.hs:9:1-3 }) + (EpaSpan { DumpSemis.hs:9:1-12 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { DumpSemis.hs:9:5-6 })) []) @@ -221,7 +221,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { DumpSemis.hs:9:11 }) + (EpaSpan { DumpSemis.hs:9:11-12 }) (AnnParen (AnnParens) (EpaSpan { DumpSemis.hs:9:11 }) @@ -456,7 +456,7 @@ (NoExtField) (TypeSig (EpAnn - (EpaSpan { DumpSemis.hs:14:1-3 }) + (EpaSpan { DumpSemis.hs:14:1-12 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { DumpSemis.hs:14:5-6 })) []) @@ -525,7 +525,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { DumpSemis.hs:14:11 }) + (EpaSpan { DumpSemis.hs:14:11-12 }) (AnnParen (AnnParens) (EpaSpan { DumpSemis.hs:14:11 }) @@ -719,7 +719,7 @@ (NoExtField) (TypeSig (EpAnn - (EpaSpan { DumpSemis.hs:21:1-3 }) + (EpaSpan { DumpSemis.hs:21:1-12 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { DumpSemis.hs:21:5-6 })) []) @@ -788,7 +788,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { DumpSemis.hs:21:11 }) + (EpaSpan { DumpSemis.hs:21:11-12 }) (AnnParen (AnnParens) (EpaSpan { DumpSemis.hs:21:11 }) @@ -1357,7 +1357,7 @@ []))) (ClassOpSig (EpAnn - (EpaSpan { DumpSemis.hs:29:3-7 }) + (EpaSpan { DumpSemis.hs:29:3-23 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { DumpSemis.hs:29:9-10 })) []) @@ -1393,7 +1393,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpSemis.hs:29:12-16 }) + (EpaSpan { DumpSemis.hs:29:12-23 }) (NoEpAnns) (EpaComments [])) @@ -1464,7 +1464,7 @@ (NoExtField) (TypeSig (EpAnn - (EpaSpan { DumpSemis.hs:31:1 }) + (EpaSpan { DumpSemis.hs:31:1-30 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { DumpSemis.hs:31:3-4 })) []) @@ -1503,7 +1503,7 @@ (NoExtField) (L (SrcSpanAnn (EpAnn - (EpaSpan { DumpSemis.hs:31:6-20 }) + (EpaSpan { DumpSemis.hs:31:6-23 }) (AnnContext (Just ((,) @@ -1514,7 +1514,7 @@ [(EpaSpan { DumpSemis.hs:31:19 }) ,(EpaSpan { DumpSemis.hs:31:20 })]) (EpaComments - [])) { DumpSemis.hs:31:6-20 }) + [])) { DumpSemis.hs:31:6-23 }) [(L ((EpAnnS (EpaSpan { DumpSemis.hs:31:8-11 }) @@ -1635,7 +1635,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { DumpSemis.hs:31:25 }) + (EpaSpan { DumpSemis.hs:31:25-30 }) (NoEpAnns) (EpaComments [])) @@ -1694,7 +1694,12 @@ ((EpAnnS (EpaSpan { DumpSemis.hs:32:1-7 }) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:33:1 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:6 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:7 }))]) (EpaComments []))) (ValD @@ -1718,12 +1723,7 @@ ((EpAnnS (EpaSpan { DumpSemis.hs:32:1-7 }) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:33:1 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:6 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:7 }))]) + []) (EpaComments []))) (Match @@ -2124,7 +2124,8 @@ ((EpAnnS (EpaSpan { DumpSemis.hs:(36,1)-(44,4) }) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:45:1 }))]) (EpaComments []))) (ValD @@ -2148,8 +2149,7 @@ ((EpAnnS (EpaSpan { DumpSemis.hs:(36,1)-(44,4) }) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:45:1 }))]) + []) (EpaComments []))) (Match @@ -2268,7 +2268,7 @@ []))) (Match (EpAnn - (EpaSpan { DumpSemis.hs:39:6 }) + (EpaSpan { DumpSemis.hs:39:6-13 }) [] (EpaComments [])) @@ -2306,7 +2306,7 @@ [])) (GRHS (EpAnn - (EpaSpan { DumpSemis.hs:39:8-9 }) + (EpaSpan { DumpSemis.hs:39:8-13 }) (GrhsAnn (Nothing) (AddEpAnn AnnRarrow (EpaSpan { DumpSemis.hs:39:8-9 }))) @@ -2341,7 +2341,7 @@ []))) (Match (EpAnn - (EpaSpan { DumpSemis.hs:40:6 }) + (EpaSpan { DumpSemis.hs:40:6-13 }) [] (EpaComments [])) @@ -2379,7 +2379,7 @@ [])) (GRHS (EpAnn - (EpaSpan { DumpSemis.hs:40:8-9 }) + (EpaSpan { DumpSemis.hs:40:8-13 }) (GrhsAnn (Nothing) (AddEpAnn AnnRarrow (EpaSpan { DumpSemis.hs:40:8-9 }))) @@ -2416,7 +2416,7 @@ []))) (Match (EpAnn - (EpaSpan { DumpSemis.hs:41:6 }) + (EpaSpan { DumpSemis.hs:41:6-13 }) [] (EpaComments [])) @@ -2454,7 +2454,7 @@ [])) (GRHS (EpAnn - (EpaSpan { DumpSemis.hs:41:8-9 }) + (EpaSpan { DumpSemis.hs:41:8-13 }) (GrhsAnn (Nothing) (AddEpAnn AnnRarrow (EpaSpan { DumpSemis.hs:41:8-9 }))) @@ -2493,7 +2493,7 @@ []))) (Match (EpAnn - (EpaSpan { DumpSemis.hs:42:6 }) + (EpaSpan { DumpSemis.hs:42:6-13 }) [] (EpaComments [])) @@ -2531,7 +2531,7 @@ [])) (GRHS (EpAnn - (EpaSpan { DumpSemis.hs:42:8-9 }) + (EpaSpan { DumpSemis.hs:42:8-13 }) (GrhsAnn (Nothing) (AddEpAnn AnnRarrow (EpaSpan { DumpSemis.hs:42:8-9 }))) ===================================== testsuite/tests/parser/should_compile/KindSigs.stderr ===================================== @@ -147,7 +147,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:12:11-13 }) + (EpaSpan { KindSigs.hs:12:11-21 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:12:15-16 }))] (EpaComments [])) @@ -300,7 +300,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { KindSigs.hs:15:14 }) + (EpaSpan { KindSigs.hs:15:14-51 }) (AnnParen (AnnParens) (EpaSpan { KindSigs.hs:15:14 }) @@ -318,7 +318,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:15:16-18 }) + (EpaSpan { KindSigs.hs:15:16-26 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:15:20-21 }))] (EpaComments [])) @@ -401,7 +401,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:15:35-41 }) + (EpaSpan { KindSigs.hs:15:35-49 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:15:43-44 }))] (EpaComments [])) @@ -543,7 +543,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { KindSigs.hs:16:15-16 }) + (EpaSpan { KindSigs.hs:16:15-54 }) (AnnParen (AnnParensHash) (EpaSpan { KindSigs.hs:16:15-16 }) @@ -561,7 +561,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:16:18-20 }) + (EpaSpan { KindSigs.hs:16:18-28 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:16:22-23 }))] (EpaComments [])) @@ -644,7 +644,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:16:37-43 }) + (EpaSpan { KindSigs.hs:16:37-51 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:16:45-46 }))] (EpaComments [])) @@ -764,7 +764,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { KindSigs.hs:19:12 }) + (EpaSpan { KindSigs.hs:19:12-26 }) (AnnParen (AnnParensSquare) (EpaSpan { KindSigs.hs:19:12 }) @@ -780,7 +780,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:19:14-16 }) + (EpaSpan { KindSigs.hs:19:14-24 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:19:18-19 }))] (EpaComments [])) @@ -841,7 +841,7 @@ (NoExtField) (TypeSig (EpAnn - (EpaSpan { KindSigs.hs:22:1-3 }) + (EpaSpan { KindSigs.hs:22:1-44 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:22:5-6 })) []) @@ -878,7 +878,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { KindSigs.hs:22:8-20 }) + (EpaSpan { KindSigs.hs:22:8-44 }) (NoEpAnns) (EpaComments [])) @@ -896,7 +896,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { KindSigs.hs:22:8 }) + (EpaSpan { KindSigs.hs:22:8-20 }) (AnnParen (AnnParens) (EpaSpan { KindSigs.hs:22:8 }) @@ -912,7 +912,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:22:9-11 }) + (EpaSpan { KindSigs.hs:22:9-19 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:22:13-14 }))] (EpaComments [])) @@ -971,7 +971,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { KindSigs.hs:22:25-28 }) + (EpaSpan { KindSigs.hs:22:25-44 }) (NoEpAnns) (EpaComments [])) @@ -1012,7 +1012,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { KindSigs.hs:22:33 }) + (EpaSpan { KindSigs.hs:22:33-44 }) (AnnParen (AnnParens) (EpaSpan { KindSigs.hs:22:33 }) @@ -1028,7 +1028,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:22:34-35 }) + (EpaSpan { KindSigs.hs:22:34-43 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:22:37-38 }))] (EpaComments [])) @@ -1041,7 +1041,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { KindSigs.hs:22:34 }) + (EpaSpan { KindSigs.hs:22:34-35 }) (AnnParen (AnnParens) (EpaSpan { KindSigs.hs:22:34 }) @@ -1219,7 +1219,7 @@ []))) (HsExplicitListTy (EpAnn - (EpaSpan { KindSigs.hs:26:13 }) + (EpaSpan { KindSigs.hs:26:13-29 }) [(AddEpAnn AnnSimpleQuote (EpaSpan { KindSigs.hs:26:13 })) ,(AddEpAnn AnnOpenS (EpaSpan { KindSigs.hs:26:14 })) ,(AddEpAnn AnnCloseS (EpaSpan { KindSigs.hs:26:29 }))] @@ -1235,7 +1235,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:26:16-19 }) + (EpaSpan { KindSigs.hs:26:16-27 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:26:21-22 }))] (EpaComments [])) @@ -1323,7 +1323,7 @@ []))) (HsExplicitListTy (EpAnn - (EpaSpan { KindSigs.hs:27:14 }) + (EpaSpan { KindSigs.hs:27:14-45 }) [(AddEpAnn AnnOpenS (EpaSpan { KindSigs.hs:27:14 })) ,(AddEpAnn AnnCloseS (EpaSpan { KindSigs.hs:27:45 }))] (EpaComments @@ -1339,7 +1339,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:27:16-19 }) + (EpaSpan { KindSigs.hs:27:16-27 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:27:21-22 }))] (EpaComments [])) @@ -1398,7 +1398,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:27:30-34 }) + (EpaSpan { KindSigs.hs:27:30-42 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:27:36-37 }))] (EpaComments [])) @@ -1508,7 +1508,7 @@ []))) (HsExplicitTupleTy (EpAnn - (EpaSpan { KindSigs.hs:28:16 }) + (EpaSpan { KindSigs.hs:28:16-44 }) [(AddEpAnn AnnSimpleQuote (EpaSpan { KindSigs.hs:28:16 })) ,(AddEpAnn AnnOpenP (EpaSpan { KindSigs.hs:28:17 })) ,(AddEpAnn AnnCloseP (EpaSpan { KindSigs.hs:28:44 }))] @@ -1524,7 +1524,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:28:19-29 }) + (EpaSpan { KindSigs.hs:28:19-39 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:28:31-32 }))] (EpaComments [])) @@ -1537,7 +1537,7 @@ []))) (HsExplicitListTy (EpAnn - (EpaSpan { KindSigs.hs:28:19 }) + (EpaSpan { KindSigs.hs:28:19-29 }) [(AddEpAnn AnnOpenS (EpaSpan { KindSigs.hs:28:19 })) ,(AddEpAnn AnnCloseS (EpaSpan { KindSigs.hs:28:29 }))] (EpaComments @@ -1599,7 +1599,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { KindSigs.hs:28:34 }) + (EpaSpan { KindSigs.hs:28:34-39 }) (AnnParen (AnnParensSquare) (EpaSpan { KindSigs.hs:28:34 }) @@ -1690,7 +1690,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:31:21-23 }) + (EpaSpan { KindSigs.hs:31:21-31 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:31:25-26 }))] (EpaComments [])) @@ -1751,7 +1751,7 @@ (NoExtField) (TypeSig (EpAnn - (EpaSpan { KindSigs.hs:34:1-4 }) + (EpaSpan { KindSigs.hs:34:1-22 }) (AnnSig (AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:34:6-7 })) []) @@ -1788,7 +1788,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { KindSigs.hs:34:9 }) + (EpaSpan { KindSigs.hs:34:9-22 }) (AnnParen (AnnParens) (EpaSpan { KindSigs.hs:34:9 }) @@ -1804,7 +1804,7 @@ []))) (HsKindSig (EpAnn - (EpaSpan { KindSigs.hs:34:10-13 }) + (EpaSpan { KindSigs.hs:34:10-21 }) [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:34:15-16 }))] (EpaComments [])) @@ -1942,5 +1942,3 @@ {OccName: True}))))))] (EmptyLocalBinds (NoExtField)))))])))))])) - - ===================================== testsuite/tests/parser/should_compile/T14189.stderr ===================================== @@ -142,7 +142,7 @@ (RecCon (L (SrcSpanAnn (EpAnn - (EpaSpan { T14189.hs:6:31 }) + (EpaSpan { T14189.hs:6:31-42 }) (AnnList (Just (EpaSpan { T14189.hs:6:33-40 })) @@ -164,11 +164,12 @@ (ConDeclField (EpAnnNotUsed) [(L - (EpAnnS + ((EpAnnS (EpaSpan { T14189.hs:6:33 }) - (NoEpAnns) + (AnnListItem + []) (EpaComments - [])) + []))) (FieldOcc {Name: T14189.f} (L @@ -248,12 +249,14 @@ (EpaComments []))) (IEThingWith - (EpAnn - (EpaSpan { T14189.hs:3:3-8 }) - [(AddEpAnn AnnOpenP (EpaSpan { T14189.hs:3:10 })) - ,(AddEpAnn AnnCloseP (EpaSpan { T14189.hs:3:15 }))] - (EpaComments - [])) + ((,) + (Nothing) + (EpAnn + (EpaSpan { T14189.hs:3:3-8 }) + [(AddEpAnn AnnOpenP (EpaSpan { T14189.hs:3:10 })) + ,(AddEpAnn AnnCloseP (EpaSpan { T14189.hs:3:15 }))] + (EpaComments + []))) (L ((EpAnnS (EpaSpan { T14189.hs:3:3-8 }) ===================================== testsuite/tests/parser/should_compile/T15323.stderr ===================================== @@ -121,14 +121,14 @@ (HsNormalTok)) (L ((EpAnnS - (EpaSpan { T15323.hs:6:20-54 }) + (EpaSpan { T15323.hs:6:20-29 }) (AnnListItem []) (EpaComments []))) (HsOuterExplicit (EpAnn - (EpaSpan { T15323.hs:6:20-25 }) + (EpaSpan { T15323.hs:6:20-29 }) ((,) (AddEpAnn AnnForall (EpaSpan { T15323.hs:6:20-25 })) (AddEpAnn AnnDot (EpaSpan { T15323.hs:6:29 }))) @@ -160,7 +160,7 @@ (Just (L (SrcSpanAnn (EpAnn - (EpaSpan { T15323.hs:6:31-36 }) + (EpaSpan { T15323.hs:6:31-39 }) (AnnContext (Just ((,) @@ -169,7 +169,7 @@ [] []) (EpaComments - [])) { T15323.hs:6:31-36 }) + [])) { T15323.hs:6:31-39 }) [(L ((EpAnnS (EpaSpan { T15323.hs:6:31-36 }) @@ -179,7 +179,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { T15323.hs:6:31 }) + (EpaSpan { T15323.hs:6:31-36 }) (AnnParen (AnnParens) (EpaSpan { T15323.hs:6:31 }) ===================================== testsuite/tests/parser/should_compile/T20452.stderr ===================================== @@ -432,7 +432,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { T20452.hs:8:57 }) + (EpaSpan { T20452.hs:8:57-74 }) (AnnParen (AnnParensSquare) (EpaSpan { T20452.hs:8:57 }) @@ -448,7 +448,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { T20452.hs:8:58 }) + (EpaSpan { T20452.hs:8:58-73 }) (AnnParen (AnnParens) (EpaSpan { T20452.hs:8:58 }) @@ -688,7 +688,7 @@ []))) (HsListTy (EpAnn - (EpaSpan { T20452.hs:9:57 }) + (EpaSpan { T20452.hs:9:57-74 }) (AnnParen (AnnParensSquare) (EpaSpan { T20452.hs:9:57 }) @@ -704,7 +704,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { T20452.hs:9:58 }) + (EpaSpan { T20452.hs:9:58-73 }) (AnnParen (AnnParens) (EpaSpan { T20452.hs:9:58 }) ===================================== testsuite/tests/parser/should_compile/T20846.stderr ===================================== @@ -44,7 +44,7 @@ (NoExtField) (FixSig (EpAnn - (EpaSpan { T20846.hs:3:1-6 }) + (EpaSpan { T20846.hs:3:1-11 }) [(AddEpAnn AnnInfix (EpaSpan { T20846.hs:3:1-6 }))] (EpaComments [])) ===================================== testsuite/tests/printer/Test20297.stdout ===================================== @@ -93,13 +93,13 @@ []) [(L (EpAnnS - (EpaSpan { Test20297.hs:(5,5)-(7,7) }) + (EpaSpan { Test20297.hs:5:5-7 }) (NoEpAnns) (EpaComments [])) (GRHS (EpAnn - (EpaSpan { Test20297.hs:(5,5)-(7,7) }) + (EpaSpan { Test20297.hs:5:5-7 }) (GrhsAnn (Nothing) (AddEpAnn AnnEqual (EpaSpan { Test20297.hs:5:5 }))) @@ -205,13 +205,13 @@ []) [(L (EpAnnS - (EpaSpan { Test20297.hs:(9,5)-(11,26) }) + (EpaSpan { Test20297.hs:9:5-7 }) (NoEpAnns) (EpaComments [])) (GRHS (EpAnn - (EpaSpan { Test20297.hs:(9,5)-(11,26) }) + (EpaSpan { Test20297.hs:9:5-7 }) (GrhsAnn (Nothing) (AddEpAnn AnnEqual (EpaSpan { Test20297.hs:9:5 }))) @@ -484,13 +484,13 @@ []) [(L (EpAnnS - (EpaSpan { Test20297.ppr.hs:(4,3)-(5,7) }) + (EpaSpan { Test20297.ppr.hs:4:3-5 }) (NoEpAnns) (EpaComments [])) (GRHS (EpAnn - (EpaSpan { Test20297.ppr.hs:(4,3)-(5,7) }) + (EpaSpan { Test20297.ppr.hs:4:3-5 }) (GrhsAnn (Nothing) (AddEpAnn AnnEqual (EpaSpan { Test20297.ppr.hs:4:3 }))) @@ -586,13 +586,13 @@ []) [(L (EpAnnS - (EpaSpan { Test20297.ppr.hs:(7,3)-(9,24) }) + (EpaSpan { Test20297.ppr.hs:7:3-5 }) (NoEpAnns) (EpaComments [])) (GRHS (EpAnn - (EpaSpan { Test20297.ppr.hs:(7,3)-(9,24) }) + (EpaSpan { Test20297.ppr.hs:7:3-5 }) (GrhsAnn (Nothing) (AddEpAnn AnnEqual (EpaSpan { Test20297.ppr.hs:7:3 }))) ===================================== testsuite/tests/typecheck/should_compile/T15242.stderr ===================================== @@ -1,34 +1,17 @@ -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:5-41 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:6-40 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:7-39 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:8-35 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:9-34 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:10-33 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:11-29 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:12-25 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:13-21 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:14-20 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:5:5-17 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:5:6-16 }) -(HsPar -[]))) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:5:19-37 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:5:20-32 }) -(HsPar -(SrcSpanAnn (EpAnnNotUsed) { T15242.hs:5:21-31 }) -(HsPar -[]))) -(HsPar +(EpaSpan { T15242.hs:6:5-41 }) +(EpaSpan { T15242.hs:6:6-40 }) +(EpaSpan { T15242.hs:6:7-39 }) +(EpaSpan { T15242.hs:6:8-35 }) +(EpaSpan { T15242.hs:6:9-34 }) +(EpaSpan { T15242.hs:6:10-33 }) +(EpaSpan { T15242.hs:6:11-29 }) +(EpaSpan { T15242.hs:6:12-25 }) +(EpaSpan { T15242.hs:6:13-21 }) +(EpaSpan { T15242.hs:6:14-20 }) +(EpaSpan { T15242.hs:5:5-17 }) +(EpaSpan { T15242.hs:5:6-16 }) +[])) +(EpaSpan { T15242.hs:5:19-37 }) +(EpaSpan { T15242.hs:5:20-32 }) +(EpaSpan { T15242.hs:5:21-31 }) +[])) \ No newline at end of file ===================================== utils/check-exact/Transform.hs ===================================== @@ -585,7 +585,8 @@ balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds))) = do where simpleBreak (r,_) = r /= 0 an1 = l - anc1 = addCommentOrigDeltas $ s_comments an1 + -- anc1 = addCommentOrigDeltas $ s_comments an1 + anc1 = s_comments an1 cs1f = getFollowingComments anc1 (move',stay') = break simpleBreak (trailingCommentsDeltas (anchorFromLocatedA (L l ())) cs1f) move = map snd move' @@ -605,7 +606,8 @@ balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds))) = do -- --------------------------------- (EpAnn anc an lgc) = ag - lgc' = splitCommentsEnd (realSrcSpan "balanceCommentsMatch" $ locA lg) $ addCommentOrigDeltas lgc + -- lgc' = splitCommentsEnd (realSrcSpan "balanceCommentsMatch" $ locA lg) $ addCommentOrigDeltas lgc + lgc' = splitCommentsEnd (realSrcSpan "balanceCommentsMatch" $ locA lg) lgc ag' = if moved then EpAnn anc an lgc' else EpAnn anc an (lgc' <> (EpaCommentsBalanced [] move)) @@ -808,7 +810,8 @@ balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do (L lg (GRHS ga gs rhs):grs) -> (la'',reverse $ (L lg (GRHS ga' gs rhs)):grs,[(gac,(csp,csf))]) where an1 = la - anc1 = addCommentOrigDeltas $ s_comments an1 + -- anc1 = addCommentOrigDeltas $ s_comments an1 + anc1 = s_comments an1 (EpAnn anc an _) = ga :: EpAnn GrhsAnn (csp,csf) = case anc1 of EpaComments cs -> ([],cs) @@ -818,7 +821,8 @@ balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do stay = map snd stay' cs1 = EpaCommentsBalanced csp stay - gac = addCommentOrigDeltas $ epAnnComments ga + -- gac = addCommentOrigDeltas $ epAnnComments ga + gac = epAnnComments ga gfc = getFollowingComments gac gac' = setFollowingComments gac (sortEpaComments $ gfc ++ move) ga' = (EpAnn anc an gac') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d089deac3bba3e017285a002b6740b91c2bba1d1...90b2ee280996c4a37d9c570d0526d944aa0d2d4a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d089deac3bba3e017285a002b6740b91c2bba1d1...90b2ee280996c4a37d9c570d0526d944aa0d2d4a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:51:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 05 Jul 2023 13:51:41 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22012 Message-ID: <64a5adadb7c09_399dfead1ec5547c4@gitlab.mail> Ben Gamari pushed new branch wip/T22012 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22012 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:52:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 05 Jul 2023 13:52:26 -0400 Subject: [Git][ghc/ghc][wip/T22012] rts/RtsSymbols: Add AArch64 outline atomic operations Message-ID: <64a5adda8bdbe_399dfead200556734@gitlab.mail> Ben Gamari pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: c172be01 by Ben Gamari at 2023-07-05T13:52:20-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012. Generated via: ```python ops = [] ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.append(f'__aarch64_{op}{n}_{order}') for m in [1,2,4,8,16]: ops.append(f'__aarch64_cas{n}_{order}') print('\n'.join(f' SymE_NeedsProto({op}),' for op in sorted(ops))) ``` - - - - - 2 changed files: - + rts/AArch64Symbols.h - rts/RtsSymbols.c Changes: ===================================== rts/AArch64Symbols.h ===================================== @@ -0,0 +1,100 @@ + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_ldadd1_acq), + SymE_NeedsProto(__aarch64_ldadd1_acq_rel), + SymE_NeedsProto(__aarch64_ldadd1_rel), + SymE_NeedsProto(__aarch64_ldadd1_relax), + SymE_NeedsProto(__aarch64_ldadd2_acq), + SymE_NeedsProto(__aarch64_ldadd2_acq_rel), + SymE_NeedsProto(__aarch64_ldadd2_rel), + SymE_NeedsProto(__aarch64_ldadd2_relax), + SymE_NeedsProto(__aarch64_ldadd4_acq), + SymE_NeedsProto(__aarch64_ldadd4_acq_rel), + SymE_NeedsProto(__aarch64_ldadd4_rel), + SymE_NeedsProto(__aarch64_ldadd4_relax), + SymE_NeedsProto(__aarch64_ldadd8_acq), + SymE_NeedsProto(__aarch64_ldadd8_acq_rel), + SymE_NeedsProto(__aarch64_ldadd8_rel), + SymE_NeedsProto(__aarch64_ldadd8_relax), + SymE_NeedsProto(__aarch64_ldclr1_acq), + SymE_NeedsProto(__aarch64_ldclr1_acq_rel), + SymE_NeedsProto(__aarch64_ldclr1_rel), + SymE_NeedsProto(__aarch64_ldclr1_relax), + SymE_NeedsProto(__aarch64_ldclr2_acq), + SymE_NeedsProto(__aarch64_ldclr2_acq_rel), + SymE_NeedsProto(__aarch64_ldclr2_rel), + SymE_NeedsProto(__aarch64_ldclr2_relax), + SymE_NeedsProto(__aarch64_ldclr4_acq), + SymE_NeedsProto(__aarch64_ldclr4_acq_rel), + SymE_NeedsProto(__aarch64_ldclr4_rel), + SymE_NeedsProto(__aarch64_ldclr4_relax), + SymE_NeedsProto(__aarch64_ldclr8_acq), + SymE_NeedsProto(__aarch64_ldclr8_acq_rel), + SymE_NeedsProto(__aarch64_ldclr8_rel), + SymE_NeedsProto(__aarch64_ldclr8_relax), + SymE_NeedsProto(__aarch64_ldeor1_acq), + SymE_NeedsProto(__aarch64_ldeor1_acq_rel), + SymE_NeedsProto(__aarch64_ldeor1_rel), + SymE_NeedsProto(__aarch64_ldeor1_relax), + SymE_NeedsProto(__aarch64_ldeor2_acq), + SymE_NeedsProto(__aarch64_ldeor2_acq_rel), + SymE_NeedsProto(__aarch64_ldeor2_rel), + SymE_NeedsProto(__aarch64_ldeor2_relax), + SymE_NeedsProto(__aarch64_ldeor4_acq), + SymE_NeedsProto(__aarch64_ldeor4_acq_rel), + SymE_NeedsProto(__aarch64_ldeor4_rel), + SymE_NeedsProto(__aarch64_ldeor4_relax), + SymE_NeedsProto(__aarch64_ldeor8_acq), + SymE_NeedsProto(__aarch64_ldeor8_acq_rel), + SymE_NeedsProto(__aarch64_ldeor8_rel), + SymE_NeedsProto(__aarch64_ldeor8_relax), + SymE_NeedsProto(__aarch64_ldset1_acq), + SymE_NeedsProto(__aarch64_ldset1_acq_rel), + SymE_NeedsProto(__aarch64_ldset1_rel), + SymE_NeedsProto(__aarch64_ldset1_relax), + SymE_NeedsProto(__aarch64_ldset2_acq), + SymE_NeedsProto(__aarch64_ldset2_acq_rel), + SymE_NeedsProto(__aarch64_ldset2_rel), + SymE_NeedsProto(__aarch64_ldset2_relax), + SymE_NeedsProto(__aarch64_ldset4_acq), + SymE_NeedsProto(__aarch64_ldset4_acq_rel), + SymE_NeedsProto(__aarch64_ldset4_rel), + SymE_NeedsProto(__aarch64_ldset4_relax), + SymE_NeedsProto(__aarch64_ldset8_acq), + SymE_NeedsProto(__aarch64_ldset8_acq_rel), + SymE_NeedsProto(__aarch64_ldset8_rel), + SymE_NeedsProto(__aarch64_ldset8_relax), + SymE_NeedsProto(__aarch64_swp1_acq), + SymE_NeedsProto(__aarch64_swp1_acq_rel), + SymE_NeedsProto(__aarch64_swp1_rel), + SymE_NeedsProto(__aarch64_swp1_relax), + SymE_NeedsProto(__aarch64_swp2_acq), + SymE_NeedsProto(__aarch64_swp2_acq_rel), + SymE_NeedsProto(__aarch64_swp2_rel), + SymE_NeedsProto(__aarch64_swp2_relax), + SymE_NeedsProto(__aarch64_swp4_acq), + SymE_NeedsProto(__aarch64_swp4_acq_rel), + SymE_NeedsProto(__aarch64_swp4_rel), + SymE_NeedsProto(__aarch64_swp4_relax), + SymE_NeedsProto(__aarch64_swp8_acq), + SymE_NeedsProto(__aarch64_swp8_acq_rel), + SymE_NeedsProto(__aarch64_swp8_rel), + SymE_NeedsProto(__aarch64_swp8_relax), ===================================== rts/RtsSymbols.c ===================================== @@ -1055,6 +1055,9 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) +#include "AArch64Symbols.h" +#endif SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c172be0111f7b1bdfb62312e9839dfeb0a6092fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c172be0111f7b1bdfb62312e9839dfeb0a6092fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 17:54:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 05 Jul 2023 13:54:44 -0400 Subject: [Git][ghc/ghc][wip/T22012] rts/RtsSymbols: Add AArch64 outline atomic operations Message-ID: <64a5ae64b89f1_399dfead2145571ac@gitlab.mail> Ben Gamari pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: d38c4752 by Ben Gamari at 2023-07-05T13:52:52-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python ops = [] ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.append(f'__aarch64_{op}{n}_{order}') for m in [1,2,4,8,16]: ops.append(f'__aarch64_cas{n}_{order}') print('\n'.join(f' SymE_NeedsProto({op}),' for op in sorted(ops))) ``` - - - - - 2 changed files: - + rts/AArch64Symbols.h - rts/RtsSymbols.c Changes: ===================================== rts/AArch64Symbols.h ===================================== @@ -0,0 +1,100 @@ + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_ldadd1_acq), + SymE_NeedsProto(__aarch64_ldadd1_acq_rel), + SymE_NeedsProto(__aarch64_ldadd1_rel), + SymE_NeedsProto(__aarch64_ldadd1_relax), + SymE_NeedsProto(__aarch64_ldadd2_acq), + SymE_NeedsProto(__aarch64_ldadd2_acq_rel), + SymE_NeedsProto(__aarch64_ldadd2_rel), + SymE_NeedsProto(__aarch64_ldadd2_relax), + SymE_NeedsProto(__aarch64_ldadd4_acq), + SymE_NeedsProto(__aarch64_ldadd4_acq_rel), + SymE_NeedsProto(__aarch64_ldadd4_rel), + SymE_NeedsProto(__aarch64_ldadd4_relax), + SymE_NeedsProto(__aarch64_ldadd8_acq), + SymE_NeedsProto(__aarch64_ldadd8_acq_rel), + SymE_NeedsProto(__aarch64_ldadd8_rel), + SymE_NeedsProto(__aarch64_ldadd8_relax), + SymE_NeedsProto(__aarch64_ldclr1_acq), + SymE_NeedsProto(__aarch64_ldclr1_acq_rel), + SymE_NeedsProto(__aarch64_ldclr1_rel), + SymE_NeedsProto(__aarch64_ldclr1_relax), + SymE_NeedsProto(__aarch64_ldclr2_acq), + SymE_NeedsProto(__aarch64_ldclr2_acq_rel), + SymE_NeedsProto(__aarch64_ldclr2_rel), + SymE_NeedsProto(__aarch64_ldclr2_relax), + SymE_NeedsProto(__aarch64_ldclr4_acq), + SymE_NeedsProto(__aarch64_ldclr4_acq_rel), + SymE_NeedsProto(__aarch64_ldclr4_rel), + SymE_NeedsProto(__aarch64_ldclr4_relax), + SymE_NeedsProto(__aarch64_ldclr8_acq), + SymE_NeedsProto(__aarch64_ldclr8_acq_rel), + SymE_NeedsProto(__aarch64_ldclr8_rel), + SymE_NeedsProto(__aarch64_ldclr8_relax), + SymE_NeedsProto(__aarch64_ldeor1_acq), + SymE_NeedsProto(__aarch64_ldeor1_acq_rel), + SymE_NeedsProto(__aarch64_ldeor1_rel), + SymE_NeedsProto(__aarch64_ldeor1_relax), + SymE_NeedsProto(__aarch64_ldeor2_acq), + SymE_NeedsProto(__aarch64_ldeor2_acq_rel), + SymE_NeedsProto(__aarch64_ldeor2_rel), + SymE_NeedsProto(__aarch64_ldeor2_relax), + SymE_NeedsProto(__aarch64_ldeor4_acq), + SymE_NeedsProto(__aarch64_ldeor4_acq_rel), + SymE_NeedsProto(__aarch64_ldeor4_rel), + SymE_NeedsProto(__aarch64_ldeor4_relax), + SymE_NeedsProto(__aarch64_ldeor8_acq), + SymE_NeedsProto(__aarch64_ldeor8_acq_rel), + SymE_NeedsProto(__aarch64_ldeor8_rel), + SymE_NeedsProto(__aarch64_ldeor8_relax), + SymE_NeedsProto(__aarch64_ldset1_acq), + SymE_NeedsProto(__aarch64_ldset1_acq_rel), + SymE_NeedsProto(__aarch64_ldset1_rel), + SymE_NeedsProto(__aarch64_ldset1_relax), + SymE_NeedsProto(__aarch64_ldset2_acq), + SymE_NeedsProto(__aarch64_ldset2_acq_rel), + SymE_NeedsProto(__aarch64_ldset2_rel), + SymE_NeedsProto(__aarch64_ldset2_relax), + SymE_NeedsProto(__aarch64_ldset4_acq), + SymE_NeedsProto(__aarch64_ldset4_acq_rel), + SymE_NeedsProto(__aarch64_ldset4_rel), + SymE_NeedsProto(__aarch64_ldset4_relax), + SymE_NeedsProto(__aarch64_ldset8_acq), + SymE_NeedsProto(__aarch64_ldset8_acq_rel), + SymE_NeedsProto(__aarch64_ldset8_rel), + SymE_NeedsProto(__aarch64_ldset8_relax), + SymE_NeedsProto(__aarch64_swp1_acq), + SymE_NeedsProto(__aarch64_swp1_acq_rel), + SymE_NeedsProto(__aarch64_swp1_rel), + SymE_NeedsProto(__aarch64_swp1_relax), + SymE_NeedsProto(__aarch64_swp2_acq), + SymE_NeedsProto(__aarch64_swp2_acq_rel), + SymE_NeedsProto(__aarch64_swp2_rel), + SymE_NeedsProto(__aarch64_swp2_relax), + SymE_NeedsProto(__aarch64_swp4_acq), + SymE_NeedsProto(__aarch64_swp4_acq_rel), + SymE_NeedsProto(__aarch64_swp4_rel), + SymE_NeedsProto(__aarch64_swp4_relax), + SymE_NeedsProto(__aarch64_swp8_acq), + SymE_NeedsProto(__aarch64_swp8_acq_rel), + SymE_NeedsProto(__aarch64_swp8_rel), + SymE_NeedsProto(__aarch64_swp8_relax), ===================================== rts/RtsSymbols.c ===================================== @@ -1055,6 +1055,9 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) +#include "AArch64Symbols.h" +#endif SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d38c475224a08d2d75b0a32ffb5acd6f3703d6bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d38c475224a08d2d75b0a32ffb5acd6f3703d6bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 18:00:38 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Wed, 05 Jul 2023 14:00:38 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] Update Match Datatype Message-ID: <64a5afc6ed906_399dfe2b77f96856529e@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: 44733ad1 by David Knothe at 2023-07-05T20:00:23+02:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 6 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -203,11 +203,8 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss -- ==> case rhs of C x# y# -> body do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas - ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } - ; var <- selectMatchVar ManyTy upat + ; let eqn = EqnMatch { eqn_pat = pat, eqn_rest = EqnDone (cantFailMatchResult body) } + ; var <- selectMatchVar ManyTy (unLoc pat) -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -192,11 +191,7 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineEqnRhss (NEL.fromList eqns) match (v:vs) ty eqns -- Eqns *can* be empty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ @@ -279,7 +274,7 @@ matchBangs (var :| vars) ty eqns matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Apply the coercion to the match variable and then match that -matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) +matchCoercion (var :| vars) ty eqns@(eqn1 :| _) = do { let XPat (CoPat co pat _) = firstPat eqn1 ; let pat_ty' = hsPatType pat ; var' <- newUniqueId var (idMult var) pat_ty' @@ -291,7 +286,7 @@ matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Apply the view function to the match variable and then match that -matchView (var :| vars) ty (eqns@(eqn1 :| _)) +matchView (var :| vars) ty eqns@(eqn1 :| _) = do { -- we could pass in the expr from the PgView, -- but this needs to extract the pat anyway -- to figure out the type of the fresh variable @@ -309,8 +304,7 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _)) -- decompose the first pattern and leave the rest alone decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} +decomposeFirstPat extract eqn@(EqnMatch { eqn_pat = pat }) = eqn{eqn_pat = fmap extract pat} decomposeFirstPat _ _ = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc @@ -404,15 +398,14 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ eqn@(EqnDone {}) = return (idDsWrapper, eqn) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v eqn@(EqnMatch { eqn_pat = (L loc pat) }) = do + (wrap, pat') <- tidy1 v (isGeneratedSrcSpan (locA loc)) pat + return (wrap, eqn{eqn_pat = L loc pat' }) tidy1 :: Id -- The Id being scrutinised - -> Origin -- Was this a pattern the user wrote? + -> Bool -- `True` if the pattern was generated, `False` if it was user-written -> Pat GhcTc -- The pattern against which it is to be matched -> DsM (DsWrapper, -- Extra bindings to do before the match Pat GhcTc) -- Equivalent pattern @@ -423,10 +416,10 @@ tidy1 :: Id -- The Id being scrutinised -- It eliminates many pattern forms (as-patterns, variable patterns, -- list patterns, etc) and returns any created bindings in the wrapper. -tidy1 v o (ParPat _ _ pat _) = tidy1 v o (unLoc pat) -tidy1 v o (SigPat _ pat _) = tidy1 v o (unLoc pat) +tidy1 v g (ParPat _ _ pat _) = tidy1 v g (unLoc pat) +tidy1 v g (SigPat _ pat _) = tidy1 v g (unLoc pat) tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty) -tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p +tidy1 v g (BangPat _ (L l p)) = tidy_bang_pat v g l p -- case v of { x -> mr[] } -- = case v of { _ -> let x=v in mr[] } @@ -435,8 +428,8 @@ tidy1 v _ (VarPat _ (L _ var)) -- case v of { x at p -> mr[] } -- = case v of { p -> let x=v in mr[] } -tidy1 v o (AsPat _ (L _ var) _ pat) - = do { (wrap, pat') <- tidy1 v o (unLoc pat) +tidy1 v g (AsPat _ (L _ var) _ pat) + = do { (wrap, pat') <- tidy1 v g (unLoc pat) ; return (wrapBind var v . wrap, pat') } {- now, here we handle lazy patterns: @@ -488,22 +481,22 @@ tidy1 _ _ (SumPat tys pat alt arity) -- See Note [Unboxed tuple RuntimeRep vars] in TyCon -- LitPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (LitPat _ lit) - = do { unless (isGenerated o) $ +tidy1 _ g (LitPat _ lit) + = do { unless g $ warnAboutOverflowedLit lit ; return (idDsWrapper, tidyLitPat lit) } -- NPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) - = do { unless (isGenerated o) $ +tidy1 _ g (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) + = do { unless g $ let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v } | otherwise = lit in warnAboutOverflowedOverLit lit' ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) } -- NPlusKPat: we may want to warn about the literals -tidy1 _ o n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) - = do { unless (isGenerated o) $ do +tidy1 _ g n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) + = do { unless g $ do warnAboutOverflowedOverLit lit1 warnAboutOverflowedOverLit lit2 ; return (idDsWrapper, n) } @@ -513,28 +506,28 @@ tidy1 _ _ non_interesting_pat = return (idDsWrapper, non_interesting_pat) -------------------- -tidy_bang_pat :: Id -> Origin -> SrcSpanAnnA -> Pat GhcTc +tidy_bang_pat :: Id -> Bool -> SrcSpanAnnA -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc) -- Discard par/sig under a bang -tidy_bang_pat v o _ (ParPat _ _ (L l p) _) = tidy_bang_pat v o l p -tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p +tidy_bang_pat v g _ (ParPat _ _ (L l p) _) = tidy_bang_pat v g l p +tidy_bang_pat v g _ (SigPat _ (L l p) _) = tidy_bang_pat v g l p -- Push the bang-pattern inwards, in the hope that -- it may disappear next time -tidy_bang_pat v o l (AsPat x v' at p) - = tidy1 v o (AsPat x v' at (L l (BangPat noExtField p))) -tidy_bang_pat v o l (XPat (CoPat w p t)) - = tidy1 v o (XPat $ CoPat w (BangPat noExtField (L l p)) t) +tidy_bang_pat v g l (AsPat x v' at p) + = tidy1 v g (AsPat x v' at (L l (BangPat noExtField p))) +tidy_bang_pat v g l (XPat (CoPat w p t)) + = tidy1 v g (XPat $ CoPat w (BangPat noExtField (L l p)) t) -- Discard bang around strict pattern -tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(ListPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(TuplePat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p +tidy_bang_pat v g _ p@(LitPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(ListPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(TuplePat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(SumPat {}) = tidy1 v g p -- Data/newtype constructors -tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) +tidy_bang_pat v g l p@(ConPat { pat_con = L _ (RealDataCon dc) , pat_args = args , pat_con_ext = ConPatTc { cpt_arg_tys = arg_tys @@ -543,8 +536,8 @@ tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) -- Newtypes: push bang inwards (#9844) = if isNewTyCon (dataConTyCon dc) - then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) - else tidy1 v o p -- Data types: discard the bang + then tidy1 v g (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) + else tidy1 v g p -- Data types: discard the bang where (ty:_) = dataConInstArgTys dc arg_tys @@ -807,16 +800,14 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags - ; let upats = map (unLoc . decideBangHood dflags) pats + ; let upats = map (decideBangHood dflags) pats -- pat_nablas is the covered set *after* matching the pattern, but -- before any of the GRHSs. We extend the environment with pat_nablas -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats match_result } discard_warnings_if_generated orig = if isGenerated orig @@ -953,9 +944,8 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result addCoreScrutTmCs (maybeToList mb_scrut) [var] $ pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = match_result } + ; let eqn_info = EqnMatch { eqn_pat = decideBangHood dflags pat + , eqn_rest = EqnDone match_result } ; match [var] ty [eqn_info] } @@ -984,6 +974,13 @@ data PatGroup -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors @@ -1148,8 +1145,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2' -- the fixities have been straightened out by now, so it's safe -- to ignore them? - exp (OpApp _ l o ri) (OpApp _ l' o' ri') = - lexp l l' && lexp o o' && lexp ri ri' + exp (OpApp _ l g ri) (OpApp _ l' o' ri') = + lexp l l' && lexp g o' && lexp ri ri' exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n' exp (SectionL _ e1 e2) (SectionL _ e1' e2') = lexp e1 e1' && lexp e2 e2' @@ -1230,8 +1227,8 @@ patGroup :: Platform -> Pat GhcTc -> PatGroup patGroup _ (ConPat { pat_con = L _ con , pat_con_ext = ConPatTc { cpt_arg_tys = tys } }) - | RealDataCon dcon <- con = PgCon dcon - | PatSynCon psyn <- con = PgSyn psyn tys + | RealDataCon dcon <- con = PgCon dcon + | PatSynCon psyn <- con = PgSyn psyn tys patGroup _ (WildPat {}) = PgAny patGroup _ (BangPat {}) = PgBang patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -20,7 +20,6 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( match ) import GHC.Hs import GHC.HsToCore.Binds import GHC.Core.ConLike -import GHC.Types.Basic ( Origin(..) ) import GHC.Tc.Utils.TcType import GHC.Core.Multiplicity import GHC.HsToCore.Monad @@ -153,24 +152,21 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, EqnMatch { + eqn_pat = L _ (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind }}) + , eqn_rest = rest }) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , prependEqn (map (L (SrcSpanAnn EpAnnNotUsed generatedSrcSpan)) $ conArgPats val_arg_tys args) rest ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we @@ -208,6 +204,10 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ex_tvs = conLikeExTyCoVars con1 + prependEqn :: [LPat GhcTc] -> EquationInfo -> EquationInfo + prependEqn [] eqn = eqn + prependEqn (pat:pats) eqn = EqnMatch { eqn_pat = pat, eqn_rest = prependEqn pats eqn } + -- Choose the right arg_vars in the right order for this group -- Note [Record patterns] select_arg_vars :: [Id] -> NonEmpty (ConArgPats, EquationInfo) -> [Id] ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -625,10 +625,10 @@ matchLiterals (var :| vars) ty sub_groups } where match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let EqnMatch { eqn_pat = L _ (LitPat _ hs_lit) } = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -726,7 +726,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 (EqnMatch { eqn_pat = L _ (NPlusKPat _ (L _ n) _ _ _ _), eqn_rest = rest }) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -48,7 +48,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), mkEqnInfo, eqnMatchResult, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -91,7 +92,6 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) @@ -131,27 +131,35 @@ instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match data EquationInfo - = EqnInfo { eqn_pats :: [Pat GhcTc] - -- ^ The patterns for an equation - -- - -- NB: We have /already/ applied 'decideBangHood' to - -- these patterns. See Note [decideBangHood] in "GHC.HsToCore.Utils" - - , eqn_orig :: Origin - -- ^ Was this equation present in the user source? - -- - -- This helps us avoid warnings on patterns that GHC elaborated. - -- - -- For instance, the pattern @-1 :: Word@ gets desugared into - -- @W# -1## :: Word@, but we shouldn't warn about an overflowed - -- literal for /both/ of these cases. - - , eqn_rhs :: MatchResult CoreExpr - -- ^ What to do after match - } + = EqnMatch { eqn_pat :: LPat GhcTc + -- ^ The first pattern of the equation + -- + -- NB: The location info is used to determine whether the + -- pattern is generated or not. + -- This helps us avoid warnings on patterns that GHC elaborated. + -- + -- NB: We have /already/ applied 'decideBangHood' to this + -- pattern. See Note [decideBangHood] in "GHC.HsToCore.Utils" + + , eqn_rest :: EquationInfo } + -- ^ The rest of the equation after its first pattern + + -- The empty tail of an equation having no more patterns + | EqnDone (MatchResult CoreExpr) + -- ^ What to do after match + +mkEqnInfo :: [LPat GhcTc] -> MatchResult CoreExpr -> EquationInfo +mkEqnInfo [] rhs = EqnDone rhs +mkEqnInfo (pat:pats) rhs = EqnMatch { eqn_pat = pat, eqn_rest = mkEqnInfo pats rhs } + +eqnMatchResult :: EquationInfo -> MatchResult CoreExpr +eqnMatchResult (EqnDone rhs) = rhs +eqnMatchResult (EqnMatch { eqn_rest = eq }) = eqnMatchResult eq instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . allEqnPats where + allEqnPats (EqnDone {}) = [] + allEqnPats (EqnMatch { eqn_pat = pat, eqn_rest = eq }) = unLoc pat : allEqnPats eq type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, maybeFirstPat, shiftEqns, combineEqnRhss, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -87,7 +87,7 @@ import GHC.Tc.Types.Evidence import Control.Monad ( zipWithM ) import Data.List.NonEmpty (NonEmpty(..)) -import Data.Maybe (maybeToList) +import Data.Maybe (maybeToList, fromMaybe) import qualified Data.List.NonEmpty as NEL {- @@ -195,11 +195,18 @@ worthy of a type synonym and a few handy functions. -} firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat = fromMaybe (error "firstPat: no patterns") . maybeFirstPat + +maybeFirstPat :: EquationInfo -> Maybe (Pat GhcTc) +maybeFirstPat (EqnMatch { eqn_pat = pat }) = Just (unLoc pat) +maybeFirstPat (EqnDone {}) = Nothing shiftEqns :: Functor f => f EquationInfo -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap eqn_rest + +combineEqnRhss :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineEqnRhss eqns = return $ foldr1 combineMatchResults $ map eqnMatchResult (NEL.toList eqns) -- Functions on MatchResult CoreExprs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44733ad12fe2b0097dacda72a298d9f5289e59dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44733ad12fe2b0097dacda72a298d9f5289e59dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 18:07:07 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 05 Jul 2023 14:07:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22011 Message-ID: <64a5b14b4715e_399dfead25056865a@gitlab.mail> Ben Gamari pushed new branch wip/T22011 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22011 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 18:09:09 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 05 Jul 2023 14:09:09 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] 17 commits: configure: Rip out Solaris dyld check Message-ID: <64a5b1c5e70b8_399dfead21456898b@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - c9ce14f0 by Torsten Schmits at 2023-07-05T20:07:45+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 23 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf7ff2ede5ed1e2139fd62a13f8aa7bcddd15e47...c9ce14f0328a37465381c8d0d25a0aac8faf030e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf7ff2ede5ed1e2139fd62a13f8aa7bcddd15e47...c9ce14f0328a37465381c8d0d25a0aac8faf030e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 18:22:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 05 Jul 2023 14:22:29 -0400 Subject: [Git][ghc/ghc][wip/T22011] rts: Add generator for RtsSymbols from libgcc Message-ID: <64a5b4e58b9f2_399dfead250573685@gitlab.mail> Ben Gamari pushed to branch wip/T22011 at Glasgow Haskell Compiler / GHC Commits: 2c464418 by Ben Gamari at 2023-07-05T14:22:18-04:00 rts: Add generator for RtsSymbols from libgcc - - - - - 2 changed files: - hadrian/src/Rules/Generate.hs - + rts/gen_libgcc_symbols.py Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -180,13 +180,21 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "include/DerivedConstants.h" %> genPlatformConstantsHeader context root -/- "**" -/- dir -/- "include/rts/EventLogConstants.h" %> genEventTypes "--event-types-defines" root -/- "**" -/- dir -/- "include/rts/EventTypes.h" %> genEventTypes "--event-types-array" + root -/- "**" -/- dir -/- "rts/LibgccSymbols.h" %> genLibgccSymbols + +genLibgccSymbols :: FilePath -> Action () +genLibgccSymbols outFile = do + need [script] + runBuilder Python [script, outFile] [] [] + where + script = "rts" -/- "gen_libgcc_symbols.py" genEventTypes :: String -> FilePath -> Action () genEventTypes flag file = do - need ["rts" -/- "gen_event_types.py"] - runBuilder Python - ["rts" -/- "gen_event_types.py", flag, file] - [] [] + need [script] + runBuilder Python [script, flag, file] [] [] + where + script = "rts" -/- "gen_event_types.py" genPrimopCode :: Context -> FilePath -> Action () genPrimopCode context@(Context stage _pkg _ _) file = do ===================================== rts/gen_libgcc_symbols.py ===================================== @@ -0,0 +1,29 @@ +#!/usr/bin/env python3 + +import subprocess +import argparse +from typing import Set +from pathlib import Path + +def list_symbols(lib: Path) -> Set[str]: + out = subprocess.check_output([ + 'nm', '--format=posix', '--extern-only', '--defined-only', lib + ], encoding='ASCII') + syms = set() + for l in out.split('\n'): + parts = l.split(' ') + if len(parts) == 4: + syms.add(parts[0]) + + return syms + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('libgcc', type=Path, help='path to libgcc') + args = parser.parse_args() + + syms = list_symbols(args.libgcc) + print('\n'.join(f' SymE_NeedsProto({sym}),' for sym in sorted(syms))) + +if __name__ == '__main__': + main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c464418607a9071cfcc903c9985c8982f3cef0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c464418607a9071cfcc903c9985c8982f3cef0d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 19:45:32 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 05 Jul 2023 15:45:32 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 2 commits: Optimise opt_trans_rule a bit Message-ID: <64a5c85ce7b8e_399dfe2b793f08596353@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 63fd7da2 by Simon Peyton Jones at 2023-07-05T17:39:40+01:00 Optimise opt_trans_rule a bit This make a significant (5% ish) difference in T13386 - - - - - 87886186 by Simon Peyton Jones at 2023-07-05T20:40:23+01:00 Allow join points to inline a bit more This makes a big difference in T14697 -- but only because we still don't have #22404 yet. The critical function is in GHC.Driver.CmdLine, and is called lgo1_uniq It is called from `processArgs` when we find a "-" sign. For some reason this function is called (incl recursive calls) 19,021,947 times in T14967. - - - - - 2 changed files: - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -854,15 +854,16 @@ opt_trans_rule is co1 co2 -- If we put TrPushSymAxR first, we'll get -- (axN ty ; sym (axN ty)) :: N ty ~ N ty -- Obviously Refl -- --> axN (sym (axN ty)) :: N ty ~ N ty -- Very stupid - | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe - , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe - , con1 == con2 + | Just (sym1, ax1, ind1, cos1) <- isAxiom_maybe co1 + , Just (sym2, ax2, ind2, cos2) <- isAxiom_maybe co2 + , ax1 == ax2 , ind1 == ind2 , sym1 == not sym2 - , let branch = coAxiomNthBranch con1 ind1 - qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch - lhs = coAxNthLHS con1 ind1 - rhs = coAxBranchRHS branch + , let branch = coAxiomNthBranch ax1 ind1 + role = coAxiomRole ax1 + qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch + lhs = coAxNthLHS ax1 ind1 + rhs = coAxBranchRHS branch pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs) , all (`elemVarSet` pivot_tvs) qtvs = fireTransRule "TrPushAxSym" co1 co2 $ @@ -875,7 +876,7 @@ opt_trans_rule is co1 co2 -- See Note [Push transitivity inside axioms] and -- Note [Push transitivity inside newtype axioms only] -- TrPushSymAxR - | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + | Just (sym, con, ind, cos1) <- isAxiom_maybe co1 , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos2 <- matchAxiom sym con ind co2 @@ -883,7 +884,7 @@ opt_trans_rule is co1 co2 = fireTransRule "TrPushSymAxR" co1 co2 $ SymCo newAxInst -- TrPushAxR - | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + | Just (sym, con, ind, cos1) <- isAxiom_maybe co1 , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos2 <- matchAxiom sym con ind co2 @@ -891,7 +892,7 @@ opt_trans_rule is co1 co2 = fireTransRule "TrPushAxR" co1 co2 newAxInst -- TrPushSymAxL - | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + | Just (sym, con, ind, cos2) <- isAxiom_maybe co2 , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 @@ -899,17 +900,13 @@ opt_trans_rule is co1 co2 = fireTransRule "TrPushSymAxL" co1 co2 $ SymCo newAxInst -- TrPushAxL - | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + | Just (sym, con, ind, cos2) <- isAxiom_maybe co2 , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) = fireTransRule "TrPushAxL" co1 co2 newAxInst - where - co1_is_axiom_maybe = isAxiom_maybe co1 - co2_is_axiom_maybe = isAxiom_maybe co2 - role = coercionRole co1 -- should be the same as coercionRole co2! opt_trans_rule _ co1 co2 -- Identity rule | let ty1 = coercionLKind co1 @@ -1159,11 +1156,13 @@ chooseRole _ r = r ----------- isAxiom_maybe :: Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion]) -isAxiom_maybe (SymCo co) - | Just (sym, con, ind, cos) <- isAxiom_maybe co - = Just (not sym, con, ind, cos) -isAxiom_maybe (AxiomInstCo con ind cos) - = Just (False, con, ind, cos) +-- We don't expect to see nested SymCo; and that lets us write a simple, +-- non-recursive function. (If we see a nested SymCo we'll just fail, +-- which is ok.) +isAxiom_maybe (SymCo (AxiomInstCo ax ind cos)) + = Just (True, ax, ind, cos) +isAxiom_maybe (AxiomInstCo ax ind cos) + = Just (False, ax, ind, cos) isAxiom_maybe _ = Nothing matchAxiom :: Bool -- True = match LHS, False = match RHS ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -4311,7 +4311,7 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs where too_many_occs (ManyOccs {}) = True - too_many_occs (OneOcc { occ_n_br = n }) = n > 4 + too_many_occs (OneOcc { occ_n_br = n }) = n > 10 too_many_occs IAmDead = False too_many_occs (IAmALoopBreaker {}) = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99d011f850d8d5bc408e2e7abfb955554f869738...878861860bb1bd78d78f2f76cd8bb190b23f64ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99d011f850d8d5bc408e2e7abfb955554f869738...878861860bb1bd78d78f2f76cd8bb190b23f64ed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 21:45:53 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 05 Jul 2023 17:45:53 -0400 Subject: [Git][ghc/ghc][wip/T22404] 721 commits: Improve GHC.Tc.Gen.App.tcInstFun Message-ID: <64a5e4911ff61_184979aec40564d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 03b1230c by Simon Peyton Jones at 2023-07-05T20:47:26+01:00 Work in progress on #22404 Very much not ready! - - - - - 1a1ce851 by Sebastian Graf at 2023-07-05T20:47:26+01:00 Partition into OneOccs and ManyOccs - - - - - 801b220b by Simon Peyton Jones at 2023-07-05T20:47:27+01:00 Wibbles - - - - - 1c4fd207 by Simon Peyton Jones at 2023-07-05T20:47:27+01:00 Refactor WithTailJoinDetails - - - - - d73d19e3 by Simon Peyton Jones at 2023-07-05T20:48:28+01:00 Wibbles - - - - - fe452deb by Simon Peyton Jones at 2023-07-05T20:48:28+01:00 Wibbles - - - - - 1a541ffa by Simon Peyton Jones at 2023-07-05T20:53:38+01:00 Major wibbles - - - - - f3fbc7c9 by Simon Peyton Jones at 2023-07-05T20:53:38+01:00 Wibble - - - - - 554ae3c7 by Simon Peyton Jones at 2023-07-05T20:53:38+01:00 Vital fix to alt_env - - - - - a2bea302 by Simon Peyton Jones at 2023-07-05T20:56:21+01:00 Comments - - - - - 11f64213 by Simon Peyton Jones at 2023-07-05T20:56:21+01:00 Another crucial change Fixing a wrongly-zapped occ_join_points ..and a DEBUG check to catch it if it happens again - - - - - c2035d91 by Simon Peyton Jones at 2023-07-05T20:56:21+01:00 Fast path for addInScope - - - - - 18358594 by Simon Peyton Jones at 2023-07-05T22:45:17+01:00 Tiny fix - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - HACKING.md - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b3f6a25fda786d936331e547b4667168add4037...18358594ece6149675a8e917072d9a8b6f1ead84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b3f6a25fda786d936331e547b4667168add4037...18358594ece6149675a8e917072d9a8b6f1ead84 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 22:06:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 05 Jul 2023 18:06:46 -0400 Subject: [Git][ghc/ghc][master] Substitute free variables captured by breakpoints in SpecConstr Message-ID: <64a5e97654b76_1849791ae3b4c124d8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 4 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/SpecConstr.hs - docs/users_guide/using-optimisation.rst - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -2129,7 +2129,7 @@ stripNArgs 0 e = Just e stripNArgs n (App f _) = stripNArgs (n - 1) f stripNArgs _ _ = Nothing --- | Like @collectArgs@, but also collects looks through floatable +-- | Like @collectArgs@, but also looks through floatable -- ticks if it means that we can find more arguments. collectArgsTicks :: (CoreTickish -> Bool) -> Expr b -> (Expr b, [Arg b], [CoreTickish]) ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, LambdaCase #-} #if __GLASGOW_HASKELL__ < 905 {-# LANGUAGE PatternSynonyms #-} #endif @@ -1478,7 +1478,8 @@ scExpr' env (Type t) = scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) scExpr' env (Tick t e) = do (usg, e') <- scExpr env e - return (usg, Tick t e') + (usg_t, t') <- scTickish env t + return (combineUsage usg usg_t, Tick t' e') scExpr' env (Cast e co) = do (usg, e') <- scExpr env e return (usg, mkCast e' (scSubstCo env co)) -- Important to use mkCast here @@ -1537,6 +1538,17 @@ scExpr' env (Case scrut b ty alts) ; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') } +-- | Substitute the free variables captured by a breakpoint. +-- Variables are dropped if they have a non-variable substitution, like in +-- 'GHC.Opt.Specialise.specTickish'. +scTickish :: ScEnv -> CoreTickish -> UniqSM (ScUsage, CoreTickish) +scTickish env = \case + Breakpoint ext i fv modl -> do + (usg, fv') <- unzip <$> mapM (\ v -> scExpr env (Var v)) fv + pure (combineUsages usg, Breakpoint ext i [v | Var v <- fv'] modl) + t at ProfNote {} -> pure (nullUsage, t) + t at HpcTick {} -> pure (nullUsage, t) + t at SourceNote {} -> pure (nullUsage, t) {- Note [Do not specialise evals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -993,8 +993,8 @@ as such you shouldn't need to set any of them explicitly. A flag last' x (y : ys) = last' y ys As well avoid unnecessary pattern matching it also helps avoid - unnecessary allocation. This applies when a argument is strict in - the recursive call to itself but not on the initial entry. As strict + unnecessary allocation. This applies when an argument is strict in + the recursive call to itself but not on the initial entry. A strict recursive branch of the function is created similar to the above example. ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -477,7 +477,7 @@ test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) test('T23024', normal, multimod_compile, ['T23024', '-O -v0']) test('T23026', normal, compile, ['-O']) -test('T23267', [expect_broken(23267), only_ways(['ghci-opt']), extra_hc_opts('-fspec-constr')], ghci_script, ['T23267.script']) +test('T23267', [only_ways(['ghci-opt']), extra_hc_opts('-fspec-constr')], ghci_script, ['T23267.script']) test('T23362', normal, compile, ['-O']) test('T23307', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40f4ef7c40e747dfea491d297475458d2ccaf860 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40f4ef7c40e747dfea491d297475458d2ccaf860 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 22:07:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 05 Jul 2023 18:07:37 -0400 Subject: [Git][ghc/ghc][master] Reinstate untouchable variable error messages Message-ID: <64a5e9a9ba372_1849791ae3b24160e3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 6 changed files: - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/ado/T16135.stderr - testsuite/tests/indexed-types/should_compile/Simple14.stderr - testsuite/tests/typecheck/should_fail/T21338.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -21,6 +21,7 @@ module GHC.Tc.Errors.Ppr , inHsDocContext , TcRnMessageOpts(..) , pprTyThingUsedWrong + , pprUntouchableVariable -- | Useful when overriding message printing. , messageWithInfoDiagnosticMessage @@ -3726,13 +3727,6 @@ pprTcSolverReportMsg _ (FixedRuntimeRepError frr_origs) = = quotes (text "Levity") | otherwise = text "type" -pprTcSolverReportMsg _ (UntouchableVariable tv implic) - | Implic { ic_given = given, ic_info = skol_info } <- implic - = sep [ quotes (ppr tv) <+> text "is untouchable" - , nest 2 $ text "inside the constraints:" <+> pprEvVarTheta given - , nest 2 $ text "bound by" <+> ppr skol_info - , nest 2 $ text "at" <+> - ppr (getCtLocEnvLoc (ic_env implic)) ] pprTcSolverReportMsg _ (BlockedEquality item) = vcat [ hang (text "Cannot use equality for substitution:") 2 (ppr (errorItemPred item)) @@ -4004,6 +3998,13 @@ pprCannotUnifyVariableReason ctxt (RepresentationalEq tv_info mb_coercible_msg) = pprTyVarInfo ctxt tv_info $$ maybe empty pprCoercibleMsg mb_coercible_msg +pprUntouchableVariable :: TcTyVar -> Implication -> SDoc +pprUntouchableVariable tv (Implic { ic_given = given, ic_info = skol_info, ic_env = env }) + = sep [ quotes (ppr tv) <+> text "is untouchable" + , nest 2 $ text "inside the constraints:" <+> pprEvVarTheta given + , nest 2 $ text "bound by" <+> ppr skol_info + , nest 2 $ text "at" <+> ppr (getCtLocEnvLoc env) ] + pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc pprMismatchMsg ctxt (BasicMismatch { mismatch_ea = ea @@ -4486,8 +4487,10 @@ pprWhenMatching ctxt (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k) = Right msg -> pprMismatchMsg ctxt msg pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc -pprTyVarInfo ctxt (TyVarInfo { thisTyVar = tv1, otherTy = mb_tv2 }) = - mk_msg tv1 $$ case mb_tv2 of { Nothing -> empty; Just tv2 -> mk_msg tv2 } +pprTyVarInfo ctxt (TyVarInfo { thisTyVar = tv1, otherTy = mb_tv2, thisTyVarIsUntouchable = mb_implic }) + = vcat [ mk_msg tv1 + , maybe empty (pprUntouchableVariable tv1) mb_implic + , case mb_tv2 of { Nothing -> empty; Just tv2 -> mk_msg tv2 } ] where mk_msg tv = case tcTyVarDetails tv of SkolemTv sk_info _ _ -> pprSkols ctxt [(getSkolemInfo sk_info, [tv])] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4987,14 +4987,6 @@ data TcSolverReportMsg -- See 'HoleError'. | ReportHoleError Hole HoleError - -- | Trying to unify an untouchable variable, e.g. a variable from an outer scope. - -- - -- Test case: Simple14 - | UntouchableVariable - { untouchableTyVar :: TyVar - , untouchableTyVarImplication :: Implication - } - -- | Cannot unify a variable, because of a type mismatch. | CannotUnifyVariable { mismatchMsg :: MismatchMsg ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -306,7 +306,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "UserTypeError" = 64725 GhcDiagnosticCode "UnsatisfiableError" = 22250 GhcDiagnosticCode "ReportHoleError" = 88464 - GhcDiagnosticCode "UntouchableVariable" = 34699 GhcDiagnosticCode "FixedRuntimeRepError" = 55287 GhcDiagnosticCode "BlockedEquality" = 06200 GhcDiagnosticCode "ExpectingMoreArguments" = 81325 @@ -851,6 +850,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnUnexpectedTypeSplice" = 39180 GhcDiagnosticCode "PsErrUnexpectedTypeAppInDecl" = 45054 GhcDiagnosticCode "TcRnUnpromotableThing" = 88634 + GhcDiagnosticCode "UntouchableVariable" = 34699 {- ********************************************************************* * * ===================================== testsuite/tests/ado/T16135.stderr ===================================== @@ -2,6 +2,11 @@ T16135.hs:11:18: error: [GHC-83865] • Couldn't match type ‘a0’ with ‘a’ Expected: f a0 Actual: f a + ‘a0’ is untouchable + inside the constraints: Functor f + bound by the type signature for: + runf :: forall (f :: * -> *). Functor f => IO (T f) + at T16135.hs:7:1-39 ‘a’ is a rigid type variable bound by a pattern with constructor: MkT :: forall {k} (f :: k -> *) (a :: k). f a -> T f, ===================================== testsuite/tests/indexed-types/should_compile/Simple14.stderr ===================================== @@ -3,10 +3,15 @@ Simple14.hs:22:27: error: [GHC-83865] • Couldn't match type ‘z0’ with ‘n’ Expected: EQ_ z0 z0 Actual: EQ_ m n - ‘n’ is a rigid type variable bound by - the type signature for: - foo :: forall m n. EQ_ (Maybe m) (Maybe n) - at Simple14.hs:21:1-42 + ‘z0’ is untouchable + inside the constraints: Maybe m ~ Maybe n + bound by a type expected by the context: + (Maybe m ~ Maybe n) => EQ_ z0 z0 + at Simple14.hs:22:26-41 + ‘n’ is a rigid type variable bound by + the type signature for: + foo :: forall m n. EQ_ (Maybe m) (Maybe n) + at Simple14.hs:21:1-42 • In the second argument of ‘eqE’, namely ‘(eqI :: EQ_ m n)’ In the expression: x `eqE` (eqI :: EQ_ m n) In the first argument of ‘ntI’, namely ===================================== testsuite/tests/typecheck/should_fail/T21338.stderr ===================================== @@ -3,10 +3,18 @@ T21338.hs:38:24: error: [GHC-83865] • Couldn't match type ‘flds0’ with ‘flds’ Expected: NP (K String) flds Actual: NP (K String) flds0 - ‘flds’ is a rigid type variable bound by - the type signature for: - fieldNames :: forall a (flds :: [*]). NP (K String) flds - at T21338.hs:36:1-57 + ‘flds0’ is untouchable + inside the constraints: All flds0 + bound by a pattern with constructor: + Record :: forall (xs :: [*]). + All xs => + NP (K String) xs -> ConstructorInfo xs, + in a case alternative + at T21338.hs:38:3-11 + ‘flds’ is a rigid type variable bound by + the type signature for: + fieldNames :: forall a (flds :: [*]). NP (K String) flds + at T21338.hs:36:1-57 • In the second argument of ‘hmap’, namely ‘np’ In the expression: hmap id np In a case alternative: Record np -> hmap id np View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b55cb5f33666a71eaac7968c59e483860112e5c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b55cb5f33666a71eaac7968c59e483860112e5c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 5 22:08:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 05 Jul 2023 18:08:18 -0400 Subject: [Git][ghc/ghc][master] configure: Drop Clang command from settings Message-ID: <64a5e9d263b68_1849791ad306c19576@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 13 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - testsuite/ghc-config/ghc-config.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -108,7 +108,6 @@ module GHC.Driver.Session ( sPgm_ranlib, sPgm_lo, sPgm_lc, - sPgm_lcc, sPgm_i, sOpt_L, sOpt_P, @@ -122,7 +121,6 @@ module GHC.Driver.Session ( sOpt_windres, sOpt_lo, sOpt_lc, - sOpt_lcc, sOpt_i, sExtraGccViaCFlags, sTargetPlatformString, @@ -138,10 +136,10 @@ module GHC.Driver.Session ( extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, pgm_windres, pgm_ar, - pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, + pgm_ranlib, pgm_lo, pgm_lc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, - opt_windres, opt_lo, opt_lc, opt_lcc, + opt_windres, opt_lo, opt_lc, updatePlatformConstants, -- ** Manipulating DynFlags @@ -411,8 +409,6 @@ pgm_T :: DynFlags -> String pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags -pgm_lcc :: DynFlags -> (String,[Option]) -pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags pgm_ranlib :: DynFlags -> String @@ -453,8 +449,6 @@ opt_lm :: DynFlags -> [String] opt_lm dflags= toolSettings_opt_lm $ toolSettings dflags opt_windres :: DynFlags -> [String] opt_windres dflags= toolSettings_opt_windres $ toolSettings dflags -opt_lcc :: DynFlags -> [String] -opt_lcc dflags= toolSettings_opt_lcc $ toolSettings dflags opt_lo :: DynFlags -> [String] opt_lo dflags= toolSettings_opt_lo $ toolSettings dflags opt_lc :: DynFlags -> [String] ===================================== compiler/GHC/Settings.hs ===================================== @@ -42,7 +42,6 @@ module GHC.Settings , sPgm_ranlib , sPgm_lo , sPgm_lc - , sPgm_lcc , sPgm_i , sOpt_L , sOpt_P @@ -56,7 +55,6 @@ module GHC.Settings , sOpt_windres , sOpt_lo , sOpt_lc - , sOpt_lcc , sOpt_i , sExtraGccViaCFlags , sTargetPlatformString @@ -121,8 +119,6 @@ data ToolSettings = ToolSettings toolSettings_pgm_lo :: (String, [Option]) , -- | LLVM: llc static compiler toolSettings_pgm_lc :: (String, [Option]) - , -- | LLVM: c compiler - toolSettings_pgm_lcc :: (String, [Option]) , toolSettings_pgm_i :: String -- options for particular phases @@ -142,8 +138,6 @@ data ToolSettings = ToolSettings toolSettings_opt_lo :: [String] , -- | LLVM: llc static compiler toolSettings_opt_lc :: [String] - , -- | LLVM: c compiler - toolSettings_opt_lcc :: [String] , -- | iserv options toolSettings_opt_i :: [String] @@ -242,8 +236,6 @@ sPgm_lo :: Settings -> (String, [Option]) sPgm_lo = toolSettings_pgm_lo . sToolSettings sPgm_lc :: Settings -> (String, [Option]) sPgm_lc = toolSettings_pgm_lc . sToolSettings -sPgm_lcc :: Settings -> (String, [Option]) -sPgm_lcc = toolSettings_pgm_lcc . sToolSettings sPgm_i :: Settings -> String sPgm_i = toolSettings_pgm_i . sToolSettings sOpt_L :: Settings -> [String] @@ -270,8 +262,6 @@ sOpt_lo :: Settings -> [String] sOpt_lo = toolSettings_opt_lo . sToolSettings sOpt_lc :: Settings -> [String] sOpt_lc = toolSettings_opt_lc . sToolSettings -sOpt_lcc :: Settings -> [String] -sOpt_lcc = toolSettings_opt_lcc . sToolSettings sOpt_i :: Settings -> [String] sOpt_i = toolSettings_opt_i . sToolSettings ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -151,7 +151,6 @@ initSettings top_dir = do -- We just assume on command line lc_prog <- getSetting "LLVM llc command" lo_prog <- getSetting "LLVM opt command" - lcc_prog <- getSetting "LLVM clang command" let iserv_prog = libexec "ghc-iserv" @@ -199,7 +198,6 @@ initSettings top_dir = do , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) - , toolSettings_pgm_lcc = (lcc_prog,[]) , toolSettings_pgm_i = iserv_prog , toolSettings_opt_L = [] , toolSettings_opt_P = [] @@ -211,7 +209,6 @@ initSettings top_dir = do , toolSettings_opt_l = [] , toolSettings_opt_lm = [] , toolSettings_opt_windres = [] - , toolSettings_opt_lcc = [] , toolSettings_opt_lo = [] , toolSettings_opt_lc = [] , toolSettings_opt_i = [] ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -12,7 +12,6 @@ module GHC.SysTools.Tasks where import GHC.Prelude import GHC.Platform import GHC.ForeignSrcLang -import GHC.IO (catchException) import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound) @@ -217,28 +216,6 @@ runLlvmLlc logger dflags args = traceSystoolCommand logger "llc" $ do args1 = map Option (getOpts dflags opt_lc) runSomething logger "LLVM Compiler" p (args0 ++ args1 ++ args) --- | Run the clang compiler (used as an assembler for the LLVM --- backend on OS X as LLVM doesn't support the OS X system --- assembler) -runClang :: Logger -> DynFlags -> [Option] -> IO () -runClang logger dflags args = traceSystoolCommand logger "clang" $ do - let (clang,_) = pgm_lcc dflags - -- be careful what options we call clang with - -- see #5903 and #7617 for bugs caused by this. - (_,args0) = pgm_a dflags - args1 = map Option (getOpts dflags opt_a) - args2 = args0 ++ args1 ++ args - mb_env <- getGccEnv args2 - catchException - (runSomethingFiltered logger id "Clang (Assembler)" clang args2 Nothing mb_env) - (\(err :: SomeException) -> do - errorMsg logger $ - text ("Error running clang! you need clang installed to use the" ++ - " LLVM backend") $+$ - text "(or GHC tried to execute clang incorrectly)" - throwIO err - ) - runEmscripten :: Logger -> DynFlags -> [Option] -> IO () runEmscripten logger dflags args = traceSystoolCommand logger "emcc" $ do let (p,args0) = pgm_a dflags ===================================== configure.ac ===================================== @@ -528,13 +528,6 @@ sUPPORTED_LLVM_VERSION_MAX=$(echo \($LlvmMaxVersion\) | sed 's/\./,/') AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MIN], ${sUPPORTED_LLVM_VERSION_MIN}, [The minimum supported LLVM version number]) AC_DEFINE_UNQUOTED([sUPPORTED_LLVM_VERSION_MAX], ${sUPPORTED_LLVM_VERSION_MAX}, [The maximum supported LLVM version number]) -dnl ** Which LLVM clang to use? -dnl -------------------------------------------------------------- -AC_ARG_VAR(CLANG,[Use as the path to clang [default=autodetect]]) -AC_CHECK_TARGET_TOOL([CLANG], [clang]) -ClangCmd="$CLANG" -AC_SUBST([ClangCmd]) - dnl ** Which LLVM llc to use? dnl -------------------------------------------------------------- AC_ARG_VAR(LLC,[Use as the path to LLVM's llc [default=autodetect]]) @@ -1269,7 +1262,6 @@ echo "\ libdw : $USING_LIBDW Using LLVM tools - clang : $ClangCmd llc : $LlcCmd opt : $OptCmd" ===================================== hadrian/bindist/Makefile ===================================== @@ -120,7 +120,6 @@ lib/settings : config.mk @echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@ @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@ @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@ - @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@ @echo ',("Use inplace MinGW toolchain", "$(SettingsUseDistroMINGW)")' >> $@ @echo @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -275,7 +275,6 @@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ -SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ SettingsUseDistroMINGW = @SettingsUseDistroMINGW@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ -settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ settings-use-distro-mingw = @SettingsUseDistroMINGW@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -126,7 +126,6 @@ data SettingsFileSetting | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand - | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand | SettingsFileSetting_DistroMinGW @@ -224,7 +223,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" - SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" SettingsFileSetting_DistroMinGW -> "settings-use-distro-mingw" ===================================== hadrian/src/Oracles/TestSettings.hs ===================================== @@ -37,7 +37,6 @@ data TestSetting = TestHostOS | TestGhcDynamic | TestGhcProfiled | TestAR - | TestCLANG | TestLLC | TestTEST_CC | TestTEST_CC_OPTS @@ -69,7 +68,6 @@ testSetting key = do TestGhcDynamic -> "GhcDynamic" TestGhcProfiled -> "GhcProfiled" TestAR -> "AR" - TestCLANG -> "CLANG" TestLLC -> "LLC" TestTEST_CC -> "TEST_CC" TestTEST_CC_OPTS -> "TEST_CC_OPTS" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -479,7 +479,6 @@ generateSettings = do , ("LLVM target", getSetting LlvmTarget) , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand) , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand) - , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand) , ("Use inplace MinGW toolchain", expr $ settingsFileSetting SettingsFileSetting_DistroMinGW) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) ===================================== m4/fp_settings.m4 ===================================== @@ -75,12 +75,6 @@ AC_DEFUN([FP_SETTINGS], fi fi - # Platform-agnostic tools - if test -z "$ClangCmd"; then - ClangCmd="clang" - fi - SettingsClangCommand="$ClangCmd" - # LLVM backend tools if test -z "$LlcCmd"; then LlcCmd="llc" @@ -124,7 +118,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) - AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) AC_SUBST(SettingsUseDistroMINGW) ===================================== testsuite/ghc-config/ghc-config.hs ===================================== @@ -33,7 +33,6 @@ main = do getGhcFieldOrDefault fields "LeadingUnderscore" "Leading underscore" "NO" getGhcFieldOrDefault fields "GhcTablesNextToCode" "Tables next to code" "NO" getGhcFieldProgWithDefault fields "AR" "ar command" "ar" - getGhcFieldProgWithDefault fields "CLANG" "LLVM clang command" "clang" getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc" getGhcFieldProgWithDefault fields "TEST_CC" "C compiler command" "gcc" getGhcFieldProgWithDefault fields "TEST_CC_OPTS" "C compiler flags" "" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53ed21c5d142961848f4b24fa8d5f45d500b9494 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53ed21c5d142961848f4b24fa8d5f45d500b9494 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 01:58:39 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 05 Jul 2023 21:58:39 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to enable/disable incoherent instances Message-ID: <64a61fcf539f5_184979aec683662f@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 069083dc by Gergő Érdi at 2023-07-06T02:55:51+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 25 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/simplCore/should_run/T22448.hs Changes: ===================================== compiler/GHC/Builtin/Names/TH.hs ===================================== @@ -137,7 +137,7 @@ templateHaskellNames = [ allPhasesDataConName, fromPhaseDataConName, beforePhaseDataConName, -- Overlap overlappableDataConName, overlappingDataConName, overlapsDataConName, - incoherentDataConName, + incoherentDataConName, noncanonicalDataConName, -- DerivStrategy stockStrategyName, anyclassStrategyName, newtypeStrategyName, viaStrategyName, @@ -641,11 +641,13 @@ beforePhaseDataConName = thCon (fsLit "BeforePhase") beforePhaseDataConKey overlappableDataConName, overlappingDataConName, overlapsDataConName, - incoherentDataConName :: Name + incoherentDataConName, + noncanonicalDataConName :: Name overlappableDataConName = thCon (fsLit "Overlappable") overlappableDataConKey overlappingDataConName = thCon (fsLit "Overlapping") overlappingDataConKey overlapsDataConName = thCon (fsLit "Overlaps") overlapsDataConKey incoherentDataConName = thCon (fsLit "Incoherent") incoherentDataConKey +noncanonicalDataConName = thCon (fsLit "NonCanonical") noncanonicalDataConKey {- ********************************************************************* * * @@ -748,11 +750,13 @@ beforePhaseDataConKey = mkPreludeDataConUnique 208 overlappableDataConKey, overlappingDataConKey, overlapsDataConKey, - incoherentDataConKey :: Unique + incoherentDataConKey, + noncanonicalDataConKey :: Unique overlappableDataConKey = mkPreludeDataConUnique 209 overlappingDataConKey = mkPreludeDataConUnique 210 overlapsDataConKey = mkPreludeDataConUnique 211 incoherentDataConKey = mkPreludeDataConUnique 212 +noncanonicalDataConKey = mkPreludeDataConUnique 213 {- ********************************************************************* * * ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -11,7 +11,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv. module GHC.Core.InstEnv ( DFunId, InstMatch, ClsInstLookupResult, - Coherence(..), PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, + Canonical, PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst, @@ -122,10 +122,11 @@ fuzzyClsInstCmp x y = cmp (RM_KnownTc _, RM_WildCard) = GT cmp (RM_KnownTc x, RM_KnownTc y) = stableNameCmp x y -isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool +isOverlappable, isOverlapping, isIncoherent, isNonCanonical :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i)) isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i)) +isNonCanonical i = hasNonCanonicalFlag (overlapMode (is_flag i)) {- Note [ClsInst laziness and the rough-match fields] @@ -812,8 +813,33 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. But sometimes that is +fine, because the programmer promises that it doesn't matter which one is +chosen. A good example is in the `optics` library: + + data IxEq i is js where { IxEq :: IxEq i is is } + + class AppendIndices xs ys ks | xs ys -> ks where + appendIndices :: IxEq i (Curry xs (Curry ys i)) (Curry ks i) + + instance {-# INCOHERENT #-} xs ~ zs => AppendIndices xs '[] zs where + appendIndices = IxEq + + instance ys ~ zs => AppendIndices '[] ys zs where + appendIndices = IxEq + +Here `xs` and `ys` are type-level lists, and for type inference purposes we want to +solve the `AppendIndices` constraint when /either/ of them are the empty list. The +dictionaries are the same in both cases (indeed the dictionary type is a singleton!), +so we really don't care which is used. See #23287 for discussion. + +In short, sometimes we want to specialise on these incoherently-selected dictionaries, +and sometimes we don't. It would be best to have a per-instance pragma, but for now +we have a global flag. The flag `-fspecialise-incoherents` (on by default) selects +enables specialisation on incoherent evidence (as has been the case previously). +The rest of this note describes what happens with `-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -850,7 +876,7 @@ Here are the moving parts: * `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into (nospec f d) if `d` is incoherent. It has to do a dependency analysis to determine transitive dependencies, but we need to do that anyway. - See Note [Desugaring incoherent evidence] in GHC.HsToCore.Binds. + See Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds. See also Note [nospecId magic] in GHC.Types.Id.Make. -} @@ -955,10 +981,10 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +type Canonical = Bool -- See Note [Recording coherence information in `PotentialUnifiers`] -data PotentialUnifiers = NoUnifiers Coherence +data PotentialUnifiers = NoUnifiers Canonical | OneOrMoreUnifiers (NonEmpty ClsInst) -- This list is lazy as we only look at all the unifiers when -- printing an error message. It can be expensive to compute all @@ -980,20 +1006,12 @@ So we only need the `Coherent` flag in the case where the set of potential unifiers is otherwise empty. -} -instance Outputable Coherence where - ppr IsCoherent = text "coherent" - ppr IsIncoherent = text "incoherent" - instance Outputable PotentialUnifiers where - ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c + ppr (NoUnifiers c) = text "NoUnifiers" <+> if c then text "canonical" else text "non-canonical" ppr xs = ppr (getPotentialUnifiers xs) -instance Semigroup Coherence where - IsCoherent <> IsCoherent = IsCoherent - _ <> _ = IsIncoherent - instance Semigroup PotentialUnifiers where - NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 <> c2) + NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 && c2) NoUnifiers _ <> u = u OneOrMoreUnifiers (unifier :| unifiers) <> u = OneOrMoreUnifiers (unifier :| (unifiers <> getPotentialUnifiers u)) @@ -1039,22 +1057,24 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys = acc - incoherently_matched :: PotentialUnifiers -> PotentialUnifiers - incoherently_matched (NoUnifiers _) = NoUnifiers IsIncoherent - incoherently_matched u = u + noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers + noncanonically_matched (NoUnifiers _) = NoUnifiers False + noncanonically_matched u = u check_unifier :: [ClsInst] -> PotentialUnifiers - check_unifier [] = NoUnifiers IsCoherent + check_unifier [] = NoUnifiers True check_unifier (item at ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items) | not (instIsVisible vis_mods item) = check_unifier items -- See Note [Instance lookup and orphan instances] | Just {} <- tcMatchTys tpl_tys tys = check_unifier items -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] + -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview] + | isNonCanonical item + = noncanonically_matched $ check_unifier items -- Ignore ones that are incoherent: Note [Incoherent instances] - -- Record that we encountered incoherent instances: Note [Coherence and specialisation: overview] | isIncoherent item - = incoherently_matched $ check_unifier items + = check_unifier items | otherwise = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set) @@ -1111,7 +1131,7 @@ lookupInstEnv check_overlap_safe -- If the selected match is incoherent, discard all unifiers final_unifs = case final_matches of - (m:_) | isIncoherent (fst m) -> NoUnifiers IsCoherent + (m:_) | isIncoherent (fst m) -> NoUnifiers True _ -> all_unifs -- Note [Safe Haskell isSafeOverlap] ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Hs -- lots of things import GHC.Core -- lots of things import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Core.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( etaExpand ) @@ -1152,14 +1152,14 @@ evidence that is used in `e`. This question arose when thinking about deep subsumption; see https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649). -Note [Desugaring incoherent evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the evidence is coherent, we desugar WpEvApp by simply passing +Note [Desugaring non-canonical evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the evidence is canonical, we desugar WpEvApp by simply passing core_tm directly to k: k core_tm -If the evidence is not coherent, we mark the application with nospec: +If the evidence is not canonical, we mark the application with nospec: nospec @(cls => a) k core_tm @@ -1170,14 +1170,14 @@ of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). See Note [Coherence and specialisation: overview] for why we shouldn't specialise incoherent evidence. -We can find out if a given evidence is coherent or not during the -desugaring of its WpLet wrapper: an evidence is incoherent if its +We can find out if a given evidence is canonical or not during the +desugaring of its WpLet wrapper: an evidence is non-canonical if its own resolution was incoherent (see Note [Incoherent instances]), or -if its definition refers to other incoherent evidence. dsEvBinds is +if its definition refers to other non-canonical evidence. dsEvBinds is the convenient place to compute this, since it already needs to do inter-evidence dependency analysis to generate well-scoped -bindings. We then record this coherence information in the -dsl_coherence field of DsM's local environment. +bindings. We then record this specialisability information in the +dsl_unspecables field of DsM's local environment. -} @@ -1201,20 +1201,27 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring non-canonical evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } +-- We are about to construct an evidence application `f dict`. If the dictionary is +-- non-specialisable, instead construct +-- nospec f dict +-- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1232,7 +1239,7 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- * Desugars the ev_binds, sorts them into dependency order, and -- passes the resulting [CoreBind] to thing_inside --- * Extends the DsM (dsl_coherence field) with coherence information +-- * Extends the DsM (dsl_unspecable field) with specialisability information -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside @@ -1240,53 +1247,50 @@ dsEvBinds ev_binds thing_inside ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where - go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a + go ::[SCC (Node EvVar (Canonical, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False - - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where - ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + ((v, rhs), (this_canonical, deps)) = unpack_node node + transitively_unspecable = not this_canonical || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where - (pairs, direct_coherence) = unzip $ map unpack_node nodes + (pairs, direct_canonicity) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not this_canonical || any is_unspecable_remote deps | (this_canonical, deps) <- direct_canonicity ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring non-canonical evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty - unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) + unpack_node DigraphNode { node_key = v, node_payload = (canonical, rhs), node_dependencies = deps } = ((v, rhs), (canonical, deps)) -sort_ev_binds :: Bag (Id, Coherence, CoreExpr) -> [SCC (Node EvVar (Coherence, CoreExpr))] +sort_ev_binds :: Bag (Id, Canonical, CoreExpr) -> [SCC (Node EvVar (Canonical, CoreExpr))] -- We do SCC analysis of the evidence bindings, /after/ desugaring -- them. This is convenient: it means we can use the GHC.Core -- free-variable functions rather than having to do accurate free vars -- for EvTerm. sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges where - edges :: [ Node EvVar (Coherence, CoreExpr) ] + edges :: [ Node EvVar (Canonical, CoreExpr) ] edges = foldr ((:) . mk_node) [] ds_binds - mk_node :: (Id, Coherence, CoreExpr) -> Node EvVar (Coherence, CoreExpr) - mk_node (var, coherence, rhs) - = DigraphNode { node_payload = (coherence, rhs) + mk_node :: (Id, Canonical, CoreExpr) -> Node EvVar (Canonical, CoreExpr) + mk_node (var, canonical, rhs) + = DigraphNode { node_payload = (canonical, rhs) , node_key = var , node_dependencies = nonDetEltsUniqSet $ exprFreeVars rhs `unionVarSet` @@ -1295,13 +1299,13 @@ sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges -- is still deterministic even if the edges are in nondeterministic order -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. -dsEvBind :: EvBind -> DsM (Id, Coherence, CoreExpr) +dsEvBind :: EvBind -> DsM (Id, Canonical, CoreExpr) dsEvBind (EvBind { eb_lhs = v, eb_rhs = r, eb_info = info }) = do e <- dsEvTerm r - let coherence = case info of - EvBindGiven{} -> IsCoherent - EvBindWanted{ ebi_coherence = coherence } -> coherence - return (v, coherence, e) + let canonical = case info of + EvBindGiven{} -> True + EvBindWanted{ ebi_canonical = canonical } -> canonical + return (v, canonical, e) {-********************************************************************** ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -357,7 +357,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +413,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -2628,6 +2628,7 @@ repOverlap mb = Overlapping _ -> just =<< dataCon overlappingDataConName Overlaps _ -> just =<< dataCon overlapsDataConName Incoherent _ -> just =<< dataCon incoherentDataConName + NonCanonical _ -> just =<< dataCon noncanonicalDataConName where nothing = coreNothing overlapTyConName just = coreJust overlapTyConName ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -79,9 +79,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar - -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + , dsl_unspecables :: S.Set EvVar + -- ^ See Note [Desugaring non-canonical evidence]: this field collects + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1212,11 +1212,11 @@ addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty ; case dest of EvVarDest evar - -> addTcEvBind ev_binds_var $ mkWantedEvBind evar IsCoherent err_tm + -> addTcEvBind ev_binds_var $ mkWantedEvBind evar True err_tm HoleDest hole -> do { -- See Note [Deferred errors for coercion holes] let co_var = coHoleCoVar hole - ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var IsCoherent err_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var True err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2514,6 +2514,7 @@ reifyClassInstance is_poly_tvs i Overlapping _ -> Just TH.Overlapping Overlaps _ -> Just TH.Overlaps Incoherent _ -> Just TH.Incoherent + NonCanonical _ -> Just TH.NonCanonical ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -92,7 +92,7 @@ data ClsInstResult | OneInst { cir_new_theta :: [TcPredType] , cir_mk_ev :: [EvExpr] -> EvTerm - , cir_coherence :: Coherence -- See Note [Coherence and specialisation: overview] + , cir_canonical :: Canonical -- See Note [Coherence and specialisation: overview] , cir_what :: InstanceWhat } | NotSure -- Multiple matches and/or one or more unifiers @@ -162,7 +162,7 @@ matchInstEnv dflags short_cut_solver clas tys ; return NoInstance } -- A single match (& no safe haskell failure) - ([(ispec, inst_tys)], NoUnifiers coherence, False) + ([(ispec, inst_tys)], NoUnifiers canonical, False) | short_cut_solver -- Called from the short-cut solver , isOverlappable ispec -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT @@ -175,12 +175,11 @@ matchInstEnv dflags short_cut_solver clas tys | otherwise -> do { let dfun_id = instanceDFunId ispec ; traceTc "matchClass success" $ - vcat [text "dict" <+> ppr pred, - ppr coherence, + vcat [text "dict" <+> ppr pred <+> parens (if canonical then text "canonical" else text "non-canonical"), text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ] -- Record that this dfun is needed - ; match_one (null unsafeOverlaps) coherence dfun_id inst_tys } + ; match_one (null unsafeOverlaps) canonical dfun_id inst_tys } -- More than one matches (or Safe Haskell fail!). Defer any -- reactions of a multitude until we learn more about the reagent @@ -191,15 +190,15 @@ matchInstEnv dflags short_cut_solver clas tys where pred = mkClassPred clas tys -match_one :: SafeOverlapping -> Coherence -> DFunId -> [DFunInstType] -> TcM ClsInstResult +match_one :: SafeOverlapping -> Canonical -> DFunId -> [DFunInstType] -> TcM ClsInstResult -- See Note [DFunInstType: instantiating types] in GHC.Core.InstEnv -match_one so coherence dfun_id mb_inst_tys +match_one so canonical dfun_id mb_inst_tys = do { traceTc "match_one" (ppr dfun_id $$ ppr mb_inst_tys) ; (tys, theta) <- instDFunType dfun_id mb_inst_tys ; traceTc "match_one 2" (ppr dfun_id $$ ppr tys $$ ppr theta) ; return $ OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = TopLevInstance { iw_dfun_id = dfun_id , iw_safe_over = so } } } @@ -235,7 +234,7 @@ matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys , cir_mk_ev = tuple_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! where @@ -399,7 +398,7 @@ makeLitDict clas ty et , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) = return $ OneInst { cir_new_theta = [] , cir_mk_ev = \_ -> ev_tm - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } | otherwise @@ -448,7 +447,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_canonical = False -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } @@ -555,7 +554,7 @@ Some further observations about `withDict`: k (sv |> (sub co2 ; sym co))) That is, we cast the method using a coercion, and apply k to - it. Moreover, we mark the evidence as incoherent, resulting in + it. Moreover, we mark the evidence as non-canonical, resulting in the use of the 'nospec' magicId (see Note [nospecId magic] in GHC.Types.Id.Make) to ensure that the typeclass specialiser doesn't incorrectly common-up distinct evidence terms. This is @@ -641,7 +640,7 @@ doFunTy :: Class -> Type -> Mult -> Type -> Type -> TcM ClsInstResult doFunTy clas ty mult arg_ty ret_ty = return $ OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] @@ -658,7 +657,7 @@ doTyConApp clas ty tc kind_args | tyConIsTypeable tc = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) kind_args , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinTypeableInstance tc } | otherwise = return NoInstance @@ -690,7 +689,7 @@ doTyApp clas ty f tk | otherwise = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2) @@ -711,7 +710,7 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc mk_ev _ = panic "doTyLit" ; return (OneInst { cir_new_theta = [kc_pred] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) } {- Note [Typeable (T a b c)] @@ -946,7 +945,7 @@ matchHasField dflags short_cut clas tys ; keepAlive (greName gre) ; return OneInst { cir_new_theta = theta , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } } else matchInstEnv dflags short_cut clas tys } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -33,7 +33,6 @@ import GHC.Data.Bag import GHC.Core.Class import GHC.Core import GHC.Core.DataCon -import GHC.Core.InstEnv ( Coherence(IsCoherent) ) import GHC.Core.Make import GHC.Driver.DynFlags import GHC.Data.FastString @@ -612,7 +611,7 @@ solveImplicationUsingUnsatGiven go_simple ct = case ctEvidence ct of CtWanted { ctev_pred = pty, ctev_dest = dst } -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty - ; setWantedEvTerm dst IsCoherent $ EvExpr ev_expr } + ; setWantedEvTerm dst True $ EvExpr ev_expr } _ -> return () -- | Create an evidence expression for an arbitrary constraint using ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Hs.Type( HsIPName(..) ) import GHC.Core import GHC.Core.Type -import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) +import GHC.Core.InstEnv ( DFunInstType ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) @@ -184,7 +184,7 @@ solveCallStack ev ev_cs -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] = do { cs_tm <- evCallStack ev_cs ; let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) - ; setEvBindIfWanted ev IsCoherent ev_tm } + ; setEvBindIfWanted ev True ev_tm } {- Note [Shadowing of implicit parameters] @@ -394,7 +394,7 @@ solveEqualityDict ev cls tys ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ evDataConApp data_con tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } @@ -715,10 +715,10 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys -- the inert from the work-item or vice-versa. ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) - ; setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + ; setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) - ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) + ; setEvBindIfWanted ev_i True (ctEvTerm ev_w) ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } @@ -784,7 +784,7 @@ shortCutSolver dflags ev_w ev_i ; case inst_res of OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = what } | safeOverlap what , all isTyFamFree preds -- Note [Shortcut solving: type families] @@ -804,7 +804,7 @@ shortCutSolver dflags ev_w ev_i ; let ev_tm = mk_ev (map getEvExpr evc_vs) ev_binds' = extendEvBinds ev_binds $ - mkWantedEvBind (ctEvEvId ev) coherence ev_tm + mkWantedEvBind (ctEvEvId ev) canonical ev_tm ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ freshGoals evc_vs } @@ -847,7 +847,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls -- See Note [No Given/Given fundeps] | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached - = do { setEvBindIfWanted ev IsCoherent (ctEvTerm solved_ev) + = do { setEvBindIfWanted ev True (ctEvTerm solved_ev) ; stopWith ev "Dict/Top (cached)" } | otherwise -- Wanted, but not cached @@ -869,14 +869,14 @@ chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev - , cir_coherence = coherence }) + , cir_canonical = canonical }) = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) (ppr work_item) ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta - ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; setEvBindIfWanted work_item canonical (mk_ev (map getEvExpr evc_vars)) ; emitWorkNC (freshGoals evc_vars) ; stopWith work_item "Dict/Top (solved wanted)" } where @@ -1070,7 +1070,7 @@ matchLocalInst pred loc -> do { let result = OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = LocalInstance } ; traceTcS "Best local instance found:" $ vcat [ text "pred:" <+> ppr pred @@ -1317,7 +1317,7 @@ last_resort inerts (DictCt { di_ev = ev_w, di_cls = cls, di_tys = xis }) , Just ct_i <- lookupInertDict inerts loc_w cls xis , let ev_i = dictCtEvidence ct_i , isGiven ev_i - = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + = do { setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ TcRnLoopySuperclassSolve loc_w (ctEvPred ev_w) ; return $ Stop ev_w (text "Loopy superclass") } @@ -2158,4 +2158,3 @@ constraints. See also Note [Evidence for quantified constraints] in GHC.Core.Predicate. -} - ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -32,7 +32,7 @@ import GHC.Core.Coercion import GHC.Core.Coercion.Axiom import GHC.Core.Reduction import GHC.Core.Unify( tcUnifyTyWithTFs ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Core.FamInstEnv ( FamInstEnvs, FamInst(..), apartnessCheck , lookupFamInstEnvByTyCon ) import GHC.Core @@ -357,7 +357,7 @@ can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ -- Literals can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ | l1 == l2 - = do { setEvBindIfWanted ev IsCoherent (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) + = do { setEvBindIfWanted ev True (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } -- Decompose FunTy: (s -> t) and (c => t) @@ -1847,7 +1847,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Provide Refl evidence for the constraint -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted new_ev IsCoherent $ + ; setEvBindIfWanted new_ev True $ evCoercion (mkNomReflCo final_rhs) -- Kick out any constraints that can now be rewritten @@ -1958,7 +1958,7 @@ canEqReflexive :: CtEvidence -- ty ~ ty -> TcType -- ty -> TcS (StopOrContinue a) -- always Stop canEqReflexive ev eq_rel ty - = do { setEvBindIfWanted ev IsCoherent $ + = do { setEvBindIfWanted ev True $ evCoercion (mkReflCo (eqRelRole eq_rel) ty) ; stopWith ev "Solved by reflexivity" } @@ -2541,7 +2541,7 @@ tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item - -> do { setEvBindIfWanted ev IsCoherent $ + -> do { setEvBindIfWanted ev True $ evCoercion (maybeSymCo swapped $ downgradeRole (eqRelRole eq_rel) (ctEvRole ev_i) ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -15,7 +15,6 @@ import GHC.Tc.Solver.Monad import GHC.Tc.Types.Evidence import GHC.Core.Coercion -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Types.Basic( SwapFlag(..) ) @@ -74,9 +73,9 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) + KeepInert -> do { setEvBindIfWanted ev_w True (swap_me swap ev_i) ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } - KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) + KeepWork -> do { setEvBindIfWanted ev_i True (swap_me swap ev_w) ; updInertCans (updIrreds (\_ -> others)) ; continueWith () } } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1688,19 +1688,19 @@ setWantedEq (HoleDest hole) co setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) -- | Good for both equalities and non-equalities -setWantedEvTerm :: TcEvDest -> Coherence -> EvTerm -> TcS () -setWantedEvTerm (HoleDest hole) _coherence tm +setWantedEvTerm :: TcEvDest -> Canonical -> EvTerm -> TcS () +setWantedEvTerm (HoleDest hole) _canonical tm | Just co <- evTermCoercion_maybe tm = do { useVars (coVarsOfCo co) ; fillCoercionHole hole co } | otherwise = -- See Note [Yukky eq_sel for a HoleDest] do { let co_var = coHoleCoVar hole - ; setEvBind (mkWantedEvBind co_var IsCoherent tm) + ; setEvBind (mkWantedEvBind co_var True tm) ; fillCoercionHole hole (mkCoVarCo co_var) } -setWantedEvTerm (EvVarDest ev_id) coherence tm - = setEvBind (mkWantedEvBind ev_id coherence tm) +setWantedEvTerm (EvVarDest ev_id) canonical tm + = setEvBind (mkWantedEvBind ev_id canonical tm) {- Note [Yukky eq_sel for a HoleDest] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1726,10 +1726,10 @@ fillCoercionHole hole co = do { wrapTcS $ TcM.fillCoercionHole hole co ; kickOutAfterFillingCoercionHole hole } -setEvBindIfWanted :: CtEvidence -> Coherence -> EvTerm -> TcS () -setEvBindIfWanted ev coherence tm +setEvBindIfWanted :: CtEvidence -> Canonical -> EvTerm -> TcS () +setEvBindIfWanted ev canonical tm = case ev of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest coherence tm + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest canonical tm _ -> return () newTcEvBinds :: TcS EvBindsVar ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -20,7 +20,6 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate import GHC.Core.Reduction import GHC.Core.Coercion @@ -427,7 +426,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars , et_binds = ev_binds, et_body = w_id } @@ -556,7 +555,7 @@ finish_rewrite ev@(CtWanted { ctev_dest = dest (Reduction co new_pred) new_rewriters = do { mb_new_ev <- newWanted loc rewriters' new_pred ; massert (coercionRole co == ctEvRole ev) - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ mkEvCast (getEvExpr mb_new_ev) (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) ; case mb_new_ev of @@ -631,7 +630,7 @@ runTcPluginsWanted wc@(WC { wc_simple = simples1 }) where setEv :: (EvTerm,Ct) -> TcS () setEv (ev,ct) = case ctEvidence ct of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest IsCoherent ev -- TODO: plugins should be able to signal non-coherence + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest True ev -- TODO: plugins should be able to signal non-canonicity _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" -- | A pair of (given, wanted) constraints to pass to plugins ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1482,7 +1482,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_top_name <- newName (mkSuperDictAuxOcc n (getOccName cls)) ; sc_ev_id <- newEvVar sc_pred - ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id True sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred sc_top_id = mkLocalId sc_top_name ManyTy sc_top_ty export = ABE { abe_wrap = idHsWrapper ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Types.Basic import GHC.Core import GHC.Core.Class (Class, classSCSelId ) import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Utils.Misc import GHC.Utils.Panic @@ -451,7 +451,7 @@ instance Outputable EvBindMap where data EvBindInfo = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver } - | EvBindWanted { ebi_coherence :: Coherence -- See Note [Desugaring incoherent evidence] + | EvBindWanted { ebi_canonical :: Canonical -- See Note [Desugaring non-canonical evidence] } ----------------- @@ -465,7 +465,7 @@ data EvBind evBindVar :: EvBind -> EvVar evBindVar = eb_lhs -mkWantedEvBind :: EvVar -> Coherence -> EvTerm -> EvBind +mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind mkWantedEvBind ev c tm = EvBind { eb_info = EvBindWanted c, eb_lhs = ev, eb_rhs = tm } -- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, RecursiveDo #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -820,16 +821,27 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt LangExt.OverlappingInstances dflags - incoherent_ok = xopt LangExt.IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags + noncanonical_incoherence = not $ gopt Opt_SpecialiseIncoherents dflags + use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent NoSourceText) | overlap_ok = use (Overlaps NoSourceText) | otherwise = use (NoOverlap NoSourceText) - final_oflag = setOverlapModeMaybe default_oflag overlap_mode + oflag = setOverlapModeMaybe default_oflag overlap_mode + final_oflag = effective_oflag noncanonical_incoherence oflag ; return final_oflag } + where + effective_oflag noncanonical_incoherence oflag at OverlapFlag{ overlapMode = overlap_mode } + = oflag { overlapMode = effective_overlap_mode noncanonical_incoherence overlap_mode } + + effective_overlap_mode noncanonical_incoherence = \case + Incoherent s | noncanonical_incoherence -> NonCanonical s + overlap_mode -> overlap_mode + tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -332,6 +332,7 @@ cvtDec (InstanceD o ctxt ty decs) TH.Overlappable -> Hs.Overlappable (SourceText $ fsLit "OVERLAPPABLE") TH.Overlapping -> Hs.Overlapping (SourceText $ fsLit "OVERLAPPING") TH.Incoherent -> Hs.Incoherent (SourceText $ fsLit "INCOHERENT") + TH.NonCanonical -> Hs.NonCanonical (SourceText $ fsLit "NONCANONICAL") ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, - hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, + hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag, Boxity(..), isBoxed, @@ -628,6 +628,7 @@ hasIncoherentFlag :: OverlapMode -> Bool hasIncoherentFlag mode = case mode of Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappableFlag :: OverlapMode -> Bool @@ -636,6 +637,7 @@ hasOverlappableFlag mode = Overlappable _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappingFlag :: OverlapMode -> Bool @@ -644,8 +646,14 @@ hasOverlappingFlag mode = Overlapping _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False +hasNonCanonicalFlag :: OverlapMode -> Bool +hasNonCanonicalFlag = \case + NonCanonical{} -> True + _ -> False + data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv = NoOverlap SourceText -- See Note [Pragma source text] @@ -700,6 +708,8 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv -- instantiating 'b' would change which instance -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv" + | NonCanonical SourceText + deriving (Eq, Data) @@ -712,6 +722,7 @@ instance Outputable OverlapMode where ppr (Overlapping _) = text "[overlapping]" ppr (Overlaps _) = text "[overlap ok]" ppr (Incoherent _) = text "[incoherent]" + ppr (NonCanonical _) = text "[noncanonical]" instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s @@ -719,6 +730,7 @@ instance Binary OverlapMode where put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s + put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s get bh = do h <- getByte bh case h of @@ -727,6 +739,7 @@ instance Binary OverlapMode where 2 -> (get bh) >>= \s -> return $ Incoherent s 3 -> (get bh) >>= \s -> return $ Overlapping s 4 -> (get bh) >>= \s -> return $ Overlappable s + 5 -> (get bh) >>= \s -> return $ NonCanonical s _ -> panic ("get OverlapMode" ++ show h) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -2512,6 +2512,8 @@ data Overlap = Overlappable -- ^ May be overlapped by more specific instances | Incoherent -- ^ Both 'Overlapping' and 'Overlappable', and -- pick an arbitrary one if multiple choices are -- available. + | NonCanonical -- ^ Incoherent, and different instance choices + -- can lead to different observable behaviour. deriving( Show, Eq, Ord, Data, Generic ) -- | A single @deriving@ clause at the end of a datatype. ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/069083dc32a98e7a94a05b85ce3482474dd50c96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/069083dc32a98e7a94a05b85ce3482474dd50c96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 02:32:12 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 05 Jul 2023 22:32:12 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to enable/disable incoherent instances Message-ID: <64a627ac2eb89_1849791ad306c4079b@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: ab927106 by Gergő Érdi at 2023-07-06T03:23:54+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 21 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/Basic.hs - testsuite/tests/simplCore/should_run/T22448.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -11,7 +11,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv. module GHC.Core.InstEnv ( DFunId, InstMatch, ClsInstLookupResult, - Coherence(..), PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, + Canonical, PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst, @@ -122,10 +122,11 @@ fuzzyClsInstCmp x y = cmp (RM_KnownTc _, RM_WildCard) = GT cmp (RM_KnownTc x, RM_KnownTc y) = stableNameCmp x y -isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool +isOverlappable, isOverlapping, isIncoherent, isNonCanonical :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i)) isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i)) +isNonCanonical i = hasNonCanonicalFlag (overlapMode (is_flag i)) {- Note [ClsInst laziness and the rough-match fields] @@ -812,8 +813,33 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. But sometimes that is +fine, because the programmer promises that it doesn't matter which one is +chosen. A good example is in the `optics` library: + + data IxEq i is js where { IxEq :: IxEq i is is } + + class AppendIndices xs ys ks | xs ys -> ks where + appendIndices :: IxEq i (Curry xs (Curry ys i)) (Curry ks i) + + instance {-# INCOHERENT #-} xs ~ zs => AppendIndices xs '[] zs where + appendIndices = IxEq + + instance ys ~ zs => AppendIndices '[] ys zs where + appendIndices = IxEq + +Here `xs` and `ys` are type-level lists, and for type inference purposes we want to +solve the `AppendIndices` constraint when /either/ of them are the empty list. The +dictionaries are the same in both cases (indeed the dictionary type is a singleton!), +so we really don't care which is used. See #23287 for discussion. + +In short, sometimes we want to specialise on these incoherently-selected dictionaries, +and sometimes we don't. It would be best to have a per-instance pragma, but for now +we have a global flag. The flag `-fspecialise-incoherents` (on by default) selects +enables specialisation on incoherent evidence (as has been the case previously). +The rest of this note describes what happens with `-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -850,7 +876,7 @@ Here are the moving parts: * `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into (nospec f d) if `d` is incoherent. It has to do a dependency analysis to determine transitive dependencies, but we need to do that anyway. - See Note [Desugaring incoherent evidence] in GHC.HsToCore.Binds. + See Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds. See also Note [nospecId magic] in GHC.Types.Id.Make. -} @@ -955,10 +981,10 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +type Canonical = Bool -- See Note [Recording coherence information in `PotentialUnifiers`] -data PotentialUnifiers = NoUnifiers Coherence +data PotentialUnifiers = NoUnifiers Canonical | OneOrMoreUnifiers (NonEmpty ClsInst) -- This list is lazy as we only look at all the unifiers when -- printing an error message. It can be expensive to compute all @@ -980,20 +1006,12 @@ So we only need the `Coherent` flag in the case where the set of potential unifiers is otherwise empty. -} -instance Outputable Coherence where - ppr IsCoherent = text "coherent" - ppr IsIncoherent = text "incoherent" - instance Outputable PotentialUnifiers where - ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c + ppr (NoUnifiers c) = text "NoUnifiers" <+> if c then text "canonical" else text "non-canonical" ppr xs = ppr (getPotentialUnifiers xs) -instance Semigroup Coherence where - IsCoherent <> IsCoherent = IsCoherent - _ <> _ = IsIncoherent - instance Semigroup PotentialUnifiers where - NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 <> c2) + NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 && c2) NoUnifiers _ <> u = u OneOrMoreUnifiers (unifier :| unifiers) <> u = OneOrMoreUnifiers (unifier :| (unifiers <> getPotentialUnifiers u)) @@ -1039,22 +1057,24 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys = acc - incoherently_matched :: PotentialUnifiers -> PotentialUnifiers - incoherently_matched (NoUnifiers _) = NoUnifiers IsIncoherent - incoherently_matched u = u + noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers + noncanonically_matched (NoUnifiers _) = NoUnifiers False + noncanonically_matched u = u check_unifier :: [ClsInst] -> PotentialUnifiers - check_unifier [] = NoUnifiers IsCoherent + check_unifier [] = NoUnifiers True check_unifier (item at ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items) | not (instIsVisible vis_mods item) = check_unifier items -- See Note [Instance lookup and orphan instances] | Just {} <- tcMatchTys tpl_tys tys = check_unifier items -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] + -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview] + | isNonCanonical item + = noncanonically_matched $ check_unifier items -- Ignore ones that are incoherent: Note [Incoherent instances] - -- Record that we encountered incoherent instances: Note [Coherence and specialisation: overview] | isIncoherent item - = incoherently_matched $ check_unifier items + = check_unifier items | otherwise = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set) @@ -1111,7 +1131,7 @@ lookupInstEnv check_overlap_safe -- If the selected match is incoherent, discard all unifiers final_unifs = case final_matches of - (m:_) | isIncoherent (fst m) -> NoUnifiers IsCoherent + (m:_) | isIncoherent (fst m) -> NoUnifiers True _ -> all_unifs -- Note [Safe Haskell isSafeOverlap] ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Hs -- lots of things import GHC.Core -- lots of things import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Core.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( etaExpand ) @@ -1152,14 +1152,14 @@ evidence that is used in `e`. This question arose when thinking about deep subsumption; see https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649). -Note [Desugaring incoherent evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the evidence is coherent, we desugar WpEvApp by simply passing +Note [Desugaring non-canonical evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the evidence is canonical, we desugar WpEvApp by simply passing core_tm directly to k: k core_tm -If the evidence is not coherent, we mark the application with nospec: +If the evidence is not canonical, we mark the application with nospec: nospec @(cls => a) k core_tm @@ -1170,14 +1170,14 @@ of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). See Note [Coherence and specialisation: overview] for why we shouldn't specialise incoherent evidence. -We can find out if a given evidence is coherent or not during the -desugaring of its WpLet wrapper: an evidence is incoherent if its +We can find out if a given evidence is canonical or not during the +desugaring of its WpLet wrapper: an evidence is non-canonical if its own resolution was incoherent (see Note [Incoherent instances]), or -if its definition refers to other incoherent evidence. dsEvBinds is +if its definition refers to other non-canonical evidence. dsEvBinds is the convenient place to compute this, since it already needs to do inter-evidence dependency analysis to generate well-scoped -bindings. We then record this coherence information in the -dsl_coherence field of DsM's local environment. +bindings. We then record this specialisability information in the +dsl_unspecables field of DsM's local environment. -} @@ -1201,20 +1201,27 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring non-canonical evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } +-- We are about to construct an evidence application `f dict`. If the dictionary is +-- non-specialisable, instead construct +-- nospec f dict +-- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1232,7 +1239,7 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- * Desugars the ev_binds, sorts them into dependency order, and -- passes the resulting [CoreBind] to thing_inside --- * Extends the DsM (dsl_coherence field) with coherence information +-- * Extends the DsM (dsl_unspecable field) with specialisability information -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside @@ -1240,53 +1247,50 @@ dsEvBinds ev_binds thing_inside ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where - go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a + go ::[SCC (Node EvVar (Canonical, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False - - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where - ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + ((v, rhs), (this_canonical, deps)) = unpack_node node + transitively_unspecable = not this_canonical || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where - (pairs, direct_coherence) = unzip $ map unpack_node nodes + (pairs, direct_canonicity) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not this_canonical || any is_unspecable_remote deps | (this_canonical, deps) <- direct_canonicity ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring non-canonical evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty - unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) + unpack_node DigraphNode { node_key = v, node_payload = (canonical, rhs), node_dependencies = deps } = ((v, rhs), (canonical, deps)) -sort_ev_binds :: Bag (Id, Coherence, CoreExpr) -> [SCC (Node EvVar (Coherence, CoreExpr))] +sort_ev_binds :: Bag (Id, Canonical, CoreExpr) -> [SCC (Node EvVar (Canonical, CoreExpr))] -- We do SCC analysis of the evidence bindings, /after/ desugaring -- them. This is convenient: it means we can use the GHC.Core -- free-variable functions rather than having to do accurate free vars -- for EvTerm. sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges where - edges :: [ Node EvVar (Coherence, CoreExpr) ] + edges :: [ Node EvVar (Canonical, CoreExpr) ] edges = foldr ((:) . mk_node) [] ds_binds - mk_node :: (Id, Coherence, CoreExpr) -> Node EvVar (Coherence, CoreExpr) - mk_node (var, coherence, rhs) - = DigraphNode { node_payload = (coherence, rhs) + mk_node :: (Id, Canonical, CoreExpr) -> Node EvVar (Canonical, CoreExpr) + mk_node (var, canonical, rhs) + = DigraphNode { node_payload = (canonical, rhs) , node_key = var , node_dependencies = nonDetEltsUniqSet $ exprFreeVars rhs `unionVarSet` @@ -1295,13 +1299,13 @@ sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges -- is still deterministic even if the edges are in nondeterministic order -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. -dsEvBind :: EvBind -> DsM (Id, Coherence, CoreExpr) +dsEvBind :: EvBind -> DsM (Id, Canonical, CoreExpr) dsEvBind (EvBind { eb_lhs = v, eb_rhs = r, eb_info = info }) = do e <- dsEvTerm r - let coherence = case info of - EvBindGiven{} -> IsCoherent - EvBindWanted{ ebi_coherence = coherence } -> coherence - return (v, coherence, e) + let canonical = case info of + EvBindGiven{} -> True + EvBindWanted{ ebi_canonical = canonical } -> canonical + return (v, canonical, e) {-********************************************************************** ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -357,7 +357,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +413,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -79,9 +79,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar - -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + , dsl_unspecables :: S.Set EvVar + -- ^ See Note [Desugaring non-canonical evidence]: this field collects + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1212,11 +1212,11 @@ addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty ; case dest of EvVarDest evar - -> addTcEvBind ev_binds_var $ mkWantedEvBind evar IsCoherent err_tm + -> addTcEvBind ev_binds_var $ mkWantedEvBind evar True err_tm HoleDest hole -> do { -- See Note [Deferred errors for coercion holes] let co_var = coHoleCoVar hole - ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var IsCoherent err_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var True err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2514,6 +2514,7 @@ reifyClassInstance is_poly_tvs i Overlapping _ -> Just TH.Overlapping Overlaps _ -> Just TH.Overlaps Incoherent _ -> Just TH.Incoherent + NonCanonical _ -> Just TH.Incoherent ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -92,7 +92,7 @@ data ClsInstResult | OneInst { cir_new_theta :: [TcPredType] , cir_mk_ev :: [EvExpr] -> EvTerm - , cir_coherence :: Coherence -- See Note [Coherence and specialisation: overview] + , cir_canonical :: Canonical -- See Note [Coherence and specialisation: overview] , cir_what :: InstanceWhat } | NotSure -- Multiple matches and/or one or more unifiers @@ -162,7 +162,7 @@ matchInstEnv dflags short_cut_solver clas tys ; return NoInstance } -- A single match (& no safe haskell failure) - ([(ispec, inst_tys)], NoUnifiers coherence, False) + ([(ispec, inst_tys)], NoUnifiers canonical, False) | short_cut_solver -- Called from the short-cut solver , isOverlappable ispec -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT @@ -175,12 +175,11 @@ matchInstEnv dflags short_cut_solver clas tys | otherwise -> do { let dfun_id = instanceDFunId ispec ; traceTc "matchClass success" $ - vcat [text "dict" <+> ppr pred, - ppr coherence, + vcat [text "dict" <+> ppr pred <+> parens (if canonical then text "canonical" else text "non-canonical"), text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ] -- Record that this dfun is needed - ; match_one (null unsafeOverlaps) coherence dfun_id inst_tys } + ; match_one (null unsafeOverlaps) canonical dfun_id inst_tys } -- More than one matches (or Safe Haskell fail!). Defer any -- reactions of a multitude until we learn more about the reagent @@ -191,15 +190,15 @@ matchInstEnv dflags short_cut_solver clas tys where pred = mkClassPred clas tys -match_one :: SafeOverlapping -> Coherence -> DFunId -> [DFunInstType] -> TcM ClsInstResult +match_one :: SafeOverlapping -> Canonical -> DFunId -> [DFunInstType] -> TcM ClsInstResult -- See Note [DFunInstType: instantiating types] in GHC.Core.InstEnv -match_one so coherence dfun_id mb_inst_tys +match_one so canonical dfun_id mb_inst_tys = do { traceTc "match_one" (ppr dfun_id $$ ppr mb_inst_tys) ; (tys, theta) <- instDFunType dfun_id mb_inst_tys ; traceTc "match_one 2" (ppr dfun_id $$ ppr tys $$ ppr theta) ; return $ OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = TopLevInstance { iw_dfun_id = dfun_id , iw_safe_over = so } } } @@ -235,7 +234,7 @@ matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys , cir_mk_ev = tuple_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! where @@ -399,7 +398,7 @@ makeLitDict clas ty et , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) = return $ OneInst { cir_new_theta = [] , cir_mk_ev = \_ -> ev_tm - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } | otherwise @@ -448,7 +447,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_canonical = False -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } @@ -555,7 +554,7 @@ Some further observations about `withDict`: k (sv |> (sub co2 ; sym co))) That is, we cast the method using a coercion, and apply k to - it. Moreover, we mark the evidence as incoherent, resulting in + it. Moreover, we mark the evidence as non-canonical, resulting in the use of the 'nospec' magicId (see Note [nospecId magic] in GHC.Types.Id.Make) to ensure that the typeclass specialiser doesn't incorrectly common-up distinct evidence terms. This is @@ -641,7 +640,7 @@ doFunTy :: Class -> Type -> Mult -> Type -> Type -> TcM ClsInstResult doFunTy clas ty mult arg_ty ret_ty = return $ OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] @@ -658,7 +657,7 @@ doTyConApp clas ty tc kind_args | tyConIsTypeable tc = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) kind_args , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinTypeableInstance tc } | otherwise = return NoInstance @@ -690,7 +689,7 @@ doTyApp clas ty f tk | otherwise = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2) @@ -711,7 +710,7 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc mk_ev _ = panic "doTyLit" ; return (OneInst { cir_new_theta = [kc_pred] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) } {- Note [Typeable (T a b c)] @@ -946,7 +945,7 @@ matchHasField dflags short_cut clas tys ; keepAlive (greName gre) ; return OneInst { cir_new_theta = theta , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } } else matchInstEnv dflags short_cut clas tys } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -33,7 +33,6 @@ import GHC.Data.Bag import GHC.Core.Class import GHC.Core import GHC.Core.DataCon -import GHC.Core.InstEnv ( Coherence(IsCoherent) ) import GHC.Core.Make import GHC.Driver.DynFlags import GHC.Data.FastString @@ -612,7 +611,7 @@ solveImplicationUsingUnsatGiven go_simple ct = case ctEvidence ct of CtWanted { ctev_pred = pty, ctev_dest = dst } -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty - ; setWantedEvTerm dst IsCoherent $ EvExpr ev_expr } + ; setWantedEvTerm dst True $ EvExpr ev_expr } _ -> return () -- | Create an evidence expression for an arbitrary constraint using ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Hs.Type( HsIPName(..) ) import GHC.Core import GHC.Core.Type -import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) +import GHC.Core.InstEnv ( DFunInstType ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) @@ -184,7 +184,7 @@ solveCallStack ev ev_cs -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] = do { cs_tm <- evCallStack ev_cs ; let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) - ; setEvBindIfWanted ev IsCoherent ev_tm } + ; setEvBindIfWanted ev True ev_tm } {- Note [Shadowing of implicit parameters] @@ -394,7 +394,7 @@ solveEqualityDict ev cls tys ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ evDataConApp data_con tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } @@ -715,10 +715,10 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys -- the inert from the work-item or vice-versa. ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) - ; setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + ; setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) - ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) + ; setEvBindIfWanted ev_i True (ctEvTerm ev_w) ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } @@ -784,7 +784,7 @@ shortCutSolver dflags ev_w ev_i ; case inst_res of OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = what } | safeOverlap what , all isTyFamFree preds -- Note [Shortcut solving: type families] @@ -804,7 +804,7 @@ shortCutSolver dflags ev_w ev_i ; let ev_tm = mk_ev (map getEvExpr evc_vs) ev_binds' = extendEvBinds ev_binds $ - mkWantedEvBind (ctEvEvId ev) coherence ev_tm + mkWantedEvBind (ctEvEvId ev) canonical ev_tm ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ freshGoals evc_vs } @@ -847,7 +847,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls -- See Note [No Given/Given fundeps] | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached - = do { setEvBindIfWanted ev IsCoherent (ctEvTerm solved_ev) + = do { setEvBindIfWanted ev True (ctEvTerm solved_ev) ; stopWith ev "Dict/Top (cached)" } | otherwise -- Wanted, but not cached @@ -869,14 +869,14 @@ chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev - , cir_coherence = coherence }) + , cir_canonical = canonical }) = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) (ppr work_item) ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta - ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; setEvBindIfWanted work_item canonical (mk_ev (map getEvExpr evc_vars)) ; emitWorkNC (freshGoals evc_vars) ; stopWith work_item "Dict/Top (solved wanted)" } where @@ -1070,7 +1070,7 @@ matchLocalInst pred loc -> do { let result = OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = LocalInstance } ; traceTcS "Best local instance found:" $ vcat [ text "pred:" <+> ppr pred @@ -1317,7 +1317,7 @@ last_resort inerts (DictCt { di_ev = ev_w, di_cls = cls, di_tys = xis }) , Just ct_i <- lookupInertDict inerts loc_w cls xis , let ev_i = dictCtEvidence ct_i , isGiven ev_i - = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + = do { setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ TcRnLoopySuperclassSolve loc_w (ctEvPred ev_w) ; return $ Stop ev_w (text "Loopy superclass") } @@ -2158,4 +2158,3 @@ constraints. See also Note [Evidence for quantified constraints] in GHC.Core.Predicate. -} - ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -32,7 +32,6 @@ import GHC.Core.Coercion import GHC.Core.Coercion.Axiom import GHC.Core.Reduction import GHC.Core.Unify( tcUnifyTyWithTFs ) -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.FamInstEnv ( FamInstEnvs, FamInst(..), apartnessCheck , lookupFamInstEnvByTyCon ) import GHC.Core @@ -357,7 +356,7 @@ can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ -- Literals can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ | l1 == l2 - = do { setEvBindIfWanted ev IsCoherent (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) + = do { setEvBindIfWanted ev True (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } -- Decompose FunTy: (s -> t) and (c => t) @@ -1847,7 +1846,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Provide Refl evidence for the constraint -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted new_ev IsCoherent $ + ; setEvBindIfWanted new_ev True $ evCoercion (mkNomReflCo final_rhs) -- Kick out any constraints that can now be rewritten @@ -1958,7 +1957,7 @@ canEqReflexive :: CtEvidence -- ty ~ ty -> TcType -- ty -> TcS (StopOrContinue a) -- always Stop canEqReflexive ev eq_rel ty - = do { setEvBindIfWanted ev IsCoherent $ + = do { setEvBindIfWanted ev True $ evCoercion (mkReflCo (eqRelRole eq_rel) ty) ; stopWith ev "Solved by reflexivity" } @@ -2541,7 +2540,7 @@ tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item - -> do { setEvBindIfWanted ev IsCoherent $ + -> do { setEvBindIfWanted ev True $ evCoercion (maybeSymCo swapped $ downgradeRole (eqRelRole eq_rel) (ctEvRole ev_i) @@ -3188,4 +3187,4 @@ To avoid this situation we do not cache as solved any workitems (or inert) which did not really made a 'step' towards proving some goal. Solved's are just an optimization so we don't lose anything in terms of completeness of solving. --} \ No newline at end of file +-} ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -15,7 +15,6 @@ import GHC.Tc.Solver.Monad import GHC.Tc.Types.Evidence import GHC.Core.Coercion -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Types.Basic( SwapFlag(..) ) @@ -74,9 +73,9 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) + KeepInert -> do { setEvBindIfWanted ev_w True (swap_me swap ev_i) ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } - KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) + KeepWork -> do { setEvBindIfWanted ev_i True (swap_me swap ev_w) ; updInertCans (updIrreds (\_ -> others)) ; continueWith () } } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1688,19 +1688,19 @@ setWantedEq (HoleDest hole) co setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) -- | Good for both equalities and non-equalities -setWantedEvTerm :: TcEvDest -> Coherence -> EvTerm -> TcS () -setWantedEvTerm (HoleDest hole) _coherence tm +setWantedEvTerm :: TcEvDest -> Canonical -> EvTerm -> TcS () +setWantedEvTerm (HoleDest hole) _canonical tm | Just co <- evTermCoercion_maybe tm = do { useVars (coVarsOfCo co) ; fillCoercionHole hole co } | otherwise = -- See Note [Yukky eq_sel for a HoleDest] do { let co_var = coHoleCoVar hole - ; setEvBind (mkWantedEvBind co_var IsCoherent tm) + ; setEvBind (mkWantedEvBind co_var True tm) ; fillCoercionHole hole (mkCoVarCo co_var) } -setWantedEvTerm (EvVarDest ev_id) coherence tm - = setEvBind (mkWantedEvBind ev_id coherence tm) +setWantedEvTerm (EvVarDest ev_id) canonical tm + = setEvBind (mkWantedEvBind ev_id canonical tm) {- Note [Yukky eq_sel for a HoleDest] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1726,10 +1726,10 @@ fillCoercionHole hole co = do { wrapTcS $ TcM.fillCoercionHole hole co ; kickOutAfterFillingCoercionHole hole } -setEvBindIfWanted :: CtEvidence -> Coherence -> EvTerm -> TcS () -setEvBindIfWanted ev coherence tm +setEvBindIfWanted :: CtEvidence -> Canonical -> EvTerm -> TcS () +setEvBindIfWanted ev canonical tm = case ev of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest coherence tm + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest canonical tm _ -> return () newTcEvBinds :: TcS EvBindsVar ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -20,7 +20,6 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate import GHC.Core.Reduction import GHC.Core.Coercion @@ -427,7 +426,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars , et_binds = ev_binds, et_body = w_id } @@ -556,7 +555,7 @@ finish_rewrite ev@(CtWanted { ctev_dest = dest (Reduction co new_pred) new_rewriters = do { mb_new_ev <- newWanted loc rewriters' new_pred ; massert (coercionRole co == ctEvRole ev) - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ mkEvCast (getEvExpr mb_new_ev) (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) ; case mb_new_ev of @@ -631,7 +630,7 @@ runTcPluginsWanted wc@(WC { wc_simple = simples1 }) where setEv :: (EvTerm,Ct) -> TcS () setEv (ev,ct) = case ctEvidence ct of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest IsCoherent ev -- TODO: plugins should be able to signal non-coherence + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest True ev -- TODO: plugins should be able to signal non-canonicity _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" -- | A pair of (given, wanted) constraints to pass to plugins ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1482,7 +1482,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_top_name <- newName (mkSuperDictAuxOcc n (getOccName cls)) ; sc_ev_id <- newEvVar sc_pred - ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id True sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred sc_top_id = mkLocalId sc_top_name ManyTy sc_top_ty export = ABE { abe_wrap = idHsWrapper ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Types.Basic import GHC.Core import GHC.Core.Class (Class, classSCSelId ) import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Utils.Misc import GHC.Utils.Panic @@ -451,7 +451,7 @@ instance Outputable EvBindMap where data EvBindInfo = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver } - | EvBindWanted { ebi_coherence :: Coherence -- See Note [Desugaring incoherent evidence] + | EvBindWanted { ebi_canonical :: Canonical -- See Note [Desugaring non-canonical evidence] } ----------------- @@ -465,7 +465,7 @@ data EvBind evBindVar :: EvBind -> EvVar evBindVar = eb_lhs -mkWantedEvBind :: EvVar -> Coherence -> EvTerm -> EvBind +mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind mkWantedEvBind ev c tm = EvBind { eb_info = EvBindWanted c, eb_lhs = ev, eb_rhs = tm } -- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, RecursiveDo #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -820,16 +821,27 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt LangExt.OverlappingInstances dflags - incoherent_ok = xopt LangExt.IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags + noncanonical_incoherence = not $ gopt Opt_SpecialiseIncoherents dflags + use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent NoSourceText) | overlap_ok = use (Overlaps NoSourceText) | otherwise = use (NoOverlap NoSourceText) - final_oflag = setOverlapModeMaybe default_oflag overlap_mode + oflag = setOverlapModeMaybe default_oflag overlap_mode + final_oflag = effective_oflag noncanonical_incoherence oflag ; return final_oflag } + where + effective_oflag noncanonical_incoherence oflag at OverlapFlag{ overlapMode = overlap_mode } + = oflag { overlapMode = effective_overlap_mode noncanonical_incoherence overlap_mode } + + effective_overlap_mode noncanonical_incoherence = \case + Incoherent s | noncanonical_incoherence -> NonCanonical s + overlap_mode -> overlap_mode + tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, - hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, + hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag, Boxity(..), isBoxed, @@ -628,6 +628,7 @@ hasIncoherentFlag :: OverlapMode -> Bool hasIncoherentFlag mode = case mode of Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappableFlag :: OverlapMode -> Bool @@ -636,6 +637,7 @@ hasOverlappableFlag mode = Overlappable _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappingFlag :: OverlapMode -> Bool @@ -644,8 +646,14 @@ hasOverlappingFlag mode = Overlapping _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False +hasNonCanonicalFlag :: OverlapMode -> Bool +hasNonCanonicalFlag = \case + NonCanonical{} -> True + _ -> False + data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv = NoOverlap SourceText -- See Note [Pragma source text] @@ -700,6 +708,8 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv -- instantiating 'b' would change which instance -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv" + | NonCanonical SourceText + deriving (Eq, Data) @@ -712,6 +722,7 @@ instance Outputable OverlapMode where ppr (Overlapping _) = text "[overlapping]" ppr (Overlaps _) = text "[overlap ok]" ppr (Incoherent _) = text "[incoherent]" + ppr (NonCanonical _) = text "[noncanonical]" instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s @@ -719,6 +730,7 @@ instance Binary OverlapMode where put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s + put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s get bh = do h <- getByte bh case h of @@ -727,6 +739,7 @@ instance Binary OverlapMode where 2 -> (get bh) >>= \s -> return $ Incoherent s 3 -> (get bh) >>= \s -> return $ Overlapping s 4 -> (get bh) >>= \s -> return $ Overlappable s + 5 -> (get bh) >>= \s -> return $ NonCanonical s _ -> panic ("get OverlapMode" ++ show h) ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab927106994ae2fa86ca199ca7678ad46bc28370 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ab927106994ae2fa86ca199ca7678ad46bc28370 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 02:33:27 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 05 Jul 2023 22:33:27 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to enable/disable incoherent instances Message-ID: <64a627f7ba7ee_1849791ad306c411dd@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 7c7d6738 by Gergő Érdi at 2023-07-06T03:33:07+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 23 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/Basic.hs - testsuite/tests/simplCore/should_run/T22448.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -11,7 +11,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv. module GHC.Core.InstEnv ( DFunId, InstMatch, ClsInstLookupResult, - Coherence(..), PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, + Canonical, PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst, @@ -122,10 +122,11 @@ fuzzyClsInstCmp x y = cmp (RM_KnownTc _, RM_WildCard) = GT cmp (RM_KnownTc x, RM_KnownTc y) = stableNameCmp x y -isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool +isOverlappable, isOverlapping, isIncoherent, isNonCanonical :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i)) isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i)) +isNonCanonical i = hasNonCanonicalFlag (overlapMode (is_flag i)) {- Note [ClsInst laziness and the rough-match fields] @@ -812,8 +813,33 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. But sometimes that is +fine, because the programmer promises that it doesn't matter which one is +chosen. A good example is in the `optics` library: + + data IxEq i is js where { IxEq :: IxEq i is is } + + class AppendIndices xs ys ks | xs ys -> ks where + appendIndices :: IxEq i (Curry xs (Curry ys i)) (Curry ks i) + + instance {-# INCOHERENT #-} xs ~ zs => AppendIndices xs '[] zs where + appendIndices = IxEq + + instance ys ~ zs => AppendIndices '[] ys zs where + appendIndices = IxEq + +Here `xs` and `ys` are type-level lists, and for type inference purposes we want to +solve the `AppendIndices` constraint when /either/ of them are the empty list. The +dictionaries are the same in both cases (indeed the dictionary type is a singleton!), +so we really don't care which is used. See #23287 for discussion. + +In short, sometimes we want to specialise on these incoherently-selected dictionaries, +and sometimes we don't. It would be best to have a per-instance pragma, but for now +we have a global flag. The flag `-fspecialise-incoherents` (on by default) selects +enables specialisation on incoherent evidence (as has been the case previously). +The rest of this note describes what happens with `-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -850,7 +876,7 @@ Here are the moving parts: * `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into (nospec f d) if `d` is incoherent. It has to do a dependency analysis to determine transitive dependencies, but we need to do that anyway. - See Note [Desugaring incoherent evidence] in GHC.HsToCore.Binds. + See Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds. See also Note [nospecId magic] in GHC.Types.Id.Make. -} @@ -955,10 +981,10 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +type Canonical = Bool -- See Note [Recording coherence information in `PotentialUnifiers`] -data PotentialUnifiers = NoUnifiers Coherence +data PotentialUnifiers = NoUnifiers Canonical | OneOrMoreUnifiers (NonEmpty ClsInst) -- This list is lazy as we only look at all the unifiers when -- printing an error message. It can be expensive to compute all @@ -980,20 +1006,12 @@ So we only need the `Coherent` flag in the case where the set of potential unifiers is otherwise empty. -} -instance Outputable Coherence where - ppr IsCoherent = text "coherent" - ppr IsIncoherent = text "incoherent" - instance Outputable PotentialUnifiers where - ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c + ppr (NoUnifiers c) = text "NoUnifiers" <+> if c then text "canonical" else text "non-canonical" ppr xs = ppr (getPotentialUnifiers xs) -instance Semigroup Coherence where - IsCoherent <> IsCoherent = IsCoherent - _ <> _ = IsIncoherent - instance Semigroup PotentialUnifiers where - NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 <> c2) + NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 && c2) NoUnifiers _ <> u = u OneOrMoreUnifiers (unifier :| unifiers) <> u = OneOrMoreUnifiers (unifier :| (unifiers <> getPotentialUnifiers u)) @@ -1039,22 +1057,24 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys = acc - incoherently_matched :: PotentialUnifiers -> PotentialUnifiers - incoherently_matched (NoUnifiers _) = NoUnifiers IsIncoherent - incoherently_matched u = u + noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers + noncanonically_matched (NoUnifiers _) = NoUnifiers False + noncanonically_matched u = u check_unifier :: [ClsInst] -> PotentialUnifiers - check_unifier [] = NoUnifiers IsCoherent + check_unifier [] = NoUnifiers True check_unifier (item at ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items) | not (instIsVisible vis_mods item) = check_unifier items -- See Note [Instance lookup and orphan instances] | Just {} <- tcMatchTys tpl_tys tys = check_unifier items -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] + -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview] + | isNonCanonical item + = noncanonically_matched $ check_unifier items -- Ignore ones that are incoherent: Note [Incoherent instances] - -- Record that we encountered incoherent instances: Note [Coherence and specialisation: overview] | isIncoherent item - = incoherently_matched $ check_unifier items + = check_unifier items | otherwise = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set) @@ -1111,7 +1131,7 @@ lookupInstEnv check_overlap_safe -- If the selected match is incoherent, discard all unifiers final_unifs = case final_matches of - (m:_) | isIncoherent (fst m) -> NoUnifiers IsCoherent + (m:_) | isIncoherent (fst m) -> NoUnifiers True _ -> all_unifs -- Note [Safe Haskell isSafeOverlap] ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -911,6 +911,7 @@ ppOverlapPragma mb = 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 where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Hs -- lots of things import GHC.Core -- lots of things import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Core.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( etaExpand ) @@ -1152,14 +1152,14 @@ evidence that is used in `e`. This question arose when thinking about deep subsumption; see https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649). -Note [Desugaring incoherent evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the evidence is coherent, we desugar WpEvApp by simply passing +Note [Desugaring non-canonical evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the evidence is canonical, we desugar WpEvApp by simply passing core_tm directly to k: k core_tm -If the evidence is not coherent, we mark the application with nospec: +If the evidence is not canonical, we mark the application with nospec: nospec @(cls => a) k core_tm @@ -1170,14 +1170,14 @@ of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). See Note [Coherence and specialisation: overview] for why we shouldn't specialise incoherent evidence. -We can find out if a given evidence is coherent or not during the -desugaring of its WpLet wrapper: an evidence is incoherent if its +We can find out if a given evidence is canonical or not during the +desugaring of its WpLet wrapper: an evidence is non-canonical if its own resolution was incoherent (see Note [Incoherent instances]), or -if its definition refers to other incoherent evidence. dsEvBinds is +if its definition refers to other non-canonical evidence. dsEvBinds is the convenient place to compute this, since it already needs to do inter-evidence dependency analysis to generate well-scoped -bindings. We then record this coherence information in the -dsl_coherence field of DsM's local environment. +bindings. We then record this specialisability information in the +dsl_unspecables field of DsM's local environment. -} @@ -1201,20 +1201,27 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring non-canonical evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } +-- We are about to construct an evidence application `f dict`. If the dictionary is +-- non-specialisable, instead construct +-- nospec f dict +-- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1232,7 +1239,7 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- * Desugars the ev_binds, sorts them into dependency order, and -- passes the resulting [CoreBind] to thing_inside --- * Extends the DsM (dsl_coherence field) with coherence information +-- * Extends the DsM (dsl_unspecable field) with specialisability information -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside @@ -1240,53 +1247,50 @@ dsEvBinds ev_binds thing_inside ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where - go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a + go ::[SCC (Node EvVar (Canonical, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False - - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where - ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + ((v, rhs), (this_canonical, deps)) = unpack_node node + transitively_unspecable = not this_canonical || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where - (pairs, direct_coherence) = unzip $ map unpack_node nodes + (pairs, direct_canonicity) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not this_canonical || any is_unspecable_remote deps | (this_canonical, deps) <- direct_canonicity ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring non-canonical evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty - unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) + unpack_node DigraphNode { node_key = v, node_payload = (canonical, rhs), node_dependencies = deps } = ((v, rhs), (canonical, deps)) -sort_ev_binds :: Bag (Id, Coherence, CoreExpr) -> [SCC (Node EvVar (Coherence, CoreExpr))] +sort_ev_binds :: Bag (Id, Canonical, CoreExpr) -> [SCC (Node EvVar (Canonical, CoreExpr))] -- We do SCC analysis of the evidence bindings, /after/ desugaring -- them. This is convenient: it means we can use the GHC.Core -- free-variable functions rather than having to do accurate free vars -- for EvTerm. sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges where - edges :: [ Node EvVar (Coherence, CoreExpr) ] + edges :: [ Node EvVar (Canonical, CoreExpr) ] edges = foldr ((:) . mk_node) [] ds_binds - mk_node :: (Id, Coherence, CoreExpr) -> Node EvVar (Coherence, CoreExpr) - mk_node (var, coherence, rhs) - = DigraphNode { node_payload = (coherence, rhs) + mk_node :: (Id, Canonical, CoreExpr) -> Node EvVar (Canonical, CoreExpr) + mk_node (var, canonical, rhs) + = DigraphNode { node_payload = (canonical, rhs) , node_key = var , node_dependencies = nonDetEltsUniqSet $ exprFreeVars rhs `unionVarSet` @@ -1295,13 +1299,13 @@ sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges -- is still deterministic even if the edges are in nondeterministic order -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. -dsEvBind :: EvBind -> DsM (Id, Coherence, CoreExpr) +dsEvBind :: EvBind -> DsM (Id, Canonical, CoreExpr) dsEvBind (EvBind { eb_lhs = v, eb_rhs = r, eb_info = info }) = do e <- dsEvTerm r - let coherence = case info of - EvBindGiven{} -> IsCoherent - EvBindWanted{ ebi_coherence = coherence } -> coherence - return (v, coherence, e) + let canonical = case info of + EvBindGiven{} -> True + EvBindWanted{ ebi_canonical = canonical } -> canonical + return (v, canonical, e) {-********************************************************************** ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -357,7 +357,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +413,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -2628,6 +2628,7 @@ repOverlap mb = Overlapping _ -> just =<< dataCon overlappingDataConName Overlaps _ -> just =<< dataCon overlapsDataConName Incoherent _ -> just =<< dataCon incoherentDataConName + NonCanonical _ -> just =<< dataCon incoherentDataConName where nothing = coreNothing overlapTyConName just = coreJust overlapTyConName ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -79,9 +79,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar - -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + , dsl_unspecables :: S.Set EvVar + -- ^ See Note [Desugaring non-canonical evidence]: this field collects + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1212,11 +1212,11 @@ addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty ; case dest of EvVarDest evar - -> addTcEvBind ev_binds_var $ mkWantedEvBind evar IsCoherent err_tm + -> addTcEvBind ev_binds_var $ mkWantedEvBind evar True err_tm HoleDest hole -> do { -- See Note [Deferred errors for coercion holes] let co_var = coHoleCoVar hole - ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var IsCoherent err_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var True err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2514,6 +2514,7 @@ reifyClassInstance is_poly_tvs i Overlapping _ -> Just TH.Overlapping Overlaps _ -> Just TH.Overlaps Incoherent _ -> Just TH.Incoherent + NonCanonical _ -> Just TH.Incoherent ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -92,7 +92,7 @@ data ClsInstResult | OneInst { cir_new_theta :: [TcPredType] , cir_mk_ev :: [EvExpr] -> EvTerm - , cir_coherence :: Coherence -- See Note [Coherence and specialisation: overview] + , cir_canonical :: Canonical -- See Note [Coherence and specialisation: overview] , cir_what :: InstanceWhat } | NotSure -- Multiple matches and/or one or more unifiers @@ -162,7 +162,7 @@ matchInstEnv dflags short_cut_solver clas tys ; return NoInstance } -- A single match (& no safe haskell failure) - ([(ispec, inst_tys)], NoUnifiers coherence, False) + ([(ispec, inst_tys)], NoUnifiers canonical, False) | short_cut_solver -- Called from the short-cut solver , isOverlappable ispec -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT @@ -175,12 +175,11 @@ matchInstEnv dflags short_cut_solver clas tys | otherwise -> do { let dfun_id = instanceDFunId ispec ; traceTc "matchClass success" $ - vcat [text "dict" <+> ppr pred, - ppr coherence, + vcat [text "dict" <+> ppr pred <+> parens (if canonical then text "canonical" else text "non-canonical"), text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ] -- Record that this dfun is needed - ; match_one (null unsafeOverlaps) coherence dfun_id inst_tys } + ; match_one (null unsafeOverlaps) canonical dfun_id inst_tys } -- More than one matches (or Safe Haskell fail!). Defer any -- reactions of a multitude until we learn more about the reagent @@ -191,15 +190,15 @@ matchInstEnv dflags short_cut_solver clas tys where pred = mkClassPred clas tys -match_one :: SafeOverlapping -> Coherence -> DFunId -> [DFunInstType] -> TcM ClsInstResult +match_one :: SafeOverlapping -> Canonical -> DFunId -> [DFunInstType] -> TcM ClsInstResult -- See Note [DFunInstType: instantiating types] in GHC.Core.InstEnv -match_one so coherence dfun_id mb_inst_tys +match_one so canonical dfun_id mb_inst_tys = do { traceTc "match_one" (ppr dfun_id $$ ppr mb_inst_tys) ; (tys, theta) <- instDFunType dfun_id mb_inst_tys ; traceTc "match_one 2" (ppr dfun_id $$ ppr tys $$ ppr theta) ; return $ OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = TopLevInstance { iw_dfun_id = dfun_id , iw_safe_over = so } } } @@ -235,7 +234,7 @@ matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys , cir_mk_ev = tuple_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! where @@ -399,7 +398,7 @@ makeLitDict clas ty et , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) = return $ OneInst { cir_new_theta = [] , cir_mk_ev = \_ -> ev_tm - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } | otherwise @@ -448,7 +447,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_canonical = False -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } @@ -555,7 +554,7 @@ Some further observations about `withDict`: k (sv |> (sub co2 ; sym co))) That is, we cast the method using a coercion, and apply k to - it. Moreover, we mark the evidence as incoherent, resulting in + it. Moreover, we mark the evidence as non-canonical, resulting in the use of the 'nospec' magicId (see Note [nospecId magic] in GHC.Types.Id.Make) to ensure that the typeclass specialiser doesn't incorrectly common-up distinct evidence terms. This is @@ -641,7 +640,7 @@ doFunTy :: Class -> Type -> Mult -> Type -> Type -> TcM ClsInstResult doFunTy clas ty mult arg_ty ret_ty = return $ OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] @@ -658,7 +657,7 @@ doTyConApp clas ty tc kind_args | tyConIsTypeable tc = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) kind_args , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinTypeableInstance tc } | otherwise = return NoInstance @@ -690,7 +689,7 @@ doTyApp clas ty f tk | otherwise = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2) @@ -711,7 +710,7 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc mk_ev _ = panic "doTyLit" ; return (OneInst { cir_new_theta = [kc_pred] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) } {- Note [Typeable (T a b c)] @@ -946,7 +945,7 @@ matchHasField dflags short_cut clas tys ; keepAlive (greName gre) ; return OneInst { cir_new_theta = theta , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } } else matchInstEnv dflags short_cut clas tys } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -33,7 +33,6 @@ import GHC.Data.Bag import GHC.Core.Class import GHC.Core import GHC.Core.DataCon -import GHC.Core.InstEnv ( Coherence(IsCoherent) ) import GHC.Core.Make import GHC.Driver.DynFlags import GHC.Data.FastString @@ -612,7 +611,7 @@ solveImplicationUsingUnsatGiven go_simple ct = case ctEvidence ct of CtWanted { ctev_pred = pty, ctev_dest = dst } -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty - ; setWantedEvTerm dst IsCoherent $ EvExpr ev_expr } + ; setWantedEvTerm dst True $ EvExpr ev_expr } _ -> return () -- | Create an evidence expression for an arbitrary constraint using ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Hs.Type( HsIPName(..) ) import GHC.Core import GHC.Core.Type -import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) +import GHC.Core.InstEnv ( DFunInstType ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) @@ -184,7 +184,7 @@ solveCallStack ev ev_cs -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] = do { cs_tm <- evCallStack ev_cs ; let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) - ; setEvBindIfWanted ev IsCoherent ev_tm } + ; setEvBindIfWanted ev True ev_tm } {- Note [Shadowing of implicit parameters] @@ -394,7 +394,7 @@ solveEqualityDict ev cls tys ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ evDataConApp data_con tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } @@ -715,10 +715,10 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys -- the inert from the work-item or vice-versa. ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) - ; setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + ; setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) - ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) + ; setEvBindIfWanted ev_i True (ctEvTerm ev_w) ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } @@ -784,7 +784,7 @@ shortCutSolver dflags ev_w ev_i ; case inst_res of OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = what } | safeOverlap what , all isTyFamFree preds -- Note [Shortcut solving: type families] @@ -804,7 +804,7 @@ shortCutSolver dflags ev_w ev_i ; let ev_tm = mk_ev (map getEvExpr evc_vs) ev_binds' = extendEvBinds ev_binds $ - mkWantedEvBind (ctEvEvId ev) coherence ev_tm + mkWantedEvBind (ctEvEvId ev) canonical ev_tm ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ freshGoals evc_vs } @@ -847,7 +847,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls -- See Note [No Given/Given fundeps] | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached - = do { setEvBindIfWanted ev IsCoherent (ctEvTerm solved_ev) + = do { setEvBindIfWanted ev True (ctEvTerm solved_ev) ; stopWith ev "Dict/Top (cached)" } | otherwise -- Wanted, but not cached @@ -869,14 +869,14 @@ chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev - , cir_coherence = coherence }) + , cir_canonical = canonical }) = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) (ppr work_item) ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta - ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; setEvBindIfWanted work_item canonical (mk_ev (map getEvExpr evc_vars)) ; emitWorkNC (freshGoals evc_vars) ; stopWith work_item "Dict/Top (solved wanted)" } where @@ -1070,7 +1070,7 @@ matchLocalInst pred loc -> do { let result = OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = LocalInstance } ; traceTcS "Best local instance found:" $ vcat [ text "pred:" <+> ppr pred @@ -1317,7 +1317,7 @@ last_resort inerts (DictCt { di_ev = ev_w, di_cls = cls, di_tys = xis }) , Just ct_i <- lookupInertDict inerts loc_w cls xis , let ev_i = dictCtEvidence ct_i , isGiven ev_i - = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + = do { setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ TcRnLoopySuperclassSolve loc_w (ctEvPred ev_w) ; return $ Stop ev_w (text "Loopy superclass") } @@ -2158,4 +2158,3 @@ constraints. See also Note [Evidence for quantified constraints] in GHC.Core.Predicate. -} - ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -32,7 +32,6 @@ import GHC.Core.Coercion import GHC.Core.Coercion.Axiom import GHC.Core.Reduction import GHC.Core.Unify( tcUnifyTyWithTFs ) -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.FamInstEnv ( FamInstEnvs, FamInst(..), apartnessCheck , lookupFamInstEnvByTyCon ) import GHC.Core @@ -357,7 +356,7 @@ can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ -- Literals can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ | l1 == l2 - = do { setEvBindIfWanted ev IsCoherent (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) + = do { setEvBindIfWanted ev True (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } -- Decompose FunTy: (s -> t) and (c => t) @@ -1847,7 +1846,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Provide Refl evidence for the constraint -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted new_ev IsCoherent $ + ; setEvBindIfWanted new_ev True $ evCoercion (mkNomReflCo final_rhs) -- Kick out any constraints that can now be rewritten @@ -1958,7 +1957,7 @@ canEqReflexive :: CtEvidence -- ty ~ ty -> TcType -- ty -> TcS (StopOrContinue a) -- always Stop canEqReflexive ev eq_rel ty - = do { setEvBindIfWanted ev IsCoherent $ + = do { setEvBindIfWanted ev True $ evCoercion (mkReflCo (eqRelRole eq_rel) ty) ; stopWith ev "Solved by reflexivity" } @@ -2541,7 +2540,7 @@ tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item - -> do { setEvBindIfWanted ev IsCoherent $ + -> do { setEvBindIfWanted ev True $ evCoercion (maybeSymCo swapped $ downgradeRole (eqRelRole eq_rel) (ctEvRole ev_i) @@ -3188,4 +3187,4 @@ To avoid this situation we do not cache as solved any workitems (or inert) which did not really made a 'step' towards proving some goal. Solved's are just an optimization so we don't lose anything in terms of completeness of solving. --} \ No newline at end of file +-} ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -15,7 +15,6 @@ import GHC.Tc.Solver.Monad import GHC.Tc.Types.Evidence import GHC.Core.Coercion -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Types.Basic( SwapFlag(..) ) @@ -74,9 +73,9 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) + KeepInert -> do { setEvBindIfWanted ev_w True (swap_me swap ev_i) ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } - KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) + KeepWork -> do { setEvBindIfWanted ev_i True (swap_me swap ev_w) ; updInertCans (updIrreds (\_ -> others)) ; continueWith () } } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1688,19 +1688,19 @@ setWantedEq (HoleDest hole) co setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) -- | Good for both equalities and non-equalities -setWantedEvTerm :: TcEvDest -> Coherence -> EvTerm -> TcS () -setWantedEvTerm (HoleDest hole) _coherence tm +setWantedEvTerm :: TcEvDest -> Canonical -> EvTerm -> TcS () +setWantedEvTerm (HoleDest hole) _canonical tm | Just co <- evTermCoercion_maybe tm = do { useVars (coVarsOfCo co) ; fillCoercionHole hole co } | otherwise = -- See Note [Yukky eq_sel for a HoleDest] do { let co_var = coHoleCoVar hole - ; setEvBind (mkWantedEvBind co_var IsCoherent tm) + ; setEvBind (mkWantedEvBind co_var True tm) ; fillCoercionHole hole (mkCoVarCo co_var) } -setWantedEvTerm (EvVarDest ev_id) coherence tm - = setEvBind (mkWantedEvBind ev_id coherence tm) +setWantedEvTerm (EvVarDest ev_id) canonical tm + = setEvBind (mkWantedEvBind ev_id canonical tm) {- Note [Yukky eq_sel for a HoleDest] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1726,10 +1726,10 @@ fillCoercionHole hole co = do { wrapTcS $ TcM.fillCoercionHole hole co ; kickOutAfterFillingCoercionHole hole } -setEvBindIfWanted :: CtEvidence -> Coherence -> EvTerm -> TcS () -setEvBindIfWanted ev coherence tm +setEvBindIfWanted :: CtEvidence -> Canonical -> EvTerm -> TcS () +setEvBindIfWanted ev canonical tm = case ev of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest coherence tm + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest canonical tm _ -> return () newTcEvBinds :: TcS EvBindsVar ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -20,7 +20,6 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate import GHC.Core.Reduction import GHC.Core.Coercion @@ -427,7 +426,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars , et_binds = ev_binds, et_body = w_id } @@ -556,7 +555,7 @@ finish_rewrite ev@(CtWanted { ctev_dest = dest (Reduction co new_pred) new_rewriters = do { mb_new_ev <- newWanted loc rewriters' new_pred ; massert (coercionRole co == ctEvRole ev) - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ mkEvCast (getEvExpr mb_new_ev) (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) ; case mb_new_ev of @@ -631,7 +630,7 @@ runTcPluginsWanted wc@(WC { wc_simple = simples1 }) where setEv :: (EvTerm,Ct) -> TcS () setEv (ev,ct) = case ctEvidence ct of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest IsCoherent ev -- TODO: plugins should be able to signal non-coherence + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest True ev -- TODO: plugins should be able to signal non-canonicity _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" -- | A pair of (given, wanted) constraints to pass to plugins ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1482,7 +1482,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_top_name <- newName (mkSuperDictAuxOcc n (getOccName cls)) ; sc_ev_id <- newEvVar sc_pred - ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id True sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred sc_top_id = mkLocalId sc_top_name ManyTy sc_top_ty export = ABE { abe_wrap = idHsWrapper ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Types.Basic import GHC.Core import GHC.Core.Class (Class, classSCSelId ) import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Utils.Misc import GHC.Utils.Panic @@ -451,7 +451,7 @@ instance Outputable EvBindMap where data EvBindInfo = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver } - | EvBindWanted { ebi_coherence :: Coherence -- See Note [Desugaring incoherent evidence] + | EvBindWanted { ebi_canonical :: Canonical -- See Note [Desugaring non-canonical evidence] } ----------------- @@ -465,7 +465,7 @@ data EvBind evBindVar :: EvBind -> EvVar evBindVar = eb_lhs -mkWantedEvBind :: EvVar -> Coherence -> EvTerm -> EvBind +mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind mkWantedEvBind ev c tm = EvBind { eb_info = EvBindWanted c, eb_lhs = ev, eb_rhs = tm } -- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, RecursiveDo #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -820,16 +821,27 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt LangExt.OverlappingInstances dflags - incoherent_ok = xopt LangExt.IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags + noncanonical_incoherence = not $ gopt Opt_SpecialiseIncoherents dflags + use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent NoSourceText) | overlap_ok = use (Overlaps NoSourceText) | otherwise = use (NoOverlap NoSourceText) - final_oflag = setOverlapModeMaybe default_oflag overlap_mode + oflag = setOverlapModeMaybe default_oflag overlap_mode + final_oflag = effective_oflag noncanonical_incoherence oflag ; return final_oflag } + where + effective_oflag noncanonical_incoherence oflag at OverlapFlag{ overlapMode = overlap_mode } + = oflag { overlapMode = effective_overlap_mode noncanonical_incoherence overlap_mode } + + effective_overlap_mode noncanonical_incoherence = \case + Incoherent s | noncanonical_incoherence -> NonCanonical s + overlap_mode -> overlap_mode + tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, - hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, + hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag, Boxity(..), isBoxed, @@ -628,6 +628,7 @@ hasIncoherentFlag :: OverlapMode -> Bool hasIncoherentFlag mode = case mode of Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappableFlag :: OverlapMode -> Bool @@ -636,6 +637,7 @@ hasOverlappableFlag mode = Overlappable _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappingFlag :: OverlapMode -> Bool @@ -644,8 +646,14 @@ hasOverlappingFlag mode = Overlapping _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False +hasNonCanonicalFlag :: OverlapMode -> Bool +hasNonCanonicalFlag = \case + NonCanonical{} -> True + _ -> False + data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv = NoOverlap SourceText -- See Note [Pragma source text] @@ -700,6 +708,8 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv -- instantiating 'b' would change which instance -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv" + | NonCanonical SourceText + deriving (Eq, Data) @@ -712,6 +722,7 @@ instance Outputable OverlapMode where ppr (Overlapping _) = text "[overlapping]" ppr (Overlaps _) = text "[overlap ok]" ppr (Incoherent _) = text "[incoherent]" + ppr (NonCanonical _) = text "[noncanonical]" instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s @@ -719,6 +730,7 @@ instance Binary OverlapMode where put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s + put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s get bh = do h <- getByte bh case h of @@ -727,6 +739,7 @@ instance Binary OverlapMode where 2 -> (get bh) >>= \s -> return $ Incoherent s 3 -> (get bh) >>= \s -> return $ Overlapping s 4 -> (get bh) >>= \s -> return $ Overlappable s + 5 -> (get bh) >>= \s -> return $ NonCanonical s _ -> panic ("get OverlapMode" ++ show h) ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c7d673877af089d1faa4e97c39ab63e99489f42 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c7d673877af089d1faa4e97c39ab63e99489f42 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 07:56:43 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 03:56:43 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add MO_UU_Conv w W64 Message-ID: <64a673bbe511e_1849791ad304452289@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: f238be8f by Jaro Reinders at 2023-07-06T09:56:36+02:00 Add MO_UU_Conv w W64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -599,6 +599,16 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do r_dst_hi r_dst_lo +iselExpr64 (CmmMachOp (MO_UU_Conv w W64) [expr]) | w == W8 || w == W16 = do + (rsrc, code) <- getByteReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code `appOL` toOL [ + MOVZxL II32 (OpReg rsrc) (OpReg r_dst_lo), + MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi) + ]) + r_dst_hi + r_dst_lo + iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do code <- getAnyReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f238be8f0f029f8c98f2ce2ea0b9afd409f5a213 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f238be8f0f029f8c98f2ce2ea0b9afd409f5a213 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 08:10:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 06 Jul 2023 04:10:22 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] wibble Message-ID: <64a676ee5ba0b_1849791ad3044525a6@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 740908bf by Simon Peyton Jones at 2023-07-06T09:10:10+01:00 wibble - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3733,8 +3733,9 @@ mkDupableContWithDmds env _ where thumbsUpPlanA (StrictBind {}) = True thumbsUpPlanA (Stop {}) = True + thumbsUpPlanA (Select {}) = True -- Not quite sure of this one, but it + -- benefits nofib digits-of-e1 quite a bit thumbsUpPlanA (StrictArg {}) = False - thumbsUpPlanA (Select {}) = False thumbsUpPlanA (CastIt { sc_cont = k }) = thumbsUpPlanA k thumbsUpPlanA (TickIt _ k) = thumbsUpPlanA k thumbsUpPlanA (ApplyToVal { sc_cont = k }) = thumbsUpPlanA k View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/740908bfce305de2b85b84add80ecc6384d43f7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/740908bfce305de2b85b84add80ecc6384d43f7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 08:46:39 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 04:46:39 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix MO_SS_Conv W8/16 W64 Message-ID: <64a67f6fba3d1_184979aec6854681@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: c471ab42 by Jaro Reinders at 2023-07-06T10:46:33+02:00 Fix MO_SS_Conv W8/16 W64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -624,8 +624,8 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do code <- getAnyReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code r_dst_lo `snocOL` - MOV II16 (OpReg r_dst_lo) (OpReg eax) `snocOL` - CLTD II16 `snocOL` + MOVZxL II32 (OpReg r_dst_lo) (OpReg eax) `snocOL` + CLTD II32 `snocOL` MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` MOV II32 (OpReg edx) (OpReg r_dst_hi)) r_dst_hi @@ -635,8 +635,8 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do code <- getAnyReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code r_dst_lo `snocOL` - MOV II8 (OpReg r_dst_lo) (OpReg eax) `snocOL` - CLTD II8 `snocOL` + MOVZxL II32 (OpReg r_dst_lo) (OpReg eax) `snocOL` + CLTD II32 `snocOL` MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` MOV II32 (OpReg edx) (OpReg r_dst_hi)) r_dst_hi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c471ab42c6fa16ee4ddfde393c5732a57382a25a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c471ab42c6fa16ee4ddfde393c5732a57382a25a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 08:50:50 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 04:50:50 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix MO_SS_Conv W8/16 W64 again Message-ID: <64a6806a291aa_1849791ae3b245653c@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: ae8577f0 by Jaro Reinders at 2023-07-06T10:50:42+02:00 Fix MO_SS_Conv W8/16 W64 again - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -621,24 +621,24 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do r_dst_lo iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do - code <- getAnyReg expr + (r, code) <- getByteReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code r_dst_lo `snocOL` - MOVZxL II32 (OpReg r_dst_lo) (OpReg eax) `snocOL` - CLTD II32 `snocOL` - MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` - MOV II32 (OpReg edx) (OpReg r_dst_hi)) + return $ RegCode64 (code `appOL` toOL [ + MOVZxL II32 (OpReg r) (OpReg eax), + CLTD II32, + MOV II32 (OpReg eax) (OpReg r_dst_lo), + MOV II32 (OpReg edx) (OpReg r_dst_hi)]) r_dst_hi r_dst_lo iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do - code <- getAnyReg expr + (r, code) <- getByteReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 - return $ RegCode64 (code r_dst_lo `snocOL` - MOVZxL II32 (OpReg r_dst_lo) (OpReg eax) `snocOL` - CLTD II32 `snocOL` - MOV II32 (OpReg eax) (OpReg r_dst_lo) `snocOL` - MOV II32 (OpReg edx) (OpReg r_dst_hi)) + return $ RegCode64 (code `appOL` toOL [ + MOVZxL II32 (OpReg r) (OpReg eax), + CLTD II32, + MOV II32 (OpReg eax) (OpReg r_dst_lo), + MOV II32 (OpReg edx) (OpReg r_dst_hi)]) r_dst_hi r_dst_lo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae8577f06319ca3ccfea09831a9d977430272252 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ae8577f06319ca3ccfea09831a9d977430272252 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 08:51:16 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Thu, 06 Jul 2023 04:51:16 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] Use original location info from ConPats Message-ID: <64a68084e8ae6_1849791ae3b38568c3@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: d51b023a by David Knothe at 2023-07-06T10:51:11+02:00 Use original location info from ConPats - - - - - 1 changed file: - compiler/GHC/HsToCore/Match/Constructor.hs Changes: ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -164,7 +164,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , prependEqn (map (L (SrcSpanAnn EpAnnNotUsed generatedSrcSpan)) $ conArgPats val_arg_tys args) rest + , prependEqn (conArgPats val_arg_tys args) rest ) shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys @@ -256,14 +256,14 @@ conArgPats :: [Scaled Type]-- Instantiated argument types -- Used only to fill in the types of WildPats, which -- are probably never looked at anyway -> ConArgPats - -> [Pat GhcTc] -conArgPats _arg_tys (PrefixCon _ ps) = map unLoc ps -conArgPats _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2] + -> [LPat GhcTc] +conArgPats _arg_tys (PrefixCon _ ps) = ps +conArgPats _arg_tys (InfixCon p1 p2) = [p1, p2] conArgPats arg_tys (RecCon (HsRecFields { rec_flds = rpats })) - | null rpats = map WildPat (map scaledThing arg_tys) + | null rpats = map (L (SrcSpanAnn EpAnnNotUsed generatedSrcSpan) . WildPat . scaledThing) arg_tys -- Important special case for C {}, which can be used for a -- datacon that isn't declared to have fields at all - | otherwise = map (unLoc . hfbRHS . unLoc) rpats + | otherwise = map (hfbRHS . unLoc) rpats {- Note [Record patterns] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d51b023a7def9ff32528c3681e9646f675347633 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d51b023a7def9ff32528c3681e9646f675347633 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 08:52:40 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 04:52:40 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix MO_SS_Conv W8/16 W64 again again Message-ID: <64a680d880ea9_1849791ad3030590c3@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 04e5569c by Jaro Reinders at 2023-07-06T10:52:34+02:00 Fix MO_SS_Conv W8/16 W64 again again - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -624,7 +624,7 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do (r, code) <- getByteReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code `appOL` toOL [ - MOVZxL II32 (OpReg r) (OpReg eax), + MOVSxL II32 (OpReg r) (OpReg eax), CLTD II32, MOV II32 (OpReg eax) (OpReg r_dst_lo), MOV II32 (OpReg edx) (OpReg r_dst_hi)]) @@ -635,7 +635,7 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do (r, code) <- getByteReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code `appOL` toOL [ - MOVZxL II32 (OpReg r) (OpReg eax), + MOVSxL II32 (OpReg r) (OpReg eax), CLTD II32, MOV II32 (OpReg eax) (OpReg r_dst_lo), MOV II32 (OpReg edx) (OpReg r_dst_hi)]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04e5569c017b009e1bc21aeef86d81d4435c4391 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04e5569c017b009e1bc21aeef86d81d4435c4391 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 08:55:23 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 04:55:23 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix MO_SS_Conv W8/16 W64 again again again Message-ID: <64a6817b3f790_184979aec4059334@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 99ca7699 by Jaro Reinders at 2023-07-06T10:55:16+02:00 Fix MO_SS_Conv W8/16 W64 again again again - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -599,11 +599,21 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do r_dst_hi r_dst_lo -iselExpr64 (CmmMachOp (MO_UU_Conv w W64) [expr]) | w == W8 || w == W16 = do +iselExpr64 (CmmMachOp (MO_UU_Conv W16 W64) [expr]) = do (rsrc, code) <- getByteReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code `appOL` toOL [ - MOVZxL II32 (OpReg rsrc) (OpReg r_dst_lo), + MOVZxL II16 (OpReg rsrc) (OpReg r_dst_lo), + MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi) + ]) + r_dst_hi + r_dst_lo + +iselExpr64 (CmmMachOp (MO_UU_Conv W8 W64) [expr]) = do + (rsrc, code) <- getByteReg expr + Reg64 r_dst_hi r_dst_lo <- getNewReg64 + return $ RegCode64 (code `appOL` toOL [ + MOVZxL II8 (OpReg rsrc) (OpReg r_dst_lo), MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi) ]) r_dst_hi @@ -624,7 +634,7 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W16 W64) [expr]) = do (r, code) <- getByteReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code `appOL` toOL [ - MOVSxL II32 (OpReg r) (OpReg eax), + MOVSxL II16 (OpReg r) (OpReg eax), CLTD II32, MOV II32 (OpReg eax) (OpReg r_dst_lo), MOV II32 (OpReg edx) (OpReg r_dst_hi)]) @@ -635,7 +645,7 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W8 W64) [expr]) = do (r, code) <- getByteReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code `appOL` toOL [ - MOVSxL II32 (OpReg r) (OpReg eax), + MOVSxL II8 (OpReg r) (OpReg eax), CLTD II32, MOV II32 (OpReg eax) (OpReg r_dst_lo), MOV II32 (OpReg edx) (OpReg r_dst_hi)]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99ca7699f84350e07627c9806054985426c00ea6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99ca7699f84350e07627c9806054985426c00ea6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 09:06:38 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 05:06:38 -0400 Subject: [Git][ghc/ghc][wip/T23576] Remove temporary quottish ops Message-ID: <64a6841e75cb2_1849791ad304459678@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 58e63fd3 by Jaro Reinders at 2023-07-06T11:06:32+02:00 Remove temporary quottish ops - - - - - 1 changed file: - compiler/GHC/StgToCmm/Prim.hs Changes: ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1684,33 +1684,6 @@ emitPrimOp cfg primop = isQuottishOp MO_I64_Rem = True isQuottishOp MO_W64_Quot = True isQuottishOp MO_W64_Rem = True - - isQuottishOp MO_I64_ToI = True - isQuottishOp MO_I64_FromI = True - isQuottishOp MO_W64_ToW = True - isQuottishOp MO_W64_FromW = True - - isQuottishOp MO_x64_Eq = True - isQuottishOp MO_x64_Ne = True - isQuottishOp MO_I64_Ge = True - isQuottishOp MO_I64_Gt = True - isQuottishOp MO_I64_Le = True - isQuottishOp MO_I64_Lt = True - isQuottishOp MO_W64_Ge = True - isQuottishOp MO_W64_Gt = True - isQuottishOp MO_W64_Le = True - isQuottishOp MO_W64_Lt = True - - isQuottishOp MO_UF_Conv{} = True - - isQuottishOp MO_x64_And = True - isQuottishOp MO_x64_Or = True - isQuottishOp MO_x64_Xor = True - isQuottishOp MO_x64_Not = True - isQuottishOp MO_x64_Shl = True - isQuottishOp MO_I64_Shr = True - isQuottishOp MO_W64_Shr = True - isQuottishOp _ = False opTranslate64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/58e63fd3b1a8ddb7888a14ba5d1d4c2aa0b88e16 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/58e63fd3b1a8ddb7888a14ba5d1d4c2aa0b88e16 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 09:10:41 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 05:10:41 -0400 Subject: [Git][ghc/ghc][wip/T23576] 68 commits: hadrian: Fix dependencies of docs:* rule Message-ID: <64a68511d1a17_184979aec2c599f1@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 92cd146b by Jaro Reinders at 2023-07-06T11:09:53+02:00 Allow big arith on x86 - - - - - 1c763800 by Jaro Reinders at 2023-07-06T11:09:53+02:00 More detailed panic in iselExpr64 - - - - - af5a09a0 by Jaro Reinders at 2023-07-06T11:09:53+02:00 Better debug message attempt 2 - - - - - f988bc5d by Jaro Reinders at 2023-07-06T11:09:53+02:00 Implement negation - - - - - ce57503e by Jaro Reinders at 2023-07-06T11:09:53+02:00 Add MO_Mul case in iselExpr64 - - - - - 62daa23b by Jaro Reinders at 2023-07-06T11:09:53+02:00 Try fixing iselExpr64 for MO_Mul - - - - - c5841064 by Jaro Reinders at 2023-07-06T11:09:53+02:00 Fix MO_Mul some more - - - - - 60053f5c by Jaro Reinders at 2023-07-06T11:09:53+02:00 Add AllowBigQuot option to StgToCmm - - - - - 77a2853c by Jaro Reinders at 2023-07-06T11:09:53+02:00 Implement MO_Shl in iselExpr64 - - - - - 28d0a138 by Jaro Reinders at 2023-07-06T11:09:53+02:00 Add SHRD to regUsage - - - - - 38943b39 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add SHRD to patchRegs - - - - - 6c9b13c6 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add SHRD to pprInstr - - - - - 8c97d12b by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add more shifts - - - - - 72f0f25c by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add bitwise operations - - - - - d8e3cb1b by Jaro Reinders at 2023-07-06T11:09:54+02:00 Insert unconditional jumps before NEWBLOCK - - - - - c9a7fd07 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Fix blocks - - - - - 209c1fd8 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add condIntCode for 64-bit ints on i386 - - - - - 8bbb4ae9 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Fix typo - - - - - 14c919fe by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add MO_UU_Conv W64 W8 - - - - - 6cfe9d62 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add CmmRegOff case to iselExpr64 - - - - - cfd9e65b by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add MO_UU_Conv W64 W16 - - - - - b9913704 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Add MO_SS_Conv W16/W8 W64 - - - - - 873bd577 by Jaro Reinders at 2023-07-06T11:09:54+02:00 Revert confFltCode changes - - - - - a062eeae by Jaro Reinders at 2023-07-06T11:09:54+02:00 Remove whitespace and add temporary quottish cases - - - - - 377a211a by Jaro Reinders at 2023-07-06T11:09:55+02:00 Fixes - - - - - 9cb9da39 by Jaro Reinders at 2023-07-06T11:09:55+02:00 Add MO_UU_Conv w W64 - - - - - e2d2dea4 by Jaro Reinders at 2023-07-06T11:09:55+02:00 Fix MO_SS_Conv W8/16 W64 - - - - - f684630e by Jaro Reinders at 2023-07-06T11:09:55+02:00 Fix MO_SS_Conv W8/16 W64 again - - - - - 3fe10123 by Jaro Reinders at 2023-07-06T11:09:55+02:00 Fix MO_SS_Conv W8/16 W64 again again - - - - - bda64b00 by Jaro Reinders at 2023-07-06T11:09:55+02:00 Fix MO_SS_Conv W8/16 W64 again again again - - - - - 9d83fa34 by Jaro Reinders at 2023-07-06T11:09:55+02:00 Remove temporary quottish ops - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58e63fd3b1a8ddb7888a14ba5d1d4c2aa0b88e16...9d83fa342e3f783dfade30ff3ff1af3eaec818b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58e63fd3b1a8ddb7888a14ba5d1d4c2aa0b88e16...9d83fa342e3f783dfade30ff3ff1af3eaec818b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 10:11:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 06 Jul 2023 06:11:31 -0400 Subject: [Git][ghc/ghc][wip/T22012] 7 commits: Improve the situation with the stimes cycle Message-ID: <64a69353ef375_184979aec4010839e@gitlab.mail> Matthew Pickering pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - d8509abd by Ben Gamari at 2023-07-06T11:11:19+01:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python ops = [] ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.append(f'__aarch64_{op}{n}_{order}') for m in [1,2,4,8,16]: ops.append(f'__aarch64_cas{n}_{order}') print('\n'.join(f' SymE_NeedsProto({op}) \\' for op in sorted(ops))) ``` - - - - - 20 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d38c475224a08d2d75b0a32ffb5acd6f3703d6bc...d8509abd9aa88e0adc05a48c0ce0409b70b2ce93 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d38c475224a08d2d75b0a32ffb5acd6f3703d6bc...d8509abd9aa88e0adc05a48c0ce0409b70b2ce93 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 10:29:16 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 06 Jul 2023 06:29:16 -0400 Subject: [Git][ghc/ghc][wip/cmm-s-files] 20 commits: configure: Rip out Solaris dyld check Message-ID: <64a6977c6e60f_184979aec681178f6@gitlab.mail> Matthew Pickering pushed to branch wip/cmm-s-files at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 84036afe by Matthew Pickering at 2023-07-06T11:29:06+01:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 23 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01b4f23163f1e797ca623f50a3442fea010587b3...84036afe4b1ae42af7d86bf83995fb4288df4a1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01b4f23163f1e797ca623f50a3442fea010587b3...84036afe4b1ae42af7d86bf83995fb4288df4a1b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 11:17:36 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 07:17:36 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 5 commits: Drop SDFM module Message-ID: <64a6a2d03ace8_184979aec401542af@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 37279f53 by Rodrigo Mesquita at 2023-07-03T10:00:29+01:00 Drop SDFM module - - - - - 7e4cebee by Rodrigo Mesquita at 2023-07-03T10:00:29+01:00 Improve a little bit the mixing of Ids and ClassIds tWeaks Don't use EG.rebuild as a view pattern - - - - - 00b4cbd2 by Rodrigo Mesquita at 2023-07-03T10:16:23+01:00 Debuggging - - - - - 2f2f1867 by Rodrigo Mesquita at 2023-07-03T19:39:10+01:00 Touches - - - - - e779a752 by Rodrigo Mesquita at 2023-07-06T12:17:17+01:00 Fix to representId over multiple (different) nablas - - - - - 14 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - − compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in - libraries/hegg - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -7,6 +7,11 @@ module GHC.Core.Equality where +-- ROMES:TODO: +-- I think, for the particular usages of Core e-graphs, we can do much better +-- than this for equality. +-- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) + import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude ===================================== compiler/GHC/HsToCore/Errors/Ppr.hs ===================================== @@ -72,7 +72,8 @@ instance Diagnostic DsMessage where case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas - pp_tys = pprQuotedList $ map idType vars + -- pp_tys = pprQuotedList $ map idType vars + pp_tys = empty in hang (text "Patterns of type" <+> pp_tys <+> text "not matched:") 4 ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -20,6 +20,8 @@ import GHC.Types.Id import GHC.Types.Name (Name) import qualified GHC.LanguageExtensions as LangExt +import Data.Equality.Graph (ClassId) + import GHC.Generics (Generic) newtype MinBound = MinBound Integer @@ -99,7 +101,7 @@ data DsMessage | DsNonExhaustivePatterns !(HsMatchContext GhcRn) !ExhaustivityCheckType !MaxUncoveredPatterns - [Id] + [ClassId] [Nabla] | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -75,6 +75,8 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Coerce +import Data.Equality.Graph (ClassId) + -- -- * Exported entry points to the checker -- @@ -104,9 +106,20 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do !missing <- getLdiNablas pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) - result <- unCA (checkPatBind pat_bind) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportPatBind ctxt [var] result + result0 <- unCA (checkPatBind pat_bind) missing + tracePm "}: " (ppr (cr_uncov result0)) + -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas + -- DESIGN:TODO: However, if we represent the variables while desugaring, we + -- would no longer need representId to represent VarF in the e-class, and can + -- instead do newEClass. This would further reduce allocations. + -- The reason why we can't do that currently is that on checkPatBind we'll + -- representIds, and when we represent them again in the next line, we want + -- them to match the ones we represented during checkPatBind. If we made + -- empty-eclasses, the representId on the next line wouldn't match the match + -- ids we defined in checkPatBind. + let (varid, cr_uncov') = representId var (cr_uncov result0) + formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -165,18 +178,20 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars empty_case <- noCheckDs $ desugarEmptyCase var - result <- unCA (checkEmptyCase empty_case) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportEmptyCase ctxt vars result + result0 <- unCA (checkEmptyCase empty_case) missing + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + formatReportWarnings ReportEmptyCase ctxt varids result0{cr_uncov=cr_uncov'} return [] Just matches -> do matches <- {-# SCC "desugarMatches" #-} noCheckDs $ desugarMatches vars matches - result <- {-# SCC "checkMatchGroup" #-} + result0 <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing - tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result - return (NE.toList (ldiMatchGroup (cr_ret result))) + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} + return (NE.toList (ldiMatchGroup (cr_ret result0))) {- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -340,7 +355,7 @@ collectInMode ReportEmptyCase = cirbsEmptyCase -- | Given a 'FormatReportWarningsMode', this function will emit warnings -- for a 'CheckResult'. -formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult ann -> DsM () +formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult ann -> DsM () formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do cov_info <- collectInMode report_mode ann dflags <- getDynFlags @@ -348,7 +363,7 @@ formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do -- | Issue all the warnings -- (redundancy, inaccessibility, exhaustiveness, redundant bangs). -reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () +reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult CIRB -> DsM () reportWarnings dflags report_mode (DsMatchContext kind loc) vars CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss , cirb_red = redundant_rhss @@ -387,14 +402,13 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars maxPatterns = maxUncoveredPatterns dflags -getNFirstUncovered :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nablas -> DsM [Nabla] getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - let (vars', nabla') = representIds vars nabla -- they're already there, we're just getting the e-class ids back - front <- generateInhabitingPatterns mode vars' n nabla' + front <- generateInhabitingPatterns mode vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -429,9 +443,10 @@ addTyCs origin ev_vars m = do -- to be added for multiple scrutinees rather than just one. addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k -addCoreScrutTmCs (scr:scrs) (x:xs) k = - flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas -> - addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) +addCoreScrutTmCs (scr:scrs) (x0:xs) k = + flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> + let (x, nablas) = representId x0 nablas0 + in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -103,9 +103,10 @@ emptyRedSets :: RedSets emptyRedSets = RedSets mempty mempty mempty checkGrd :: PmGrd -> CheckAction RedSets -checkGrd grd = CA $ \inc -> case grd of +checkGrd grd = CA $ \inc0 -> case grd of -- let x = e: Refine with x ~ e - PmLet x e -> do + PmLet x0 e -> do + let (x, inc) = representId x0 inc0 -- romes: we could potentially do update the trees to use e-class ids here, -- or in pmcMatches matched <- addPhiCtNablas inc (PhiCoreCt x e) @@ -114,7 +115,8 @@ checkGrd grd = CA $ \inc -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ - PmBang x mb_info -> do + PmBang x0 mb_info -> do + let (x, inc) = representId x0 inc0 div <- addPhiCtNablas inc (PhiBotCt x) matched <- addPhiCtNablas inc (PhiNotBotCt x) -- See Note [Dead bang patterns] @@ -133,7 +135,10 @@ checkGrd grd = CA $ \inc -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x con tvs dicts args -> do + PmCon x0 con tvs dicts args0 -> do + let (x, inc1) = representId x0 inc0 + (args, inc) = representIds args0 inc1 + pprTraceM "PmCon" (ppr inc $$ text "args:" <+> ppr args) !div <- if isPmAltConMatchStrict con then addPhiCtNablas inc (PhiBotCt x) else pure mempty @@ -181,7 +186,8 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPhiCtNablas inc (PhiNotBotCt var) + let (varid, inc') = representId var inc + unc <- addPhiCtNablas inc' (PhiNotBotCt varid) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -327,7 +327,14 @@ desugarEmptyCase var = pure PmEmptyCase { pe_var = var } -- | Desugar the non-empty 'Match'es of a 'MatchGroup'. -- --- Returns a desugared guard tree of guard expressions. +-- TODO: Would this be a good design? +-- Returns a desugared guard tree of guard expressions /and/ an e-graph e-graph +-- per tree branch. +-- +-- These e-graphs have an equivalence class for each match-id in the guard +-- expression, and are required in the subsequent passes of the PMC +-- +-- Furthermore, the match-ids in the PmGrd expressions are e-class ids from said e-graph desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) -> DsM (PmMatchGroup Pre) desugarMatches vars matches = ===================================== compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -12,7 +12,6 @@ import GHC.Prelude import GHC.Data.List.Infinite (Infinite (..)) import qualified GHC.Data.List.Infinite as Inf import GHC.Types.Basic -import GHC.Types.Id import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Builtin.Types @@ -42,7 +41,7 @@ import qualified Data.IntMap as IM -- -- When the set of refutable shapes contains more than 3 elements, the -- additional elements are indicated by "...". -pprUncovered :: Nabla -> [Id] -> SDoc +pprUncovered :: Nabla -> [ClassId] -> SDoc pprUncovered nabla vas | IM.null refuts = fsep vec -- there are no refutations | otherwise = hang (fsep vec) 4 $ @@ -53,10 +52,9 @@ pprUncovered nabla vas -- precedence | [_] <- vas = topPrec | otherwise = appPrec - (vas',nabla') = representIds vas nabla - ppr_action = mapM (pprPmVar init_prec) vas' - (vec, renamings) = runPmPpr nabla' ppr_action - refuts = prettifyRefuts nabla' renamings + ppr_action = mapM (pprPmVar init_prec) vas + (vec, renamings) = runPmPpr nabla ppr_action + refuts = prettifyRefuts nabla renamings -- | Output refutable shapes of a variable in the form of @var is not one of {2, -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -1,7 +1,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RankNTypes, GADTs #-} {- Authors: George Karachalias @@ -105,8 +107,6 @@ import qualified Data.Equality.Graph as EG import Data.Bifunctor (second) import Data.Function ((&)) import qualified Data.IntSet as IS -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) -- -- * Main exports @@ -571,20 +571,20 @@ where you can find the solution in a perhaps more digestible format. data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". - | PhiCoreCt !Id !CoreExpr + | PhiCoreCt !ClassId !CoreExpr -- ^ @PhiCoreCt x e@ encodes "x ~ e", equating @x@ with the 'CoreExpr' @e at . - | PhiConCt !Id !PmAltCon ![TyVar] ![PredType] ![Id] + | HasCallStack => PhiConCt !ClassId !PmAltCon ![TyVar] ![PredType] ![ClassId] -- ^ @PhiConCt x K tvs dicts ys@ encodes @K \@tvs dicts ys <- x@, matching @x@ -- against the 'PmAltCon' application @K \@tvs dicts ys@, binding @tvs@, -- @dicts@ and possibly unlifted fields @ys@ in the process. -- See Note [Strict fields and variables of unlifted type]. - | PhiNotConCt !Id !PmAltCon + | PhiNotConCt !ClassId !PmAltCon -- ^ @PhiNotConCt x K@ encodes "x ≁ K", asserting that @x@ can't be headed -- by @K at . - | PhiBotCt !Id + | PhiBotCt !ClassId -- ^ @PhiBotCt x@ encodes "x ~ ⊥", equating @x@ to ⊥. -- by @K at . - | PhiNotBotCt !Id + | PhiNotBotCt !ClassId -- ^ @PhiNotBotCt x y@ encodes "x ≁ ⊥", asserting that @x@ can't be ⊥. instance Outputable PhiCt where @@ -674,31 +674,25 @@ nameTyCt pred_ty = do -- 'addTyCts' before, through 'addPhiCts'. addPhiTmCt :: Nabla -> PhiCt -> MaybeT DsM Nabla addPhiTmCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition -addPhiTmCt nabla (PhiCoreCt x e) = let (xid, nabla') = representId x nabla - in addCoreCt nabla' xid e -addPhiTmCt nabla (PhiConCt x con tvs dicts args) = do +addPhiTmCt nabla (PhiCoreCt x e) = addCoreCt nabla x e +addPhiTmCt nabla0 (PhiConCt x con tvs dicts args) = do -- Case (1) of Note [Strict fields and variables of unlifted type] -- PhiConCt correspond to the higher-level φ constraints from the paper with -- bindings semantics. It disperses into lower-level δ constraints that the -- 'add*Ct' functions correspond to. - nabla1 <- addTyCts nabla (listToBag dicts) - let (xid, nabla2) = representId x nabla1 - let (args_ids, nabla3) = representIds args nabla2 + nabla1 <- addTyCts nabla0 (listToBag dicts) -- romes: here we could have something like (merge (add K arg_ids) x) -- or actually that should be done by addConCt? - nabla4 <- addConCt nabla3 xid con tvs args_ids - foldlM addNotBotCt nabla4 (filterUnliftedFields con (zip args_ids args)) -addPhiTmCt nabla (PhiNotConCt x con) = let (xid, nabla') = representId x nabla - in addNotConCt nabla' xid con -addPhiTmCt nabla (PhiBotCt x) = let (xid, nabla') = representId x nabla - in addBotCt nabla' xid -addPhiTmCt nabla (PhiNotBotCt x) = let (xid, nabla') = representId x nabla - in addNotBotCt nabla' xid - -filterUnliftedFields :: PmAltCon -> [(ClassId,Id)] -> [ClassId] -filterUnliftedFields con args = - [ arg_id | ((arg_id,arg), bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) - , isBanged bang || definitelyUnliftedType (idType arg) ] + nabla2 <- addConCt nabla1 x con tvs args + foldlM addNotBotCt nabla2 (filterUnliftedFields nabla2 con args) +addPhiTmCt nabla (PhiNotConCt x con) = addNotConCt nabla x con +addPhiTmCt nabla (PhiBotCt x) = addBotCt nabla x +addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x + +filterUnliftedFields :: Nabla -> PmAltCon -> [ClassId] -> [ClassId] +filterUnliftedFields nabla con args = + [ arg_id | (arg_id, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || definitelyUnliftedType (eclassType arg_id nabla) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about @@ -788,7 +782,7 @@ hasRequiredTheta _ = False -- have on @x@, reject (@Nothing@) otherwise. -- -- See Note [TmState invariants]. -addConCt :: Nabla -> ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> MaybeT DsM Nabla +addConCt :: HasCallStack => Nabla -> ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts } x alt tvs args = do -- ROMES:TODO: Also looks like a function on varinfo (adjust) let vi@(VI _ pos neg bot _) = lookupVarInfo ts x @@ -838,14 +832,14 @@ equateTys ts us = -- @nabla@ has integrated the knowledge from the equality constraint. -- -- See Note [TmState invariants]. -addVarCt :: Nabla -> ClassId -> ClassId -> MaybeT DsM Nabla +addVarCt :: HasCallStack => Nabla -> ClassId -> ClassId -> MaybeT DsM Nabla -- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so case equate env x y of -- Add the constraints we had for x to y - -- See Note [Joining e-classes PMC] todo mention from joinA + -- See Note (TODO) Joining e-classes PMC] todo mention from joinA -- Now, here's a really tricky bit (TODO Write note, is it the one above?) -- Bc the joinA operation is unlawful, and because the makeA operation for -- expressions is also unlawful (sets the type to ()::(), mostly out of @@ -854,7 +848,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- We *also update the type* (WTF1). -- This is because every e-class should always have a match-var first, which will always have a type, and it should appear on "the left" -- We also rebuild here, we did just merge two things. TODO: Where and when exactly should we merge? - (vi_x, EG.rebuild -> env') -> do + (vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -875,7 +869,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) equate :: TmEGraph -> ClassId -> ClassId -> (VarInfo, TmEGraph) equate eg x y = let (_, eg') = EG.merge x y eg - in (eg ^. _class x ._data, eg') + in (eg ^. _class x ._data, EG.rebuild eg') -- Note: lookup in @eg@, not @eg'@, because we want to return x's data before the merge. @@ -900,6 +894,7 @@ addCoreCt nabla x e = do where -- Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. + -- ROMES:TODO: Consider CoreExprF instead of CoreExpr already here? core_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon -- RM: Could this be done better with e-graphs? The whole newtype stuff @@ -924,18 +919,18 @@ addCoreCt nabla x e = do <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args | otherwise - = do - nabla' <- get - if + = equate_with_similar_expr x e + -- nabla' <- get + -- if -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') + -- ROMES:TODO: Can we fix this more easily with e-graphs? + -- x| Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') -- We don't consider DataCons flexible variables - -> modifyT (\nabla -> let (yid, nabla') = representId y nabla - in addVarCt nabla' x yid) - | otherwise + -- -> modifyT (\nabla -> addVarCt nabla' x y) + -- x| otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! - -> equate_with_similar_expr x e + -- -> equate_with_similar_expr x e where expr_ty = exprType e expr_in_scope = mkInScopeSet (exprFreeVars e) @@ -960,10 +955,9 @@ addCoreCt nabla x e = do bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) - xid <- StateT $ \nabla -> pure $ representId x nabla - core_expr xid e - pure xid + x <- StateT $ \nabla -> lift (mkPmMatchId (exprType e) nabla) + core_expr x e + pure x -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -1480,7 +1474,6 @@ instCompleteSet fuel nabla xid cs = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where vi = lookupVarInfo (nabla_tm_st nabla) xid - x = vi_id vi sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1504,8 +1497,8 @@ instCompleteSet fuel nabla xid cs let recur_not_con = do nabla' <- addNotConCt nabla xid (PmAltConLike con) go nabla' cons - (nabla <$ instCon fuel nabla x con) -- return the original nabla, not the - -- refined one! + (nabla <$ instCon fuel nabla xid con) -- return the original nabla, not the + -- refined one! <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. @@ -1566,11 +1559,11 @@ compareConLikeTestability (RealDataCon a) (RealDataCon b) = mconcat -- adding the proper constructor constraint. -- -- See Note [Instantiating a ConLike]. -instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla -instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do +instCon :: Int -> Nabla -> ClassId -> ConLike -> MaybeT DsM Nabla +instCon fuel nabla0 at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do let hdr what = "instCon " ++ show fuel ++ " " ++ what env <- dsGetFamInstEnvs - let match_ty = idType x + let match_ty = eclassType x nabla0 tracePm (hdr "{") $ ppr con <+> text "... <-" <+> ppr x <+> dcolon <+> ppr match_ty norm_match_ty <- normaliseSourceTypeWHNF ty_st match_ty @@ -1588,24 +1581,23 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma let gammas = substTheta sigma_ex (eqSpecPreds eq_spec ++ thetas) -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys - arg_ids <- mapM mkPmId field_tys' - let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids + (arg_ids, nabla1) <- runStateT (mapM (StateT @Nabla . mkPmMatchId) field_tys') nabla0 tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) ] -- (5) Finally add the new constructor constraint runMaybeT $ do -- Case (2) of Note [Strict fields and variables of unlifted type] let alt = PmAltConLike con - let branching_factor = length $ filterUnliftedFields alt (zip arg_class_ids arg_ids) + let branching_factor = length $ filterUnliftedFields nabla1 alt arg_ids let ct = PhiConCt x alt ex_tvs gammas arg_ids - nabla1 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ - addPhiTmCt nabla' ct + nabla2 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ + addPhiTmCt nabla1 ct -- See Note [Fuel for the inhabitation test] let new_fuel | branching_factor <= 1 = fuel @@ -1617,17 +1609,17 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) , ppr branching_factor , ppr new_fuel ] - nabla2 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla1) $ - inhabitationTest new_fuel (nabla_ty_st nabla') nabla1 - lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla2) - pure nabla2 + nabla3 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla2) $ + inhabitationTest new_fuel (nabla_ty_st nabla1) nabla2 + lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla3) + pure nabla3 Nothing -> do tracePm (hdr "(match_ty not instance of res_ty) }") empty - pure (Just nabla) -- Matching against match_ty failed. Inhabited! + pure (Just nabla0) -- Matching against match_ty failed. Inhabited! -- See Note [Instantiating a ConLike]. -- | @matchConLikeResTy _ _ ty K@ tries to match @ty@ against the result @@ -2036,12 +2028,11 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do - y <- lift $ mkPmId arg_ty - let (yid,nabla') = representId y nabla + (y,nabla') <- lift $ mkPmMatchId arg_ty nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] - instantiate_newtype_chain yid nabla'' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [y] + instantiate_newtype_chain y nabla'' dcs instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] @@ -2052,7 +2043,7 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do = generateInhabitingPatterns mode xs n nabla instantiate_cons x ty xs n nabla (cl:cls) = do -- The following line is where we call out to the inhabitationTest! - mb_nabla <- runMaybeT $ instCon 4 nabla (eclassMatchId x nabla) cl + mb_nabla <- runMaybeT $ instCon 4 nabla x cl tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (eclassType x nabla) , ppr ty , ppr cl @@ -2155,5 +2146,13 @@ eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) eclassType :: ClassId -> Nabla -> Type eclassType cid = idType . eclassMatchId cid - -- ROMES:TODO: When exactly to rebuild? + +-- | Generate a fresh class for matching, returning the class-id as the match-id +mkPmMatchId :: Type -> Nabla -> DsM (ClassId, Nabla) +mkPmMatchId ty (MkNabla tyst ts at TmSt{ts_facts = egr}) = do + x <- mkPmId ty -- romes:Todo: for now, we still use mkPmId to get an Id for emptyVarInfo, but we want to get rid of this too + let (xid, egr') = EG.newEClass (emptyVarInfo x) egr + return (xid, MkNabla tyst ts{ts_facts=egr'}) +{-# NOINLINE mkPmMatchId #-} -- We'll CPR deeply, that should be enough + ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -88,7 +88,10 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second) +import Data.Bifunctor (second, bimap) +import Control.Monad.Trans.State (runState, state) +import Data.List (sortOn) +import Data.Ord (Down(..)) -- import GHC.Driver.Ppr @@ -318,7 +321,6 @@ emptyVarInfo x -- | @lookupVarInfo tms x@ tells what we know about 'x' --- romes:TODO: This will have a different type. I don't know what yet. -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? --- romes:TodO should return VarInfo rather than Maybe VarInfo lookupVarInfo :: TmState -> ClassId -> VarInfo lookupVarInfo (TmSt eg _) x -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. @@ -834,14 +836,27 @@ type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) instance Show VarInfo where show = showPprUnsafe . ppr -representId :: Id -> Nabla -> (ClassId, Nabla) --- Will need to justify this well -representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) +representId :: Id -> Nablas -> (ClassId, Nablas) +-- TODO:TOMORROW: pick the highest Id, and use newPointerToClassId on the Nablas on which the represented Id got a lower clsas Id +-- +-- I suppose that if we do it earlier, we can make all the nablas share the exact same match-ids and avoid this complexity. +representId x (MkNablas nbs) + = case unzip $ map go (bagToList nbs) of + (ids,nablas) -> + case sortOn Down ids of + [] -> panic "representId: impossible, there's at least one nabla" + (max_i:_) -> + let go_zip i nabla@(MkNabla tyst tmst at TmSt{ts_facts=eg0}) = if max_i > i + then MkNabla tyst tmst{ts_facts=EG.newPointerToClassId max_i i eg0} + else nabla + in (max_i, MkNablas $ listToBag $ zipWith go_zip ids nablas) + where + go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) -representIds :: [Id] -> Nabla -> ([ClassId], Nabla) -representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs +representIds :: [Id] -> Nablas -> ([ClassId], Nablas) +representIds xs = runState (mapM (state . representId) xs) -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. ===================================== compiler/GHC/Types/Unique/SDFM.hs deleted ===================================== @@ -1,122 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE ApplicativeDo #-} -{-# OPTIONS_GHC -Wall #-} - --- | Like a 'UniqDFM', but maintains equivalence classes of keys sharing the --- same entry. See 'UniqSDFM'. -module GHC.Types.Unique.SDFM ( - -- * Unique-keyed, /shared/, deterministic mappings - UniqSDFM, - - emptyUSDFM, - lookupUSDFM, - equateUSDFM, addToUSDFM, - traverseUSDFM - ) where - -import GHC.Prelude - -import GHC.Types.Unique -import GHC.Types.Unique.DFM -import GHC.Utils.Outputable - --- | Either @Indirect x@, meaning the value is represented by that of @x@, or --- an @Entry@ containing containing the actual value it represents. -data Shared key ele - = Indirect !key - | Entry !ele - --- | A 'UniqDFM' whose domain is /sets/ of 'Unique's, each of which share a --- common value of type @ele at . --- Every such set (\"equivalence class\") has a distinct representative --- 'Unique'. Supports merging the entries of multiple such sets in a union-find --- like fashion. --- --- An accurate model is that of @[(Set key, Maybe ele)]@: A finite mapping from --- sets of @key at s to possibly absent entries @ele@, where the sets don't overlap. --- Example: --- @ --- m = [({u1,u3}, Just ele1), ({u2}, Just ele2), ({u4,u7}, Nothing)] --- @ --- On this model we support the following main operations: --- --- * @'lookupUSDFM' m u3 == Just ele1@, @'lookupUSDFM' m u4 == Nothing@, --- @'lookupUSDFM' m u5 == Nothing at . --- * @'equateUSDFM' m u1 u3@ is a no-op, but --- @'equateUSDFM' m u1 u2@ merges @{u1,u3}@ and @{u2}@ to point to --- @Just ele2@ and returns the old entry of @{u1,u3}@, @Just ele1 at . --- * @'addToUSDFM' m u3 ele4@ sets the entry of @{u1,u3}@ to @Just ele4 at . --- --- As well as a few means for traversal/conversion to list. -newtype UniqSDFM key ele - = USDFM { unUSDFM :: UniqDFM key (Shared key ele) } - -emptyUSDFM :: UniqSDFM key ele -emptyUSDFM = USDFM emptyUDFM - -lookupReprAndEntryUSDFM :: Uniquable key => UniqSDFM key ele -> key -> (key, Maybe ele) -lookupReprAndEntryUSDFM (USDFM env) = go - where - go x = case lookupUDFM env x of - Nothing -> (x, Nothing) - Just (Indirect y) -> go y - Just (Entry ele) -> (x, Just ele) - --- | @lookupSUDFM env x@ looks up an entry for @x@, looking through all --- 'Indirect's until it finds a shared 'Entry'. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 == Just ele1 --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u4 == Nothing --- >>> lookupUSDFM [({u1,u3}, Just ele1), ({u2}, Nothing)] u2 == Nothing -lookupUSDFM :: Uniquable key => UniqSDFM key ele -> key -> Maybe ele -lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) - --- | @equateUSDFM env x y@ makes @x@ and @y@ point to the same entry, --- thereby merging @x@'s class with @y@'s. --- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be --- chosen as the new entry and @x@'s old entry will be returned. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> equateUSDFM [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) --- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) --- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) --- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) --- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? -equateUSDFM - :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) -equateUSDFM usdfm@(USDFM env) x y = - case (lu x, lu y) of - ((x', _) , (y', _)) - | getUnique x' == getUnique y' -> (Nothing, usdfm) -- nothing to do - ((x', _) , (y', Nothing)) -> (Nothing, set_indirect y' x') - ((x', mb_ex), (y', _)) -> (mb_ex, set_indirect x' y') - where - lu = lookupReprAndEntryUSDFM usdfm - set_indirect a b = USDFM $ addToUDFM env a (Indirect b) - --- | @addToUSDFM env x a@ sets the entry @x@ is associated with to @a@, --- thereby modifying its whole equivalence class. --- --- Examples in terms of the model (see 'UniqSDFM'): --- >>> addToUSDFM [] u1 ele1 == [({u1}, Just ele1)] --- >>> addToUSDFM [({u1,u3}, Just ele1)] u3 ele2 == [({u1,u3}, Just ele2)] -addToUSDFM :: Uniquable key => UniqSDFM key ele -> key -> ele -> UniqSDFM key ele -addToUSDFM usdfm@(USDFM env) x v = - USDFM $ addToUDFM env (fst (lookupReprAndEntryUSDFM usdfm x)) (Entry v) - -traverseUSDFM :: forall key a b f. Applicative f => (a -> f b) -> UniqSDFM key a -> f (UniqSDFM key b) -traverseUSDFM f = fmap (USDFM . listToUDFM_Directly) . traverse g . udfmToList . unUSDFM - where - g :: (Unique, Shared key a) -> f (Unique, Shared key b) - g (u, Indirect y) = pure (u,Indirect y) - g (u, Entry a) = do - a' <- f a - pure (u,Entry a') - -instance (Outputable key, Outputable ele) => Outputable (Shared key ele) where - ppr (Indirect x) = ppr x - ppr (Entry a) = ppr a - -instance (Outputable key, Outputable ele) => Outputable (UniqSDFM key ele) where - ppr (USDFM env) = ppr env ===================================== compiler/ghc.cabal.in ===================================== @@ -818,7 +818,6 @@ Library GHC.Types.Unique.FM GHC.Types.Unique.Map GHC.Types.Unique.MemoFun - GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 +Subproject commit f2cb5d7671f9135340fd2bd782f08614c34bceeb ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -248,7 +248,6 @@ GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Map -GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -255,7 +255,6 @@ GHC.Types.Unique.DFM GHC.Types.Unique.DSet GHC.Types.Unique.FM GHC.Types.Unique.Map -GHC.Types.Unique.SDFM GHC.Types.Unique.Set GHC.Types.Unique.Supply GHC.Types.Var View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d2039eecbf8e8ca071c63803640a3e32c05ee01...e779a75246e3f6dc4ecbdf79eec77fd803a1e57d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d2039eecbf8e8ca071c63803640a3e32c05ee01...e779a75246e3f6dc4ecbdf79eec77fd803a1e57d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 11:18:54 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 07:18:54 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Fix to representId over multiple (different) nablas Message-ID: <64a6a31e3f715_1849791ad3030154694@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 11153cf5 by Rodrigo Mesquita at 2023-07-06T12:18:45+01:00 Fix to representId over multiple (different) nablas - - - - - 2 changed files: - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -79,8 +79,6 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) import Data.Functor.Compose import Data.Equality.Analysis (Analysis(..)) import Data.Equality.Graph (EGraph, ClassId) @@ -88,8 +86,10 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second, bimap) +import Data.Bifunctor (second) import Control.Monad.Trans.State (runState, state) +import Data.List (sortOn) +import Data.Ord (Down(..)) -- import GHC.Driver.Ppr @@ -835,15 +835,23 @@ instance Show VarInfo where show = showPprUnsafe . ppr representId :: Id -> Nablas -> (ClassId, Nablas) --- Will need to justify this well --- ROMES:TODO: The headMaybe is wrong, because the nablas are not exactly the --- same, and the match-id in one might not be the same match-id in the other, --- weirdly. I suppose that if we do it earlier, we can make all the nablas --- share the same match-ids. -representId x (MkNablas nbs) = bimap (fromJust . headMaybe) MkNablas $ unzipBag $ mapBag go nbs where - go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) +-- TODO:TOMORROW: pick the highest Id, and use newPointerToClassId on the Nablas on which the represented Id got a lower clsas Id +-- +-- I suppose that if we do it earlier, we can make all the nablas share the exact same match-ids and avoid this complexity. +representId x (MkNablas nbs) + = case unzip $ map go (bagToList nbs) of + (ids,nablas) -> + case sortOn Down ids of + [] -> panic "representId: impossible, there's at least one nabla" + (max_i:_) -> + let go_zip i nabla@(MkNabla tyst tmst at TmSt{ts_facts=eg0}) = if max_i > i + then MkNabla tyst tmst{ts_facts=EG.newPointerToClassId max_i i eg0} + else nabla + in (max_i, MkNablas $ listToBag $ zipWith go_zip ids nablas) + where + go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) representIds :: [Id] -> Nablas -> ([ClassId], Nablas) representIds xs = runState (mapM (state . representId) xs) ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 +Subproject commit f2cb5d7671f9135340fd2bd782f08614c34bceeb View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11153cf5f91456df835c87b5fadb4d577751d82a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11153cf5f91456df835c87b5fadb4d577751d82a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 11:48:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 07:48:40 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 2 commits: Fix to representId over multiple (different) nablas Message-ID: <64a6aa18e5596_184979aec2c1585bc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 416586ce by Rodrigo Mesquita at 2023-07-06T12:21:09+01:00 Fix to representId over multiple (different) nablas - - - - - f9443fbe by Rodrigo Mesquita at 2023-07-06T12:48:23+01:00 Paper over - - - - - 4 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -76,6 +76,7 @@ import qualified Data.List.NonEmpty as NE import Data.Coerce import Data.Equality.Graph (ClassId) +import Data.Maybe (maybeToList) -- -- * Exported entry points to the checker @@ -119,7 +120,7 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do -- empty-eclasses, the representId on the next line wouldn't match the match -- ids we defined in checkPatBind. let (varid, cr_uncov') = representId var (cr_uncov result0) - formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} + formatReportWarnings ReportPatBind ctxt (maybeToList varid) result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -189,7 +190,10 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do result0 <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + let (varids, cr_uncov') = representIds vars (cr_uncov result0) + -- romes:todo: this seems redundant, hints that the right thing might be + -- for desugar to return already the match variable already "represented" + -- in the e-graph {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} return (NE.toList (ldiMatchGroup (cr_ret result0))) @@ -445,8 +449,10 @@ addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k addCoreScrutTmCs (scr:scrs) (x0:xs) k = flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> - let (x, nablas) = representId x0 nablas0 - in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) + let (mvarid, nablas) = representId x0 nablas0 + in case mvarid of + Nothing -> return nablas0 -- return the empty nablas unchanged + Just x -> addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -106,27 +106,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc0 -> case grd of -- let x = e: Refine with x ~ e PmLet x0 e -> do - let (x, inc) = representId x0 inc0 - -- romes: we could potentially do update the trees to use e-class ids here, - -- or in pmcMatches - matched <- addPhiCtNablas inc (PhiCoreCt x e) - tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) - pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } - , cr_uncov = mempty - , cr_approx = Precise } + -- It'd be better to do this earlier even, maybe + let (mx, inc) = representId x0 inc0 + case mx of + Nothing -> emptyCheckResult + Just x -> do + matched <- addPhiCtNablas inc (PhiCoreCt x e) + tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } + , cr_uncov = mempty + , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ PmBang x0 mb_info -> do - let (x, inc) = representId x0 inc0 - div <- addPhiCtNablas inc (PhiBotCt x) - matched <- addPhiCtNablas inc (PhiNotBotCt x) - -- See Note [Dead bang patterns] - -- mb_info = Just info <==> PmBang originates from bang pattern in source - let bangs | Just info <- mb_info = unitOL (div, info) - | otherwise = NilOL - tracePm "check:Bang" (ppr x <+> ppr div) - pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } - , cr_uncov = mempty - , cr_approx = Precise } + let (mx, inc) = representId x0 inc0 + case mx of + Nothing -> emptyCheckResult + Just x -> do + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt x) + -- See Note [Dead bang patterns] + -- mb_info = Just info <==> PmBang originates from bang pattern in source + let bangs | Just info <- mb_info = unitOL (div, info) + | otherwise = NilOL + tracePm "check:Bang" (ppr x <+> ppr div) + pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } + , cr_uncov = mempty + , cr_approx = Precise } -- See point (3) of Note [considerAccessible] PmCon x (PmAltConLike con) _ _ _ | x `hasKey` considerAccessibleIdKey @@ -136,24 +141,32 @@ checkGrd grd = CA $ \inc0 -> case grd of , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x0 con tvs dicts args0 -> do - let (x, inc1) = representId x0 inc0 + let (mx, inc1) = representId x0 inc0 (args, inc) = representIds args0 inc1 - pprTraceM "PmCon" (ppr inc $$ text "args:" <+> ppr args) - !div <- if isPmAltConMatchStrict con - then addPhiCtNablas inc (PhiBotCt x) - else pure mempty - !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) - !uncov <- addPhiCtNablas inc (PhiNotConCt x con) - tracePm "check:Con" $ vcat - [ ppr grd - , ppr inc - , hang (text "div") 2 (ppr div) - , hang (text "matched") 2 (ppr matched) - , hang (text "uncov") 2 (ppr uncov) - ] - pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } - , cr_uncov = uncov - , cr_approx = Precise } + case mx of + Nothing -> emptyCheckResult + Just x -> do + pprTraceM "PmCon" (ppr inc $$ text "args:" <+> ppr args) + !div <- if isPmAltConMatchStrict con + then addPhiCtNablas inc (PhiBotCt x) + else pure mempty + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } + , cr_uncov = uncov + , cr_approx = Precise } + where + -- We return this when we know the nablas are empty + emptyCheckResult = pure CheckResult { cr_ret = emptyRedSets + , cr_uncov = mempty + , cr_approx = Precise } checkGrds :: [PmGrd] -> CheckAction RedSets checkGrds [] = CA $ \inc -> @@ -186,9 +199,12 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - let (varid, inc') = representId var inc - unc <- addPhiCtNablas inc' (PhiNotBotCt varid) - pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } + let (mvarid, inc') = representId var inc + case mvarid of + Nothing -> pure (CheckResult pe mempty Precise) + Just varid -> do + unc <- addPhiCtNablas inc' (PhiNotBotCt varid) + pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) checkPatBind = coerce checkGRHS ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -79,8 +79,6 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) import Data.Functor.Compose import Data.Equality.Analysis (Analysis(..)) import Data.Equality.Graph (EGraph, ClassId) @@ -88,8 +86,10 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second, bimap) +import Data.Bifunctor (second) import Control.Monad.Trans.State (runState, state) +import Data.List (sortOn) +import Data.Ord (Down(..)) -- import GHC.Driver.Ppr @@ -834,19 +834,35 @@ type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) instance Show VarInfo where show = showPprUnsafe . ppr -representId :: Id -> Nablas -> (ClassId, Nablas) --- Will need to justify this well --- ROMES:TODO: The headMaybe is wrong, because the nablas are not exactly the --- same, and the match-id in one might not be the same match-id in the other, --- weirdly. I suppose that if we do it earlier, we can make all the nablas --- share the same match-ids. -representId x (MkNablas nbs) = bimap (fromJust . headMaybe) MkNablas $ unzipBag $ mapBag go nbs where - go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) + +-- I think the right thing to do here is have representId always return a ClassId, or panic +-- and have an additional method which is called by representIds... +-- +-- | Represents a match-id in 'Nablas' and returns the match-id in terms of the e-graph +-- +-- It returns Nothing if the Nablas is empty, and hence there's no returned +-- match-id in terms of e-graphs (there are none in which we can represent that Id) +representId :: Id -> Nablas -> (Maybe ClassId, Nablas) +-- TODO:TOMORROW: pick the highest Id, and use newPointerToClassId on the Nablas on which the represented Id got a lower clsas Id +-- +-- I suppose that if we do it earlier, we can make all the nablas share the exact same match-ids and avoid this complexity. +representId x (MkNablas nbs) + = case unzip $ map go (bagToList nbs) of + (ids,nablas) -> + case sortOn Down ids of + [] -> (Nothing, MkNablas nbs) + (max_i:_) -> + let go_zip i nabla@(MkNabla tyst tmst at TmSt{ts_facts=eg0}) = if max_i > i + then MkNabla tyst tmst{ts_facts=EG.newPointerToClassId max_i i eg0} + else nabla + in (Just max_i, MkNablas $ listToBag $ zipWith go_zip ids nablas) + where + go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) representIds :: [Id] -> Nablas -> ([ClassId], Nablas) -representIds xs = runState (mapM (state . representId) xs) +representIds xs = runState (catMaybes <$> mapM (state . representId) xs) -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 +Subproject commit f2cb5d7671f9135340fd2bd782f08614c34bceeb View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11153cf5f91456df835c87b5fadb4d577751d82a...f9443fbeb16440fc1f95bff2670bd94e195f35dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/11153cf5f91456df835c87b5fadb4d577751d82a...f9443fbeb16440fc1f95bff2670bd94e195f35dd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 12:21:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 06 Jul 2023 08:21:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Substitute free variables captured by breakpoints in SpecConstr Message-ID: <64a6b1e7ab36e_184979aec90167832@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - c1e4dc10 by Torsten Schmits at 2023-07-06T08:21:42-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - b8173e9f by Sylvain Henry at 2023-07-06T08:21:53-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 09564528 by Sylvain Henry at 2023-07-06T08:21:53-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - configure.ac - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Rules/Generate.hs - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/openFile003.stdout-javascript-unknown-ghcjs - libraries/base/tests/all.T - m4/fp_settings.m4 - testsuite/ghc-config/ghc-config.hs - testsuite/tests/ado/T16135.stderr - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/723a1d8f81cd2aa973508afd2fb8e1b04cde2f6f...09564528f481f9189a9e39a54a0a0688f0cb547c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/723a1d8f81cd2aa973508afd2fb8e1b04cde2f6f...09564528f481f9189a9e39a54a0a0688f0cb547c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 12:33:52 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 08:33:52 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Paper over Message-ID: <64a6b4b07696b_1849791ae3b381753e6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 11731595 by Rodrigo Mesquita at 2023-07-06T13:33:42+01:00 Paper over - - - - - 4 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -76,6 +76,7 @@ import qualified Data.List.NonEmpty as NE import Data.Coerce import Data.Equality.Graph (ClassId) +import Data.Maybe (maybeToList) -- -- * Exported entry points to the checker @@ -119,7 +120,7 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do -- empty-eclasses, the representId on the next line wouldn't match the match -- ids we defined in checkPatBind. let (varid, cr_uncov') = representId var (cr_uncov result0) - formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} + formatReportWarnings ReportPatBind ctxt (maybeToList varid) result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -189,7 +190,10 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do result0 <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + let (varids, cr_uncov') = representIds vars (cr_uncov result0) + -- romes:todo: this seems redundant, hints that the right thing might be + -- for desugar to return already the match variable already "represented" + -- in the e-graph {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} return (NE.toList (ldiMatchGroup (cr_ret result0))) @@ -445,8 +449,10 @@ addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k addCoreScrutTmCs (scr:scrs) (x0:xs) k = flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> - let (x, nablas) = representId x0 nablas0 - in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) + let (mvarid, nablas) = representId x0 nablas0 + in case mvarid of + Nothing -> return nablas0 -- return the empty nablas unchanged + Just x -> addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -106,27 +106,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc0 -> case grd of -- let x = e: Refine with x ~ e PmLet x0 e -> do - let (x, inc) = representId x0 inc0 - -- romes: we could potentially do update the trees to use e-class ids here, - -- or in pmcMatches - matched <- addPhiCtNablas inc (PhiCoreCt x e) - tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) - pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } - , cr_uncov = mempty - , cr_approx = Precise } + -- It'd be better to do this earlier even, maybe + let (mx, inc) = representId x0 inc0 + case mx of + Nothing -> emptyCheckResult + Just x -> do + matched <- addPhiCtNablas inc (PhiCoreCt x e) + tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } + , cr_uncov = mempty + , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ PmBang x0 mb_info -> do - let (x, inc) = representId x0 inc0 - div <- addPhiCtNablas inc (PhiBotCt x) - matched <- addPhiCtNablas inc (PhiNotBotCt x) - -- See Note [Dead bang patterns] - -- mb_info = Just info <==> PmBang originates from bang pattern in source - let bangs | Just info <- mb_info = unitOL (div, info) - | otherwise = NilOL - tracePm "check:Bang" (ppr x <+> ppr div) - pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } - , cr_uncov = mempty - , cr_approx = Precise } + let (mx, inc) = representId x0 inc0 + case mx of + Nothing -> emptyCheckResult + Just x -> do + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt x) + -- See Note [Dead bang patterns] + -- mb_info = Just info <==> PmBang originates from bang pattern in source + let bangs | Just info <- mb_info = unitOL (div, info) + | otherwise = NilOL + tracePm "check:Bang" (ppr x <+> ppr div) + pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } + , cr_uncov = mempty + , cr_approx = Precise } -- See point (3) of Note [considerAccessible] PmCon x (PmAltConLike con) _ _ _ | x `hasKey` considerAccessibleIdKey @@ -136,24 +141,32 @@ checkGrd grd = CA $ \inc0 -> case grd of , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x0 con tvs dicts args0 -> do - let (x, inc1) = representId x0 inc0 + let (mx, inc1) = representId x0 inc0 (args, inc) = representIds args0 inc1 - pprTraceM "PmCon" (ppr inc $$ text "args:" <+> ppr args) - !div <- if isPmAltConMatchStrict con - then addPhiCtNablas inc (PhiBotCt x) - else pure mempty - !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) - !uncov <- addPhiCtNablas inc (PhiNotConCt x con) - tracePm "check:Con" $ vcat - [ ppr grd - , ppr inc - , hang (text "div") 2 (ppr div) - , hang (text "matched") 2 (ppr matched) - , hang (text "uncov") 2 (ppr uncov) - ] - pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } - , cr_uncov = uncov - , cr_approx = Precise } + case mx of + Nothing -> emptyCheckResult + Just x -> do + pprTraceM "PmCon" (ppr inc $$ text "args:" <+> ppr args) + !div <- if isPmAltConMatchStrict con + then addPhiCtNablas inc (PhiBotCt x) + else pure mempty + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } + , cr_uncov = uncov + , cr_approx = Precise } + where + -- We return this when we know the nablas are empty + emptyCheckResult = pure CheckResult { cr_ret = emptyRedSets + , cr_uncov = mempty + , cr_approx = Precise } checkGrds :: [PmGrd] -> CheckAction RedSets checkGrds [] = CA $ \inc -> @@ -186,9 +199,12 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - let (varid, inc') = representId var inc - unc <- addPhiCtNablas inc' (PhiNotBotCt varid) - pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } + let (mvarid, inc') = representId var inc + case mvarid of + Nothing -> pure (CheckResult pe mempty Precise) + Just varid -> do + unc <- addPhiCtNablas inc' (PhiNotBotCt varid) + pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) checkPatBind = coerce checkGRHS ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -84,12 +85,15 @@ import Data.Equality.Analysis (Analysis(..)) import Data.Equality.Graph (EGraph, ClassId) import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG +import qualified Data.Equality.Graph.Internal as EG +import qualified Data.Equality.Graph.ReprUnionFind as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) import Data.Bifunctor (second) import Control.Monad.Trans.State (runState, state) import Data.List (sortOn) import Data.Ord (Down(..)) +import GHC.Int (Int(..)) -- import GHC.Driver.Ppr @@ -834,27 +838,35 @@ type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) instance Show VarInfo where show = showPprUnsafe . ppr -representId :: Id -> Nablas -> (ClassId, Nablas) + +-- I think the right thing to do here is have representId always return a ClassId, or panic +-- and have an additional method which is called by representIds... +-- +-- | Represents a match-id in 'Nablas' and returns the match-id in terms of the e-graph +-- +-- It returns Nothing if the Nablas is empty, and hence there's no returned +-- match-id in terms of e-graphs (there are none in which we can represent that Id) +representId :: Id -> Nablas -> (Maybe ClassId, Nablas) -- TODO:TOMORROW: pick the highest Id, and use newPointerToClassId on the Nablas on which the represented Id got a lower clsas Id -- -- I suppose that if we do it earlier, we can make all the nablas share the exact same match-ids and avoid this complexity. representId x (MkNablas nbs) - = case unzip $ map go (bagToList nbs) of - (ids,nablas) -> - case sortOn Down ids of - [] -> MkNablas emptyBag - (max_i:_) -> - let go_zip i nabla@(MkNabla tyst tmst at TmSt{ts_facts=eg0}) = if max_i > i - then MkNabla tyst tmst{ts_facts=EG.newPointerToClassId max_i i eg0} - else nabla - in (max_i, MkNablas $ listToBag $ zipWith go_zip ids nablas) + = case unzip3 $ map go (bagToList nbs) of + (counters,ids,nablas) -> + case sortOn Down counters of + [] -> (Nothing, MkNablas nbs) + (max_counter:_) -> + let go_zip i (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + -- The max counter will be never be an id already in these e-graphs + = MkNabla tyst tmst{ts_facts=EG.newPointerToClassId max_counter i eg0} + in (Just max_counter, MkNablas $ listToBag $ zipWith go_zip ids nablas) where go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) + (xid, eg1) -> (case EG.unionFind eg0 of EG.RUF _ size# -> I# size#, xid, MkNabla tyst tmst{ts_facts=eg1}) representIds :: [Id] -> Nablas -> ([ClassId], Nablas) -representIds xs = runState (mapM (state . representId) xs) +representIds xs = runState (catMaybes <$> mapM (state . representId) xs) -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit f2cb5d7671f9135340fd2bd782f08614c34bceeb +Subproject commit ff5fa306092c6539866d5ebffde9a3041d83444f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1173159511519aa49f6301ecd61cddd0258159c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1173159511519aa49f6301ecd61cddd0258159c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 12:40:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 08:40:04 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Paper over Message-ID: <64a6b6248981e_1849791ae3b4c1757ab@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 8a397ff9 by Rodrigo Mesquita at 2023-07-06T13:39:53+01:00 Paper over - - - - - 4 changed files: - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -76,6 +76,7 @@ import qualified Data.List.NonEmpty as NE import Data.Coerce import Data.Equality.Graph (ClassId) +import Data.Maybe (maybeToList) -- -- * Exported entry points to the checker @@ -119,7 +120,7 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do -- empty-eclasses, the representId on the next line wouldn't match the match -- ids we defined in checkPatBind. let (varid, cr_uncov') = representId var (cr_uncov result0) - formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} + formatReportWarnings ReportPatBind ctxt (maybeToList varid) result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -189,7 +190,10 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do result0 <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + let (varids, cr_uncov') = representIds vars (cr_uncov result0) + -- romes:todo: this seems redundant, hints that the right thing might be + -- for desugar to return already the match variable already "represented" + -- in the e-graph {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} return (NE.toList (ldiMatchGroup (cr_ret result0))) @@ -445,8 +449,10 @@ addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k addCoreScrutTmCs (scr:scrs) (x0:xs) k = flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> - let (x, nablas) = representId x0 nablas0 - in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) + let (mvarid, nablas) = representId x0 nablas0 + in case mvarid of + Nothing -> return nablas0 -- return the empty nablas unchanged + Just x -> addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -106,27 +106,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc0 -> case grd of -- let x = e: Refine with x ~ e PmLet x0 e -> do - let (x, inc) = representId x0 inc0 - -- romes: we could potentially do update the trees to use e-class ids here, - -- or in pmcMatches - matched <- addPhiCtNablas inc (PhiCoreCt x e) - tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) - pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } - , cr_uncov = mempty - , cr_approx = Precise } + -- It'd be better to do this earlier even, maybe + let (mx, inc) = representId x0 inc0 + case mx of + Nothing -> emptyCheckResult + Just x -> do + matched <- addPhiCtNablas inc (PhiCoreCt x e) + tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } + , cr_uncov = mempty + , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ PmBang x0 mb_info -> do - let (x, inc) = representId x0 inc0 - div <- addPhiCtNablas inc (PhiBotCt x) - matched <- addPhiCtNablas inc (PhiNotBotCt x) - -- See Note [Dead bang patterns] - -- mb_info = Just info <==> PmBang originates from bang pattern in source - let bangs | Just info <- mb_info = unitOL (div, info) - | otherwise = NilOL - tracePm "check:Bang" (ppr x <+> ppr div) - pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } - , cr_uncov = mempty - , cr_approx = Precise } + let (mx, inc) = representId x0 inc0 + case mx of + Nothing -> emptyCheckResult + Just x -> do + div <- addPhiCtNablas inc (PhiBotCt x) + matched <- addPhiCtNablas inc (PhiNotBotCt x) + -- See Note [Dead bang patterns] + -- mb_info = Just info <==> PmBang originates from bang pattern in source + let bangs | Just info <- mb_info = unitOL (div, info) + | otherwise = NilOL + tracePm "check:Bang" (ppr x <+> ppr div) + pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } + , cr_uncov = mempty + , cr_approx = Precise } -- See point (3) of Note [considerAccessible] PmCon x (PmAltConLike con) _ _ _ | x `hasKey` considerAccessibleIdKey @@ -136,24 +141,32 @@ checkGrd grd = CA $ \inc0 -> case grd of , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info PmCon x0 con tvs dicts args0 -> do - let (x, inc1) = representId x0 inc0 + let (mx, inc1) = representId x0 inc0 (args, inc) = representIds args0 inc1 - pprTraceM "PmCon" (ppr inc $$ text "args:" <+> ppr args) - !div <- if isPmAltConMatchStrict con - then addPhiCtNablas inc (PhiBotCt x) - else pure mempty - !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) - !uncov <- addPhiCtNablas inc (PhiNotConCt x con) - tracePm "check:Con" $ vcat - [ ppr grd - , ppr inc - , hang (text "div") 2 (ppr div) - , hang (text "matched") 2 (ppr matched) - , hang (text "uncov") 2 (ppr uncov) - ] - pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } - , cr_uncov = uncov - , cr_approx = Precise } + case mx of + Nothing -> emptyCheckResult + Just x -> do + pprTraceM "PmCon" (ppr inc $$ text "args:" <+> ppr args) + !div <- if isPmAltConMatchStrict con + then addPhiCtNablas inc (PhiBotCt x) + else pure mempty + !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) + !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + tracePm "check:Con" $ vcat + [ ppr grd + , ppr inc + , hang (text "div") 2 (ppr div) + , hang (text "matched") 2 (ppr matched) + , hang (text "uncov") 2 (ppr uncov) + ] + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } + , cr_uncov = uncov + , cr_approx = Precise } + where + -- We return this when we know the nablas are empty + emptyCheckResult = pure CheckResult { cr_ret = emptyRedSets + , cr_uncov = mempty + , cr_approx = Precise } checkGrds :: [PmGrd] -> CheckAction RedSets checkGrds [] = CA $ \inc -> @@ -186,9 +199,12 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - let (varid, inc') = representId var inc - unc <- addPhiCtNablas inc' (PhiNotBotCt varid) - pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } + let (mvarid, inc') = representId var inc + case mvarid of + Nothing -> pure (CheckResult pe mempty Precise) + Just varid -> do + unc <- addPhiCtNablas inc' (PhiNotBotCt varid) + pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) checkPatBind = coerce checkGRHS ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -84,12 +85,15 @@ import Data.Equality.Analysis (Analysis(..)) import Data.Equality.Graph (EGraph, ClassId) import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG +import qualified Data.Equality.Graph.Internal as EG +import qualified Data.Equality.Graph.ReprUnionFind as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) import Data.Bifunctor (second) import Control.Monad.Trans.State (runState, state) import Data.List (sortOn) import Data.Ord (Down(..)) +import GHC.Int (Int(..)) -- import GHC.Driver.Ppr @@ -834,27 +838,35 @@ type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) instance Show VarInfo where show = showPprUnsafe . ppr -representId :: Id -> Nablas -> (ClassId, Nablas) + +-- I think the right thing to do here is have representId always return a ClassId, or panic +-- and have an additional method which is called by representIds... +-- +-- | Represents a match-id in 'Nablas' and returns the match-id in terms of the e-graph +-- +-- It returns Nothing if the Nablas is empty, and hence there's no returned +-- match-id in terms of e-graphs (there are none in which we can represent that Id) +representId :: Id -> Nablas -> (Maybe ClassId, Nablas) -- TODO:TOMORROW: pick the highest Id, and use newPointerToClassId on the Nablas on which the represented Id got a lower clsas Id -- -- I suppose that if we do it earlier, we can make all the nablas share the exact same match-ids and avoid this complexity. representId x (MkNablas nbs) - = case unzip $ map go (bagToList nbs) of - (ids,nablas) -> - case sortOn Down ids of - [] -> MkNablas emptyBag - (max_i:_) -> - let go_zip i nabla@(MkNabla tyst tmst at TmSt{ts_facts=eg0}) = if max_i > i - then MkNabla tyst tmst{ts_facts=EG.newPointerToClassId max_i i eg0} - else nabla - in (max_i, MkNablas $ listToBag $ zipWith go_zip ids nablas) + = case unzip3 $ map go (bagToList nbs) of + (counters,ids,nablas) -> + case sortOn Down counters of + [] -> (Nothing, MkNablas nbs) + (max_counter:_) -> + let go_zip i (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + -- The max counter + 1 will be never be an id already in these e-graphs + = MkNabla tyst tmst{ts_facts=EG.newPointerToClassId (max_counter+1) i eg0} + in (Just max_counter, MkNablas $ listToBag $ zipWith go_zip ids nablas) where go (MkNabla tyst tmst at TmSt{ts_facts=eg0}) = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) + (xid, eg1) -> (case EG.unionFind eg0 of EG.RUF _ size# -> I# size#, xid, MkNabla tyst tmst{ts_facts=eg1}) representIds :: [Id] -> Nablas -> ([ClassId], Nablas) -representIds xs = runState (mapM (state . representId) xs) +representIds xs = runState (catMaybes <$> mapM (state . representId) xs) -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit f2cb5d7671f9135340fd2bd782f08614c34bceeb +Subproject commit ff5fa306092c6539866d5ebffde9a3041d83444f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a397ff99c0be4413490954e36fe0d9ee80ebb7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a397ff99c0be4413490954e36fe0d9ee80ebb7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 14:20:56 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 10:20:56 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix condIntCode' Message-ID: <64a6cdc8bb555_1849791ad306c195168@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: d56619dc by Jaro Reinders at 2023-07-06T16:20:48+02:00 Fix condIntCode' - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1863,22 +1863,67 @@ condIntCode cond x y = do platform <- getPlatform condIntCode' :: Platform -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode --- Larger-than-native (64-bit ops on 32-bit platforms) +-- 64-bit integer comparisons on 32-bit +-- See Note [64-bit integer comparisons on 32-bit] condIntCode' platform cond x y | target32Bit platform && isWord64 (cmmExprType platform x) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 x RegCode64 code2 r2hi r2lo <- iselExpr64 y - tmp <- getNewRegNat II32 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r2lo) (OpReg tmp), - CMP II32 (OpReg tmp) (OpReg r1lo), - MOV II32 (OpReg r2hi) (OpReg tmp), - SBB II32 (OpReg r1hi) (OpReg tmp) - ] - return (CondCode False cond code) + -- we mustn't clobber r1/r2 so we use temporaries + tmp1 <- getNewRegNat II32 + tmp2 <- getNewRegNat II32 + + let cmpCode = intComparison cond r1hi r1lo r2hi r2lo tmp1 tmp2 + return $ CondCode False cond (code1 `appOL` code2 `appOL` cmpCode) + + where + intComparison cond r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 = + case cond of + -- Let's hope these don't happen + ALWAYS -> panic "impossible" + NEG -> panic "impossible" + POS -> panic "impossible" + CARRY -> panic "impossible" + OFLO -> panic "impossible" + PARITY -> panic "impossible" + NOTPARITY -> panic "impossible" + -- Special case #1 x == y and x != y + EQQ -> cmpExact + NE -> cmpExact + -- [x >= y] + GE -> cmpG + GEU -> cmpG + -- [x > y] + GTT -> cmpG + GU -> cmpG + -- [x <= y] + LE -> cmpL + LEU -> cmpL + -- [x < y] + LTT -> cmpL + LU -> cmpL + where + cmpExact :: OrdList Instr + cmpExact = + toOL + [ MOV II32 (OpReg r1_hi) (OpReg tmp1) + , MOV II32 (OpReg r1_lo) (OpReg tmp2) + , XOR II32 (OpReg r2_hi) (OpReg tmp1) + , XOR II32 (OpReg r2_lo) (OpReg tmp2) + , OR II32 (OpReg tmp1) (OpReg tmp2) + ] + cmpG = toOL + [ MOV II32 (OpReg r1_hi) (OpReg tmp1) + , CMP II32 (OpReg r2_lo) (OpReg r1_lo) + , SBB II32 (OpReg r2_hi) (OpReg tmp1) + ] + cmpL = toOL + [ MOV II32 (OpReg r2_hi) (OpReg tmp1) + , CMP II32 (OpReg r1_lo) (OpReg r2_lo) + , SBB II32 (OpReg r1_hi) (OpReg tmp1) + ] -- memory vs immediate condIntCode' platform cond (CmmLoad x pk _) (CmmLit lit) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d56619dc72e22f26ea8b78cb75980093c4ba7d26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d56619dc72e22f26ea8b78cb75980093c4ba7d26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 14:52:23 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 06 Jul 2023 10:52:23 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] 20 commits: configure: Rip out Solaris dyld check Message-ID: <64a6d5279e8e2_1849791ad30442011d4@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 9ae4127c by Matthew Pickering at 2023-07-06T14:52:21+00:00 Try deb10 for i386 bindists - - - - - 26 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/520b3a7b6346f1e88592f80609c5e9c75d2178a5...9ae4127c8dd95928b47b1da184377f90dd6175a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/520b3a7b6346f1e88592f80609c5e9c75d2178a5...9ae4127c8dd95928b47b1da184377f90dd6175a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 15:02:48 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 11:02:48 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix condIntCode' again Message-ID: <64a6d79895de2_184979aec2c2053b0@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 37d53159 by Jaro Reinders at 2023-07-06T17:02:41+02:00 Fix condIntCode' again - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1875,8 +1875,8 @@ condIntCode' platform cond x y tmp1 <- getNewRegNat II32 tmp2 <- getNewRegNat II32 - let cmpCode = intComparison cond r1hi r1lo r2hi r2lo tmp1 tmp2 - return $ CondCode False cond (code1 `appOL` code2 `appOL` cmpCode) + let (cond', cmpCode) = intComparison cond r1hi r1lo r2hi r2lo tmp1 tmp2 + return $ CondCode False cond' (code1 `appOL` code2 `appOL` cmpCode) where intComparison cond r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 = @@ -1890,20 +1890,20 @@ condIntCode' platform cond x y PARITY -> panic "impossible" NOTPARITY -> panic "impossible" -- Special case #1 x == y and x != y - EQQ -> cmpExact - NE -> cmpExact + EQQ -> (EQQ, cmpExact) + NE -> (NE, cmpExact) -- [x >= y] - GE -> cmpG - GEU -> cmpG + GE -> (GE, cmpGE) + GEU -> (GEU, cmpGE) -- [x > y] - GTT -> cmpG - GU -> cmpG + GTT -> (LTT, cmpLE) + GU -> (LU, cmpLE) -- [x <= y] - LE -> cmpL - LEU -> cmpL + LE -> (GE, cmpLE) + LEU -> (GEU, cmpLE) -- [x < y] - LTT -> cmpL - LU -> cmpL + LTT -> (LTT, cmpGE) + LU -> (LU, cmpGE) where cmpExact :: OrdList Instr cmpExact = @@ -1914,12 +1914,12 @@ condIntCode' platform cond x y , XOR II32 (OpReg r2_lo) (OpReg tmp2) , OR II32 (OpReg tmp1) (OpReg tmp2) ] - cmpG = toOL + cmpGE = toOL [ MOV II32 (OpReg r1_hi) (OpReg tmp1) , CMP II32 (OpReg r2_lo) (OpReg r1_lo) , SBB II32 (OpReg r2_hi) (OpReg tmp1) ] - cmpL = toOL + cmpLE = toOL [ MOV II32 (OpReg r2_hi) (OpReg tmp1) , CMP II32 (OpReg r1_lo) (OpReg r2_lo) , SBB II32 (OpReg r1_hi) (OpReg tmp1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37d53159387c09fdb413d479ea646dfb85bcf62f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37d53159387c09fdb413d479ea646dfb85bcf62f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 15:50:04 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 06 Jul 2023 11:50:04 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix whitespace and update comment Message-ID: <64a6e2ac1d0ae_1849791ae3b4c217286@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 7a3d5117 by Jaro Reinders at 2023-07-06T17:49:51+02:00 Fix whitespace and update comment - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1881,7 +1881,7 @@ condIntCode' platform cond x y where intComparison cond r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 = case cond of - -- Let's hope these don't happen + -- These don't occur as argument of condIntCode' ALWAYS -> panic "impossible" NEG -> panic "impossible" POS -> panic "impossible" @@ -1919,7 +1919,7 @@ condIntCode' platform cond x y , CMP II32 (OpReg r2_lo) (OpReg r1_lo) , SBB II32 (OpReg r2_hi) (OpReg tmp1) ] - cmpLE = toOL + cmpLE = toOL [ MOV II32 (OpReg r2_hi) (OpReg tmp1) , CMP II32 (OpReg r1_lo) (OpReg r2_lo) , SBB II32 (OpReg r1_hi) (OpReg tmp1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a3d51179e74a2ab4fa107426d4e8b94d8d07f35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a3d51179e74a2ab4fa107426d4e8b94d8d07f35 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 15:56:08 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 06 Jul 2023 11:56:08 -0400 Subject: [Git][ghc/ghc][wip/t23465] 20 commits: configure: Rip out Solaris dyld check Message-ID: <64a6e417f2a36_184979aec90221254@gitlab.mail> Matthew Pickering pushed to branch wip/t23465 at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 0b480eb9 by Matthew Pickering at 2023-07-06T16:55:47+01:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - 23 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3cd31d50889635bed5d482e1c23999f6155fa1b...0b480eb9a3422e8f59ce35458b47d3b5622eabed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3cd31d50889635bed5d482e1c23999f6155fa1b...0b480eb9a3422e8f59ce35458b47d3b5622eabed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 15:58:31 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 06 Jul 2023 11:58:31 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Try making postInlineUnconditionally a bit more aggressive Message-ID: <64a6e4a775092_1849791ad3044221946@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 12266b01 by Simon Peyton Jones at 2023-07-06T16:58:08+01:00 Try making postInlineUnconditionally a bit more aggressive In particular, inline if n_br == 1 - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1544,7 +1544,7 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs -> n_br < 100 -- See Note [Suppress exponential blowup] - && (smallEnoughToInline uf_opts unfolding) -- Small enough to dup + && (smallEnoughToInline uf_opts unfolding || (in_lam == NotInsideLam && n_br == 1)) -- Small enough to dup -- ToDo: consider discount on smallEnoughToInline if int_cxt is true -- -- NB: Do NOT inline arbitrarily big things, even if occ_n_br=1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12266b011a02812d95483429ea02c036b34f7af9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/12266b011a02812d95483429ea02c036b34f7af9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 16:12:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 06 Jul 2023 12:12:37 -0400 Subject: [Git][ghc/ghc][master] Filter out nontrivial substituted expressions in substTickish Message-ID: <64a6e7f5d77f6_1849791ad306c23751e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 20 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - docs/users_guide/debugging.rst - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/ghc-api/target-contents/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/numeric/should_run/all.T - testsuite/tests/primops/should_run/all.T - testsuite/tests/programs/jtod_circint/test.T - testsuite/tests/rts/all.T - testsuite/tests/simplCore/T9646/test.T - + testsuite/tests/simplCore/should_compile/T23272.hs - + testsuite/tests/simplCore/should_compile/T23272.script - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, orElse ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -1436,7 +1436,7 @@ simplTick env tickish expr cont simplTickish env tickish | Breakpoint ext n ids modl <- tickish - = Breakpoint ext n (map (getDoneId . substId env) ids) modl + = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) modl | otherwise = tickish -- Push type application and coercion inside a tick @@ -1447,8 +1447,9 @@ simplTick env tickish expr cont where (inc,outc) = splitCont c splitCont other = (mkBoringStop (contHoleType other), other) - getDoneId (DoneId id) = id - getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst + getDoneId (DoneId id) = Just id + getDoneId (DoneEx (Var id) _) = Just id + getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst getDoneId other = pprPanic "getDoneId" (ppr other) -- Note [case-of-scc-of-case] ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -592,9 +592,9 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids modl) - = Breakpoint ext n (map do_one ids) modl + = Breakpoint ext n (mapMaybe do_one ids) modl where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst substTickish _subst other = other {- Note [Substitute lazily] @@ -649,6 +649,13 @@ Second, we have to ensure that we never try to substitute a literal for an Id in a breakpoint. We ensure this by never storing an Id with an unlifted type in a Breakpoint - see GHC.HsToCore.Ticks.mkTickish. Breakpoints can't handle free variables with unlifted types anyway. + +These measures are only reliable with unoptimized code. +Since we can now enable optimizations for GHCi with + at -fno-unoptimized-core-for-interpreter -O@, nontrivial expressions can be +substituted, e.g. by specializations. +Therefore we resort to discarding free variables from breakpoints when this +situation occurs. -} {- ===================================== docs/users_guide/debugging.rst ===================================== @@ -1203,3 +1203,9 @@ Other This option can be used to override this check, e.g. ``ghci -O2 -fno-unoptimized-core-for-interpreter``. It is not recommended for normal use and can cause a compiler panic. + + Note that this has an effect on the debugger interface: With optimizations + in play, free variables in breakpoints may now be substituted with complex + expressions. + Those cannot be stored in breakpoints, so any free variable that refers to + optimized code will not be inspectable when this flag is enabled. ===================================== libraries/base/tests/IO/all.T ===================================== @@ -96,7 +96,6 @@ test('hGetBuf001', [ when(fast(), skip) , expect_fail_if_windows , js_broken(22374) - , expect_broken_for(23272, ['ghci-opt']) , req_process ], compile_and_run, ['-package unix']) ===================================== libraries/base/tests/all.T ===================================== @@ -49,7 +49,7 @@ test('isValidNatural', normal, compile_and_run, ['']) # need to add -K64m to the compiler opts, so that GHCi gets it too test('ioref001', - [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS'), expect_broken_for(23272, ['ghci-opt'])], + [when(fast(), skip),extra_run_opts('+RTS -K64m -RTS')], compile_and_run, ['+RTS -K64m -RTS']) @@ -250,7 +250,7 @@ test('T11334a', normal, compile_and_run, ['']) test('T11555', normal, compile_and_run, ['']) test('T12494', normal, compile_and_run, ['']) test('T12852', [when(opsys('mingw32'), skip), js_broken(22374), req_process], compile_and_run, ['']) -test('lazySTexamples', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('lazySTexamples', normal, compile_and_run, ['']) test('T11760', [req_ghc_smp, req_target_smp, only_ways(['threaded1', 'threaded2', 'nonmoving_thr'])], @@ -304,7 +304,7 @@ test('T19719', normal, compile_and_run, ['']) test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring']) test('T22816', normal, compile_and_run, ['']) test('trace', normal, compile_and_run, ['']) -test('listThreads', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('listThreads', normal, compile_and_run, ['']) test('listThreads1', omit_ghci, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -69,7 +69,7 @@ test('cgrun060', test('cgrun061', normal, compile_and_run, ['']) test('cgrun062', normal, compile_and_run, ['']) test('cgrun063', normal, compile_and_run, ['']) -test('cgrun064', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('cgrun064', normal, compile_and_run, ['']) test('cgrun065', normal, compile_and_run, ['']) test('cgrun066', normal, compile_and_run, ['']) test('cgrun067', [extra_files(['Cgrun067A.hs'])], compile_and_run, ['']) @@ -140,9 +140,9 @@ test('CgStaticPointersNoFullLazyness', [when(doing_ghci(), extra_hc_opts('-fobje test('StaticArraySize', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['-O2']) test('StaticByteArraySize', normal, compile_and_run, ['-O2']) -test('CopySmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('CopySmallArray', normal, compile_and_run, ['']) test('SizeOfSmallArray', normal, compile_and_run, ['']) -test('NewSmallArray', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('NewSmallArray', normal, compile_and_run, ['']) test('T9001', normal, compile_and_run, ['']) test('T9013', normal, compile_and_run, ['']) @@ -223,5 +223,5 @@ test('T20640a', normal, compile_and_run, ['']) test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) -test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) +test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) ===================================== testsuite/tests/concurrent/should_run/all.T ===================================== @@ -81,7 +81,7 @@ test('T5611a', fragile(12751), compile_and_run, ['']) test('T5238', normal, compile_and_run, ['']) test('T5866', exit_code(1), compile_and_run, ['']) -test('readMVar1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('readMVar1', normal, compile_and_run, ['']) test('readMVar2', normal, compile_and_run, ['']) test('readMVar3', normal, compile_and_run, ['']) test('tryReadMVar1', normal, compile_and_run, ['']) @@ -149,7 +149,7 @@ test('conc016', [omit_ways(concurrent_ways) # see comment in conc016.hs test('conc017', normal, compile_and_run, ['']) test('conc017a', normal, compile_and_run, ['']) test('conc018', normal, compile_and_run, ['']) -test('conc019', [extra_run_opts('+RTS -K16m -RTS'), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, ['']) +test('conc019', [extra_run_opts('+RTS -K16m -RTS')], compile_and_run, ['']) test('conc020', normal, compile_and_run, ['']) test('conc021', [ omit_ghci, exit_code(1) ===================================== testsuite/tests/ghc-api/target-contents/all.T ===================================== @@ -1,7 +1,6 @@ test('TargetContents', [ extra_run_opts('"' + config.libdir + '"') , js_broken(22362) - , expect_broken_for(23272, ['ghci-opt']) , req_process ] , compile_and_run, ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -277,7 +277,7 @@ test('T13420', normal, ghci_script, ['T13420.script']) test('T13466', normal, ghci_script, ['T13466.script']) test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) -test('T13699', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T13699.script']) +test('T13699', normal, ghci_script, ['T13699.script']) test('T13988', normal, ghci_script, ['T13988.script']) test('T13997', [extra_run_opts('-fobject-code')], ghci_script, ['T13997.script']) test('T13407', normal, ghci_script, ['T13407.script']) @@ -319,7 +319,7 @@ test('T16876', normal, ghci_script, ['T16876.script']) test('T17345', normal, ghci_script, ['T17345.script']) test('T17384', normal, ghci_script, ['T17384.script']) test('T17403', normal, ghci_script, ['T17403.script']) -test('T17431', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T17431.script']) +test('T17431', normal, ghci_script, ['T17431.script']) test('T17500', [extra_run_opts('-ddump-to-file -ddump-bcos')], ghci_script, ['T17500.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -57,7 +57,7 @@ test('T7014', js_skip, makefile_test, []) test('T7233', normal, compile_and_run, ['']) test('NumDecimals', normal, compile_and_run, ['']) -test('T8726', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('T8726', normal, compile_and_run, ['']) test('CarryOverflow', normal, compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -60,7 +60,6 @@ test('UnliftedWeakPtr', normal, compile_and_run, ['']) test('FMA_Primops' , [ when(have_cpu_feature('fma'), extra_hc_opts('-mfma')) , js_skip # JS backend doesn't have an FMA implementation - , expect_broken_for(23272, ['ghci-opt']) ] , compile_and_run, ['']) test('FMA_ConstantFold' ===================================== testsuite/tests/programs/jtod_circint/test.T ===================================== @@ -1,4 +1,4 @@ -test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']), expect_broken_for(23272, ['ghci-opt']), +test('jtod_circint', [extra_files(['Bit.hs', 'LogFun.hs', 'Main.hs', 'Signal.hs']), when(fast(), skip)], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/rts/all.T ===================================== @@ -143,7 +143,6 @@ test('stack003', [ omit_ghci, # parameter 50000 is not passed # Test that +RTS -K0 (e.g. no stack limit) parses correctly test('stack004', [ extra_run_opts('+RTS -K0 -RTS') , js_broken(22374) - , expect_broken_for(23272, ['ghci-opt']) , expect_broken_for(14913, ['ghci']) ], compile_and_run, ['']) @@ -265,7 +264,6 @@ test('T7037', req_c, makefile_test, ['T7037']) test('T7087', exit_code(1), compile_and_run, ['']) test('T7160', [ # finalization order is different in the nonmoving omit_ways(['nonmoving', 'nonmoving_thr', 'nonmoving_thr_ghc', 'nonmoving_thr_sanity']) - , expect_broken_for(23272, ['ghci-opt']) , js_broken(22261) ], compile_and_run, ['']) @@ -285,7 +283,7 @@ test('T7227', [extra_run_opts('+RTS -tT7227.stat --machine-readable -RTS')], test('T7636', [ exit_code(1), extra_run_opts('100000') ], compile_and_run, [''] ) -test('stablename001', [expect_fail_for(['hpc']), expect_broken_for(23272, ['ghci-opt'])], compile_and_run, ['']) +test('stablename001', [expect_fail_for(['hpc'])], compile_and_run, ['']) # hpc should fail this, because it tags every variable occurrence with # a different tick. It's probably a bug if it works, hence expect_fail. ===================================== testsuite/tests/simplCore/T9646/test.T ===================================== @@ -1,4 +1,4 @@ test('T9646', [extra_files(['Main.hs', 'Natural.hs', 'StrictPrim.hs', 'Type.hs']), - when(fast(), skip), expect_broken_for(23272, ['ghci-opt'])], + when(fast(), skip)], multimod_compile_and_run, ['Main -ddump-simpl -ddump-to-file', '']) ===================================== testsuite/tests/simplCore/should_compile/T23272.hs ===================================== @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined ===================================== testsuite/tests/simplCore/should_compile/T23272.script ===================================== @@ -0,0 +1 @@ +:load T23272 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -489,3 +489,4 @@ test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], mul test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], multimod_compile, ['T23491', '-fliberate-case -ddump-liberate-case']) test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) test('T23074', normal, compile, ['-O -ddump-rules']) +test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) ===================================== testsuite/tests/th/all.T ===================================== @@ -327,8 +327,8 @@ test('T10596', normal, compile, ['-v0']) test('T10598_TH', normal, compile, ['-v0 -dsuppress-uniques -ddump-splices']) test('T10620', normal, compile_and_run, ['-v0']) test('T10638', normal, compile_fail, ['-v0']) -test('T10697_decided_1', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-v0']) -test('T10697_decided_2', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-XStrictData -v0']) +test('T10697_decided_1', normal, compile_and_run, ['-v0']) +test('T10697_decided_2', normal, compile_and_run, ['-XStrictData -v0']) test('T10697_decided_3', normal, compile_and_run, ['-XStrictData -funbox-strict-fields -O2 -v0']) test('T10697_source', [], multimod_compile_and_run, ['T10697_source', '-w ' + config.ghc_th_way_flags]) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -693,7 +693,7 @@ test('UnlifNewUnify', normal, compile, ['']) test('UnliftedNewtypesLPFamily', normal, compile, ['']) test('UnliftedNewtypesDifficultUnification', normal, compile, ['']) test('LevPolyResult', normal, compile, ['']) -test('T16832', expect_broken_for(23272, ['ghci-opt']), ghci_script, ['T16832.script']) +test('T16832', normal, ghci_script, ['T16832.script']) test('T15772', normal, compile, ['']) test('T16995', normal, compile, ['']) test('T17007', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -76,10 +76,10 @@ test('IPRun', normal, compile_and_run, ['']) test('IPLocation', normal, compile_and_run, ['']) test('T10845', normal, compile_and_run, ['']) test('T10846', normal, compile_and_run, ['']) -test('T16646', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['']) +test('T16646', normal, compile_and_run, ['']) # Support files for T1735 are in directory T1735_Help/ -test('T1735', expect_broken_for(23272, ['ghci-opt']), multimod_compile_and_run, ['T1735','']) +test('T1735', normal, multimod_compile_and_run, ['T1735','']) # The following two tests no longer compile # See Note [Inferring principal types] in Ghc.Tc.Solver View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6fdcf969db85f3fe64123ba150e9226a0d2995cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6fdcf969db85f3fe64123ba150e9226a0d2995cd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 16:13:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 06 Jul 2023 12:13:32 -0400 Subject: [Git][ghc/ghc][master] 2 commits: JS: testsuite: use req_c predicate instead of js_broken Message-ID: <64a6e82c562da_1849791ad306c24074e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 5 changed files: - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/openFile003.stdout-javascript-unknown-ghcjs - testsuite/tests/ghci/linking/all.T Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -517,7 +517,7 @@ foreign import javascript unsafe "h$base_isatty" c_isatty :: CInt -> IO CInt foreign import javascript interruptible "h$base_lseek" c_lseek :: CInt -> COff -> CInt -> IO COff -foreign import javascript interruptible "h$base_lstat" -- fixme wrong type +foreign import javascript interruptible "h$base_lstat" lstat :: CFilePath -> Ptr CStat -> IO CInt foreign import javascript interruptible "h$base_open" c_open :: CFilePath -> CInt -> CMode -> IO CInt ===================================== libraries/base/jsbits/base.js ===================================== @@ -230,6 +230,40 @@ function h$base_lstat(file, file_off, stat, stat_off, c) { #endif h$unsupported(-1, c); } + +function h$lstat(file, file_off, stat, stat_off) { + TRACE_IO("lstat") +#ifndef GHCJS_BROWSER + if(h$isNode()) { + try { + var fs = h$fs.lstatSync(h$decodeUtf8z(file, file_off)); + h$base_fillStat(fs, stat, stat_off); + return 0; + } catch(e) { + h$setErrno(e); + return -1; + } + } else +#endif + h$unsupported(-1); +} + +function h$rmdir(file, file_off) { + TRACE_IO("rmdir") +#ifndef GHCJS_BROWSER + if(h$isNode()) { + try { + var fs = h$fs.rmdirSync(h$decodeUtf8z(file, file_off)); + return 0; + } catch(e) { + h$setErrno(e); + return -1; + } + } else +#endif + h$unsupported(-1); +} + function h$base_open(file, file_off, how, mode, c) { #ifndef GHCJS_BROWSER if(h$isNode()) { @@ -435,20 +469,26 @@ function h$base_waitpid(pid, stat, stat_off, options, c) { /** @const */ var h$base_o_nonblock = 0x00004; /** @const */ var h$base_o_binary = 0x00000; +function h$base_stat_check_mode(mode,p) { + // inspired by Node's checkModeProperty + var r = (mode & h$fs.constants.S_IFMT) === p; + return r ? 1 : 0; +} + function h$base_c_s_isreg(mode) { - return 1; + return h$base_stat_check_mode(mode,h$fs.constants.S_IFREG); } function h$base_c_s_ischr(mode) { - return 0; + return h$base_stat_check_mode(mode,h$fs.constants.S_IFCHR); } function h$base_c_s_isblk(mode) { - return 0; + return h$base_stat_check_mode(mode,h$fs.constants.S_IFBLK); } function h$base_c_s_isdir(mode) { - return 0; // fixme + return h$base_stat_check_mode(mode,h$fs.constants.S_IFDIR); } function h$base_c_s_isfifo(mode) { - return 0; + return h$base_stat_check_mode(mode,h$fs.constants.S_IFIFO); } function h$base_c_fcntl_read(fd,cmd) { return -1; ===================================== libraries/base/tests/IO/all.T ===================================== @@ -12,8 +12,7 @@ test('hClose001', [], compile_and_run, ['']) test('hClose002', [normalise_win32_io_errors, js_broken(22261)], compile_and_run, ['']) test('hFileSize001', normal, compile_and_run, ['']) test('hFileSize002', - [omit_ghci, # different output - js_broken(22261)], + [omit_ghci], # different output compile_and_run, ['']) test('hFlush001', [], compile_and_run, ['']) @@ -71,12 +70,12 @@ test('misc001', [extra_run_opts('misc001.hs misc001.out')], compile_and_run, test('openFile001', normal, compile_and_run, ['']) test('openFile002', [exit_code(1), normalise_win32_io_errors], compile_and_run, ['']) -test('openFile003', [normalise_win32_io_errors, js_broken(22362)], compile_and_run, ['']) +test('openFile003', normalise_win32_io_errors, compile_and_run, ['']) test('openFile004', [], compile_and_run, ['']) test('openFile005', js_broken(22261), compile_and_run, ['']) test('openFile006', [], compile_and_run, ['']) test('openFile007', js_broken(22261), compile_and_run, ['']) -test('openFile008', [js_broken(22349), cmd_prefix('ulimit -n 1024; ')], compile_and_run, ['']) +test('openFile008', [cmd_prefix('ulimit -n 1024; ')], compile_and_run, ['']) test('openFile009', [when(arch('wasm32'), fragile(23284))], compile_and_run, ['']) test('putStr001', normal, compile_and_run, ['']) ===================================== libraries/base/tests/IO/openFile003.stdout-javascript-unknown-ghcjs ===================================== @@ -0,0 +1,4 @@ +Left openFile003Dir: openFile: inappropriate type (is a directory) +Left openFile003Dir: openFile: inappropriate type (Illegal operation on a directory) +Left openFile003Dir: openFile: inappropriate type (Illegal operation on a directory) +Left openFile003Dir: openFile: inappropriate type (Illegal operation on a directory) ===================================== testsuite/tests/ghci/linking/all.T ===================================== @@ -48,7 +48,7 @@ test('ghcilink006', test('T3333', [unless(doing_ghci, skip), when(unregisterised(), fragile(17018)), - js_broken(22359)], + req_c], makefile_test, ['T3333']) test('T11531', @@ -69,7 +69,7 @@ test('T14708', test('T15729', [extra_files(['T15729.hs', 'T15729.c']), unless(doing_ghci, skip), - js_broken(22359)], + req_c], makefile_test, ['T15729']) test('big-obj', [extra_files(['big-obj-c.c', 'big-obj.hs']), View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fdcf969db85f3fe64123ba150e9226a0d2995cd...74a4dd2ec6e200b11a56b6f82907feb66e94c90b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fdcf969db85f3fe64123ba150e9226a0d2995cd...74a4dd2ec6e200b11a56b6f82907feb66e94c90b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 16:54:51 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 06 Jul 2023 12:54:51 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Just narrow all CmmLit . CmmInt to the expected width Message-ID: <64a6f1dbcd75b_1849791ae3b4c2522ae@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 960d0af5 by Sven Tennie at 2023-07-06T18:52:24+02:00 Just narrow all CmmLit . CmmInt to the expected width There may appear immediates that don't fit the size. Just truncate them with narrowU. Otherwise, some bit operations fail for the highest bit. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -504,42 +504,13 @@ getRegister' config plat expr = CmmLit lit -> case lit of CmmInt 0 w -> pure $ Fixed (intFormat w) zero_reg nilOL - CmmInt i w | isEncodeableInWidth w i -> + CmmInt i w -> -- narrowU is important: Negative immediates may be -- sign-extended on load! let imm = OpImm . ImmInteger $ narrowU w i in pure (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) imm))) - -- i does not fit. Be careful to keep the sign. - CmmInt i w -> - let -- select all but the sign (most significant) bit - mask = allOneMask (maxBitNo - 1) - numBits = i .&. mask - truncatedI = numBits .|. signBit i - imm = OpImm . ImmInteger $ narrowU w truncatedI - in - pure $ - Any - (intFormat w) - ( \dst -> - toOL - [ annExpr - expr - (MOV (OpReg w dst) imm) - ] - ) - where - allOneMask :: Int -> Integer - allOneMask 0 = bit 0 - allOneMask n = bit n .|. allOneMask (n - 1) - - signBit :: Integer -> Integer - signBit i | signum i < 0 = bit maxBitNo - signBit _i = 0 - - maxBitNo = widthInBits w - 1 - -- floatToBytes (fromRational f) CmmFloat 0 w -> do (op, imm_code) <- litToImm' lit View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/960d0af5760fb9e0e244066e4c5ceffc25016117 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/960d0af5760fb9e0e244066e4c5ceffc25016117 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 17:22:42 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 06 Jul 2023 13:22:42 -0400 Subject: [Git][ghc/ghc][wip/T23567] 41 commits: hadrian: Fix dependencies of docs:* rule Message-ID: <64a6f862dd80b_184979aec40254814@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23567 at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 421278c8 by Krzysztof Gogolewski at 2023-07-06T19:21:50+02:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bd54b40fb28d04ec6f82122bc8fb742d20ee7df...421278c808e763227bb3e93c08070b7e0b177b57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bd54b40fb28d04ec6f82122bc8fb742d20ee7df...421278c808e763227bb3e93c08070b7e0b177b57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 18:00:46 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 14:00:46 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Improve a little bit the mixing of Ids and ClassIds Message-ID: <64a7014eb5033_1849791ad306c259033@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: d0917a69 by Rodrigo Mesquita at 2023-07-06T19:00:32+01:00 Improve a little bit the mixing of Ids and ClassIds tWeaks Don't use EG.rebuild as a view pattern Debuggging Touches Fix to representId over multiple (different) nablas Paper over Chagnes2 - - - - - 10 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -7,6 +7,11 @@ module GHC.Core.Equality where +-- ROMES:TODO: +-- I think, for the particular usages of Core e-graphs, we can do much better +-- than this for equality. +-- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) + import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude ===================================== compiler/GHC/HsToCore/Errors/Ppr.hs ===================================== @@ -72,7 +72,8 @@ instance Diagnostic DsMessage where case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas - pp_tys = pprQuotedList $ map idType vars + -- pp_tys = pprQuotedList $ map idType vars + pp_tys = empty in hang (text "Patterns of type" <+> pp_tys <+> text "not matched:") 4 ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -20,6 +20,8 @@ import GHC.Types.Id import GHC.Types.Name (Name) import qualified GHC.LanguageExtensions as LangExt +import Data.Equality.Graph (ClassId) + import GHC.Generics (Generic) newtype MinBound = MinBound Integer @@ -99,7 +101,7 @@ data DsMessage | DsNonExhaustivePatterns !(HsMatchContext GhcRn) !ExhaustivityCheckType !MaxUncoveredPatterns - [Id] + [ClassId] [Nabla] | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -75,6 +75,8 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Coerce +import Data.Equality.Graph (ClassId) + -- -- * Exported entry points to the checker -- @@ -104,9 +106,20 @@ pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do !missing <- getLdiNablas pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) - result <- unCA (checkPatBind pat_bind) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportPatBind ctxt [var] result + result0 <- unCA (checkPatBind pat_bind) missing + tracePm "}: " (ppr (cr_uncov result0)) + -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas + -- DESIGN:TODO: However, if we represent the variables while desugaring, we + -- would no longer need representId to represent VarF in the e-class, and can + -- instead do newEClass. This would further reduce allocations. + -- The reason why we can't do that currently is that on checkPatBind we'll + -- representIds, and when we represent them again in the next line, we want + -- them to match the ones we represented during checkPatBind. If we made + -- empty-eclasses, the representId on the next line wouldn't match the match + -- ids we defined in checkPatBind. + let (varid, cr_uncov') = representId var (cr_uncov result0) + formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -165,18 +178,23 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars empty_case <- noCheckDs $ desugarEmptyCase var - result <- unCA (checkEmptyCase empty_case) missing - tracePm "}: " (ppr (cr_uncov result)) - formatReportWarnings ReportEmptyCase ctxt vars result + result0 <- unCA (checkEmptyCase empty_case) missing + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph + formatReportWarnings ReportEmptyCase ctxt varids result0{cr_uncov=cr_uncov'} return [] Just matches -> do matches <- {-# SCC "desugarMatches" #-} noCheckDs $ desugarMatches vars matches - result <- {-# SCC "checkMatchGroup" #-} + result0 <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing - tracePm "}: " (ppr (cr_uncov result)) - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result - return (NE.toList (ldiMatchGroup (cr_ret result))) + tracePm "}: " (ppr (cr_uncov result0)) + let (varids, cr_uncov') = representIds vars (cr_uncov result0) + -- romes:todo: this seems redundant, hints that the right thing might be + -- for desugar to return already the match variables already "represented" + -- in the e-graph + {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} + return (NE.toList (ldiMatchGroup (cr_ret result0))) {- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -340,7 +358,7 @@ collectInMode ReportEmptyCase = cirbsEmptyCase -- | Given a 'FormatReportWarningsMode', this function will emit warnings -- for a 'CheckResult'. -formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult ann -> DsM () +formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult ann -> DsM () formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do cov_info <- collectInMode report_mode ann dflags <- getDynFlags @@ -348,7 +366,7 @@ formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do -- | Issue all the warnings -- (redundancy, inaccessibility, exhaustiveness, redundant bangs). -reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () +reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult CIRB -> DsM () reportWarnings dflags report_mode (DsMatchContext kind loc) vars CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss , cirb_red = redundant_rhss @@ -387,14 +405,13 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars maxPatterns = maxUncoveredPatterns dflags -getNFirstUncovered :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nablas -> DsM [Nabla] getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - let (vars', nabla') = representIds vars nabla -- they're already there, we're just getting the e-class ids back - front <- generateInhabitingPatterns mode vars' n nabla' + front <- generateInhabitingPatterns mode vars n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -429,9 +446,10 @@ addTyCs origin ev_vars m = do -- to be added for multiple scrutinees rather than just one. addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k -addCoreScrutTmCs (scr:scrs) (x:xs) k = - flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas -> - addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) +addCoreScrutTmCs (scr:scrs) (x0:xs) k = + flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> + let (x, nablas) = representId x0 nablas0 + in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -103,9 +103,10 @@ emptyRedSets :: RedSets emptyRedSets = RedSets mempty mempty mempty checkGrd :: PmGrd -> CheckAction RedSets -checkGrd grd = CA $ \inc -> case grd of +checkGrd grd = CA $ \inc0 -> case grd of -- let x = e: Refine with x ~ e - PmLet x e -> do + PmLet x0 e -> do + let (x, inc) = representId x0 inc0 -- romes: we could potentially do update the trees to use e-class ids here, -- or in pmcMatches matched <- addPhiCtNablas inc (PhiCoreCt x e) @@ -114,7 +115,8 @@ checkGrd grd = CA $ \inc -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ - PmBang x mb_info -> do + PmBang x0 mb_info -> do + let (x, inc) = representId x0 inc0 div <- addPhiCtNablas inc (PhiBotCt x) matched <- addPhiCtNablas inc (PhiNotBotCt x) -- See Note [Dead bang patterns] @@ -133,7 +135,9 @@ checkGrd grd = CA $ \inc -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x con tvs dicts args -> do + PmCon x0 con tvs dicts args0 -> do + let (x, inc1) = representId x0 inc0 + (args, inc) = representIds args0 inc1 !div <- if isPmAltConMatchStrict con then addPhiCtNablas inc (PhiBotCt x) else pure mempty @@ -181,7 +185,8 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPhiCtNablas inc (PhiNotBotCt var) + let (varid, inc') = representId var inc + unc <- addPhiCtNablas inc' (PhiNotBotCt varid) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -327,7 +327,14 @@ desugarEmptyCase var = pure PmEmptyCase { pe_var = var } -- | Desugar the non-empty 'Match'es of a 'MatchGroup'. -- --- Returns a desugared guard tree of guard expressions. +-- TODO: Would this be a good design? +-- Returns a desugared guard tree of guard expressions /and/ an e-graph e-graph +-- per tree branch. +-- +-- These e-graphs have an equivalence class for each match-id in the guard +-- expression, and are required in the subsequent passes of the PMC +-- +-- Furthermore, the match-ids in the PmGrd expressions are e-class ids from said e-graph desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) -> DsM (PmMatchGroup Pre) desugarMatches vars matches = ===================================== compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -12,7 +12,6 @@ import GHC.Prelude import GHC.Data.List.Infinite (Infinite (..)) import qualified GHC.Data.List.Infinite as Inf import GHC.Types.Basic -import GHC.Types.Id import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Builtin.Types @@ -42,7 +41,7 @@ import qualified Data.IntMap as IM -- -- When the set of refutable shapes contains more than 3 elements, the -- additional elements are indicated by "...". -pprUncovered :: Nabla -> [Id] -> SDoc +pprUncovered :: Nabla -> [ClassId] -> SDoc pprUncovered nabla vas | IM.null refuts = fsep vec -- there are no refutations | otherwise = hang (fsep vec) 4 $ @@ -53,10 +52,9 @@ pprUncovered nabla vas -- precedence | [_] <- vas = topPrec | otherwise = appPrec - (vas',nabla') = representIds vas nabla - ppr_action = mapM (pprPmVar init_prec) vas' - (vec, renamings) = runPmPpr nabla' ppr_action - refuts = prettifyRefuts nabla' renamings + ppr_action = mapM (pprPmVar init_prec) vas + (vec, renamings) = runPmPpr nabla ppr_action + refuts = prettifyRefuts nabla renamings -- | Output refutable shapes of a variable in the form of @var is not one of {2, -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -1,7 +1,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RankNTypes, GADTs #-} {- Authors: George Karachalias @@ -105,8 +107,6 @@ import qualified Data.Equality.Graph as EG import Data.Bifunctor (second) import Data.Function ((&)) import qualified Data.IntSet as IS -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) -- -- * Main exports @@ -571,20 +571,20 @@ where you can find the solution in a perhaps more digestible format. data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". - | PhiCoreCt !Id !CoreExpr + | PhiCoreCt !ClassId !CoreExpr -- ^ @PhiCoreCt x e@ encodes "x ~ e", equating @x@ with the 'CoreExpr' @e at . - | PhiConCt !Id !PmAltCon ![TyVar] ![PredType] ![Id] + | PhiConCt !ClassId !PmAltCon ![TyVar] ![PredType] ![ClassId] -- ^ @PhiConCt x K tvs dicts ys@ encodes @K \@tvs dicts ys <- x@, matching @x@ -- against the 'PmAltCon' application @K \@tvs dicts ys@, binding @tvs@, -- @dicts@ and possibly unlifted fields @ys@ in the process. -- See Note [Strict fields and variables of unlifted type]. - | PhiNotConCt !Id !PmAltCon + | PhiNotConCt !ClassId !PmAltCon -- ^ @PhiNotConCt x K@ encodes "x ≁ K", asserting that @x@ can't be headed -- by @K at . - | PhiBotCt !Id + | PhiBotCt !ClassId -- ^ @PhiBotCt x@ encodes "x ~ ⊥", equating @x@ to ⊥. -- by @K at . - | PhiNotBotCt !Id + | PhiNotBotCt !ClassId -- ^ @PhiNotBotCt x y@ encodes "x ≁ ⊥", asserting that @x@ can't be ⊥. instance Outputable PhiCt where @@ -674,31 +674,25 @@ nameTyCt pred_ty = do -- 'addTyCts' before, through 'addPhiCts'. addPhiTmCt :: Nabla -> PhiCt -> MaybeT DsM Nabla addPhiTmCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition -addPhiTmCt nabla (PhiCoreCt x e) = let (xid, nabla') = representId x nabla - in addCoreCt nabla' xid e -addPhiTmCt nabla (PhiConCt x con tvs dicts args) = do +addPhiTmCt nabla (PhiCoreCt x e) = addCoreCt nabla x e +addPhiTmCt nabla0 (PhiConCt x con tvs dicts args) = do -- Case (1) of Note [Strict fields and variables of unlifted type] -- PhiConCt correspond to the higher-level φ constraints from the paper with -- bindings semantics. It disperses into lower-level δ constraints that the -- 'add*Ct' functions correspond to. - nabla1 <- addTyCts nabla (listToBag dicts) - let (xid, nabla2) = representId x nabla1 - let (args_ids, nabla3) = representIds args nabla2 + nabla1 <- addTyCts nabla0 (listToBag dicts) -- romes: here we could have something like (merge (add K arg_ids) x) -- or actually that should be done by addConCt? - nabla4 <- addConCt nabla3 xid con tvs args_ids - foldlM addNotBotCt nabla4 (filterUnliftedFields con (zip args_ids args)) -addPhiTmCt nabla (PhiNotConCt x con) = let (xid, nabla') = representId x nabla - in addNotConCt nabla' xid con -addPhiTmCt nabla (PhiBotCt x) = let (xid, nabla') = representId x nabla - in addBotCt nabla' xid -addPhiTmCt nabla (PhiNotBotCt x) = let (xid, nabla') = representId x nabla - in addNotBotCt nabla' xid - -filterUnliftedFields :: PmAltCon -> [(ClassId,Id)] -> [ClassId] -filterUnliftedFields con args = - [ arg_id | ((arg_id,arg), bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) - , isBanged bang || definitelyUnliftedType (idType arg) ] + nabla2 <- addConCt nabla1 x con tvs args + foldlM addNotBotCt nabla2 (filterUnliftedFields nabla2 con args) +addPhiTmCt nabla (PhiNotConCt x con) = addNotConCt nabla x con +addPhiTmCt nabla (PhiBotCt x) = addBotCt nabla x +addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x + +filterUnliftedFields :: Nabla -> PmAltCon -> [ClassId] -> [ClassId] +filterUnliftedFields nabla con args = + [ arg_id | (arg_id, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || definitelyUnliftedType (eclassType arg_id nabla) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about @@ -845,7 +839,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so case equate env x y of -- Add the constraints we had for x to y - -- See Note [Joining e-classes PMC] todo mention from joinA + -- See Note (TODO) Joining e-classes PMC] todo mention from joinA -- Now, here's a really tricky bit (TODO Write note, is it the one above?) -- Bc the joinA operation is unlawful, and because the makeA operation for -- expressions is also unlawful (sets the type to ()::(), mostly out of @@ -854,7 +848,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- We *also update the type* (WTF1). -- This is because every e-class should always have a match-var first, which will always have a type, and it should appear on "the left" -- We also rebuild here, we did just merge two things. TODO: Where and when exactly should we merge? - (vi_x, EG.rebuild -> env') -> do + (vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -875,7 +869,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) equate :: TmEGraph -> ClassId -> ClassId -> (VarInfo, TmEGraph) equate eg x y = let (_, eg') = EG.merge x y eg - in (eg ^. _class x ._data, eg') + in (eg ^. _class x ._data, EG.rebuild eg') -- Note: lookup in @eg@, not @eg'@, because we want to return x's data before the merge. @@ -900,6 +894,7 @@ addCoreCt nabla x e = do where -- Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. + -- ROMES:TODO: Consider CoreExprF instead of CoreExpr already here? core_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon -- RM: Could this be done better with e-graphs? The whole newtype stuff @@ -924,18 +919,18 @@ addCoreCt nabla x e = do <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args | otherwise - = do - nabla' <- get - if + = equate_with_similar_expr x e + -- nabla' <- get + -- if -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') + -- ROMES:TODO: Can we fix this more easily with e-graphs? + -- x| Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') -- We don't consider DataCons flexible variables - -> modifyT (\nabla -> let (yid, nabla') = representId y nabla - in addVarCt nabla' x yid) - | otherwise + -- -> modifyT (\nabla -> addVarCt nabla' x y) + -- x| otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! - -> equate_with_similar_expr x e + -- -> equate_with_similar_expr x e where expr_ty = exprType e expr_in_scope = mkInScopeSet (exprFreeVars e) @@ -960,10 +955,9 @@ addCoreCt nabla x e = do bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) - xid <- StateT $ \nabla -> pure $ representId x nabla - core_expr xid e - pure xid + x <- StateT $ \nabla -> lift (mkPmMatchId (exprType e) nabla) + core_expr x e + pure x -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -1480,7 +1474,6 @@ instCompleteSet fuel nabla xid cs = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where vi = lookupVarInfo (nabla_tm_st nabla) xid - x = vi_id vi sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1504,8 +1497,8 @@ instCompleteSet fuel nabla xid cs let recur_not_con = do nabla' <- addNotConCt nabla xid (PmAltConLike con) go nabla' cons - (nabla <$ instCon fuel nabla x con) -- return the original nabla, not the - -- refined one! + (nabla <$ instCon fuel nabla xid con) -- return the original nabla, not the + -- refined one! <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. @@ -1566,11 +1559,11 @@ compareConLikeTestability (RealDataCon a) (RealDataCon b) = mconcat -- adding the proper constructor constraint. -- -- See Note [Instantiating a ConLike]. -instCon :: Int -> Nabla -> Id -> ConLike -> MaybeT DsM Nabla -instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do +instCon :: Int -> Nabla -> ClassId -> ConLike -> MaybeT DsM Nabla +instCon fuel nabla0 at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} MaybeT $ do let hdr what = "instCon " ++ show fuel ++ " " ++ what env <- dsGetFamInstEnvs - let match_ty = idType x + let match_ty = eclassType x nabla0 tracePm (hdr "{") $ ppr con <+> text "... <-" <+> ppr x <+> dcolon <+> ppr match_ty norm_match_ty <- normaliseSourceTypeWHNF ty_st match_ty @@ -1588,24 +1581,23 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma let gammas = substTheta sigma_ex (eqSpecPreds eq_spec ++ thetas) -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys - arg_ids <- mapM mkPmId field_tys' - let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids + (arg_ids, nabla1) <- runStateT (mapM (StateT @Nabla . mkPmMatchId) field_tys') nabla0 tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) ] -- (5) Finally add the new constructor constraint runMaybeT $ do -- Case (2) of Note [Strict fields and variables of unlifted type] let alt = PmAltConLike con - let branching_factor = length $ filterUnliftedFields alt (zip arg_class_ids arg_ids) + let branching_factor = length $ filterUnliftedFields nabla1 alt arg_ids let ct = PhiConCt x alt ex_tvs gammas arg_ids - nabla1 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ - addPhiTmCt nabla' ct + nabla2 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ + addPhiTmCt nabla1 ct -- See Note [Fuel for the inhabitation test] let new_fuel | branching_factor <= 1 = fuel @@ -1617,17 +1609,17 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma , ppr con <+> dcolon <+> text "... ->" <+> ppr _con_res_ty , ppr (map (\tv -> ppr tv <+> char '↦' <+> ppr (substTyVar sigma_univ tv)) _univ_tvs) , ppr gammas - , ppr (map (\x -> ppr x <+> dcolon <+> ppr (idType x)) arg_ids) + , ppr (map (\x -> ppr x <+> dcolon <+> ppr (eclassType x nabla1)) arg_ids) , ppr branching_factor , ppr new_fuel ] - nabla2 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla1) $ - inhabitationTest new_fuel (nabla_ty_st nabla') nabla1 - lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla2) - pure nabla2 + nabla3 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla2) $ + inhabitationTest new_fuel (nabla_ty_st nabla1) nabla2 + lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla3) + pure nabla3 Nothing -> do tracePm (hdr "(match_ty not instance of res_ty) }") empty - pure (Just nabla) -- Matching against match_ty failed. Inhabited! + pure (Just nabla0) -- Matching against match_ty failed. Inhabited! -- See Note [Instantiating a ConLike]. -- | @matchConLikeResTy _ _ ty K@ tries to match @ty@ against the result @@ -2036,12 +2028,11 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do - y <- lift $ mkPmId arg_ty - let (yid,nabla') = representId y nabla + (y,nabla') <- lift $ mkPmMatchId arg_ty nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] - instantiate_newtype_chain yid nabla'' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [y] + instantiate_newtype_chain y nabla'' dcs instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] @@ -2052,7 +2043,7 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do = generateInhabitingPatterns mode xs n nabla instantiate_cons x ty xs n nabla (cl:cls) = do -- The following line is where we call out to the inhabitationTest! - mb_nabla <- runMaybeT $ instCon 4 nabla (eclassMatchId x nabla) cl + mb_nabla <- runMaybeT $ instCon 4 nabla x cl tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (eclassType x nabla) , ppr ty , ppr cl @@ -2147,13 +2138,22 @@ the -XEmptyCase case in 'reportWarnings' by looking for 'ReportEmptyCase'. -- | Update the value of the analysis data of some e-class by its id. updateVarInfo :: Functor f => ClassId -> (VarInfo -> f VarInfo) -> Nabla -> f Nabla -- Update the data at class @xid@ using lenses and the monadic action @go@ -updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg +updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } + = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg -eclassMatchId :: HasCallStack => ClassId -> Nabla -> Id +eclassMatchId :: ClassId -> Nabla -> Id eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) eclassType :: ClassId -> Nabla -> Type eclassType cid = idType . eclassMatchId cid - -- ROMES:TODO: When exactly to rebuild? + +-- | Generate a fresh class for matching, returning the class-id as the match-id +mkPmMatchId :: Type -> Nabla -> DsM (ClassId, Nabla) +mkPmMatchId ty (MkNabla tyst ts at TmSt{ts_facts = egr}) = do + x <- mkPmId ty -- romes:Todo: for now, we still use mkPmId to get an Id for emptyVarInfo, but we want to get rid of this too + let (xid, egr') = EG.newEClass (emptyVarInfo x) egr + return (xid, MkNabla tyst ts{ts_facts=egr'}) +{-# NOINLINE mkPmMatchId #-} -- We'll CPR deeply, that should be enough + ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -69,6 +70,7 @@ import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Solver.InertSet (InertSet, emptyInert) import GHC.Tc.Utils.TcType (isStringTy) +import GHC.Types.Var.Env import GHC.Types.CompleteMatch (CompleteMatch(..)) import GHC.Types.SourceText (SourceText(..), mkFractionalLit, FractionalLit , fractionalLitFromRational @@ -79,8 +81,6 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) import Data.Functor.Compose import Data.Equality.Analysis (Analysis(..)) import Data.Equality.Graph (EGraph, ClassId) @@ -88,7 +88,8 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second) +import Data.Bifunctor (second, bimap, first) +import Control.Monad.Trans.State (runState, state) -- import GHC.Driver.Ppr @@ -155,6 +156,8 @@ data TmState = TmSt { ts_facts :: !TmEGraph -- ^ Facts about terms. + , ts_reps :: !(IdEnv ClassId) + -- ^ A mapping from match-id Ids to the class-id representing that match-id -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know -- which nodes to upward merge, perhaps we can get rid of it too. @@ -242,7 +245,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty + ppr (TmSt eg idmp dirty) = text (show eg) $$ ppr idmp $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -263,7 +266,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt EG.emptyEGraph IS.empty +initTmState = TmSt EG.emptyEGraph mempty IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -318,9 +321,8 @@ emptyVarInfo x -- | @lookupVarInfo tms x@ tells what we know about 'x' --- romes:TODO: This will have a different type. I don't know what yet. -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? --- romes:TodO should return VarInfo rather than Maybe VarInfo lookupVarInfo :: TmState -> ClassId -> VarInfo -lookupVarInfo (TmSt eg _) x +lookupVarInfo (TmSt eg _ _) x -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. = eg ^._class x._data @@ -834,14 +836,31 @@ type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) instance Show VarInfo where show = showPprUnsafe . ppr -representId :: Id -> Nabla -> (ClassId, Nabla) --- Will need to justify this well -representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) -representIds :: [Id] -> Nabla -> ([ClassId], Nabla) -representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs +-- I think the right thing to do here is have representId always return a ClassId, or panic +-- and have an additional method which is called by representIds... +representId :: Id -> Nablas -> (ClassId, Nablas) +representId i n = first fromJust $ representId' i n + +-- romes: temporary names... +-- | Represents a match-id in 'Nablas' and returns the match-id in terms of the e-graph +-- +-- It returns Nothing if the Nablas is empty, and hence there's no returned +-- match-id in terms of e-graphs (there are none in which we can represent that Id) +representId' :: Id -> Nablas -> (Maybe ClassId, Nablas) +-- TODO:TOMORROW: pick the highest Id, and use newPointerToClassId on the Nablas on which the represented Id got a lower clsas Id +-- +-- I suppose that if we do it earlier, we can make all the nablas share the exact same match-ids and avoid this complexity. +representId' x (MkNablas nbs) = bimap headMaybe MkNablas $ unzipBag $ mapBag go nbs + where + go (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) + = case lookupVarEnv idmp x of + Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + Just xid -> (xid, MkNabla tyst tmst) + +representIds :: [Id] -> Nablas -> ([ClassId], Nablas) +representIds xs = runState (catMaybes <$> mapM (state . representId') xs) -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 +Subproject commit 014e5c2b7acab76675ba2d2e16dd03a3dd19ee5d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0917a6917582e0ae102bf2235329c97b9c7e6b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0917a6917582e0ae102bf2235329c97b9c7e6b7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 18:28:37 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 14:28:37 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 41 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a707d5c9432_184979aec402596a2@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 8ededa6f by Ben Gamari at 2023-07-06T14:26:16-04:00 Drop circle-ci-job.sh - - - - - 23c326b2 by Ben Gamari at 2023-07-06T14:26:16-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 0f3cf00d by Ben Gamari at 2023-07-06T14:28:27-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0073a6bf19b0f3c947b81adc62c57df1c24a1710...0f3cf00db26ed6c6adf19486ceaa0f47d867a3fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0073a6bf19b0f3c947b81adc62c57df1c24a1710...0f3cf00db26ed6c6adf19486ceaa0f47d867a3fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 18:30:13 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 14:30:13 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 3 commits: Drop circle-ci-job.sh Message-ID: <64a7083542269_1849791ad3044263989@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 5b55b0ad by Ben Gamari at 2023-07-06T14:29:43-04:00 Drop circle-ci-job.sh - - - - - 00f4a13e by Ben Gamari at 2023-07-06T14:29:43-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 13e66fb9 by Ben Gamari at 2023-07-06T14:29:43-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 7 changed files: - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== .gitlab/ci.sh ===================================== @@ -43,12 +43,13 @@ $0 - GHC continuous integration driver Common Modes: - usage Show this usage message. - setup Prepare environment for a build. - configure Run ./configure. - clean Clean the tree - shell Run an interactive shell with a configured build environment. - save_cache Preserve the cabal cache + usage Show this usage message. + setup Prepare environment for a build. + configure Run ./configure. + clean Clean the tree + shell Run an interactive shell with a configured build environment. + save_test_output Generate unexpected-test-output.tar.gz + save_cache Preserve the cabal cache Hadrian build system build_hadrian Build GHC via the Hadrian build system @@ -614,12 +615,16 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --docs=none \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "cross-compiled hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "cross-compiled hadrian main testsuite" elif [[ -n "${CROSS_TARGET:-}" ]] && [[ "${CROSS_TARGET:-}" == *"wasm"* ]]; then run_hadrian \ test \ --summary-junit=./junit.xml \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite targetting $CROSS_TARGET" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite targetting $CROSS_TARGET" elif [ -n "${CROSS_TARGET:-}" ]; then local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -635,7 +640,9 @@ function test_hadrian() { --test-compiler=stage-cabal \ --test-root-dirs=testsuite/tests/perf \ --test-root-dirs=testsuite/tests/typecheck \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian cabal-install test" else local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -673,12 +680,13 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { @@ -770,6 +778,10 @@ function run_abi_test() { check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes" } +function save_test_output() { + tar -czf unexpected-test-output.tar.gz unexpected-test-output +} + function save_cache () { info "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..." rm -Rf "$CABAL_CACHE" @@ -935,6 +947,7 @@ case ${1:-help} in lint_author) shift; lint_author "$@" ;; compare_interfaces_of) shift; compare_interfaces_of "$@" ;; clean) clean ;; + save_test_output) save_test_output ;; save_cache) save_cache ;; shell) shift; shell "$@" ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/circle-ci-job.sh deleted ===================================== @@ -1,110 +0,0 @@ -# Circle CI "backend" for Gitlab CI -# ================================= -# -# Usage example: -# .gitlab/circle-ci-job.sh validate-x86_64-linux -# -# There are two things to configure to get artifacts to be -# uploaded to gitlab properly: -# -# - At https:///admin/application_settings, expand the -# Continuous Integration and Deployment section and set the -# "Maximum artifacts size (MB)" field to something large enough -# to contain the bindists (the test reports are tiny in comparison). -# 500MB seems to work fine, but 200MB might be sufficient. -# -# - If gitlab is exposed behind some form of proxy (e.g nginx), make sure -# the maximum client request body size is large enough to contain all the -# artifacts of a build. For nginx, this would be the following configuration -# option: https://nginx.org/en/docs/http/ngx_http_core_module.html#client_max_body_size -# (which can be set with services.nginx.clientMaxBodySize on nixos). - -#!/usr/bin/env sh - -set -e - -GHCCI_URL="localhost:8888" - -[ $# -gt 0 ] || (echo You need to pass the Circle CI job type as argument to this script; exit 1) -[ ${CI_RUNNER_ID:-} ] || (echo "CI_RUNNER_ID is not set"; exit 1) -[ ${CI_JOB_ID:-} ] || (echo "CI_JOB_ID is not set"; exit 1) -[ ${CI_COMMIT_SHA:-} ] || (echo "CI_COMMIT_SHA is not set"; exit 1) -[ ${CI_REPOSITORY_URL:-} ] || (echo "CI_REPOSITORY_URL is not set"; exit 1) -[ ${CI_PIPELINE_ID:-} ] || (echo "CI_PIPELINE_ID is not set"; exit 1) -# the first argument to this script is the Circle CI job type: -# validate-x86_64-linux, validate-i386-linux, ... -CIRCLE_JOB="circleci-$1" - -gitlab_user=$(echo $CI_REPOSITORY_URL | cut -d/ -f4) -gitlab_repo=$(echo $CI_REPOSITORY_URL | cut -d/ -f5 | cut -d. -f1) - -BODY="{ \"jobType\": \"$CIRCLE_JOB\", \"source\": { \"user\": \"$gitlab_user\", \"project\":\"$gitlab_repo\", \"commit\":\"$CI_COMMIT_SHA\" }, \"pipelineID\": $CI_PIPELINE_ID, \"runnerID\": $CI_RUNNER_ID, \"jobID\": $CI_JOB_ID }" - - -RESP=$(curl -s -XPOST -H "Content-Type: application/json" -d "$BODY" \ - http://${GHCCI_URL}/job) - -if [ $? -eq 0 ]; then - build_num=$(echo $RESP | jq '.build_num') - circle_url=$(echo $RESP | jq '.url') -else - echo "Couldn't submit job" - echo $RESP - exit 1 -fi - -echo Circle CI build number: $build_num -echo Circle CI build page: $circle_url - -outcome="null" -STATUS_URL="http://${GHCCI_URL}/job/${build_num}" -STATUS_RESP="" - -while [ "$outcome" == "null" ]; do - sleep 30s - STATUS_RESP=$(curl -s $STATUS_URL) - if [ $? -eq 0 ]; then - new_outcome=$(echo $STATUS_RESP | jq '.outcome') - jq_exitcode=$? - if [ "$new_outcome" == "null" ] && [ $jq_exitcode -ne 0 ]; then - echo "Couldn't read 'outcome' field in JSON:" - echo $STATUS_RESP - echo "Skipping" - else - outcome="$new_outcome" - fi - else - echo "curl failed:" - echo $STATUS_RESP - echo "Skipping" - fi -done - -if [ "$outcome" == "\"success\"" ]; then - echo The build passed - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - exit 0 -else - echo The build failed - - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - - failing_step=$(echo $STATUS_RESP | jq '.steps | .[] | .actions | .[] | select(.status != "success")') - failing_step_name=$(echo $failing_step | jq '.name' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing step: $failing_step_name" - - failing_cmds=$(echo $failing_step | jq '.bash_command' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing command(s):" - echo $failing_cmds - - log_url=$(echo $failing_step | jq '.output_url' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Log url: $log_url" - - last_log_lines=$(curl -s $log_url | gunzip | jq '.[] | select(.type == "out") | .message' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/' | tail -50) - echo End of the build log: - echo $last_log_lines - - exit 1 -fi ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -680,10 +680,12 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAfterScript | Windows <- opsys = [ "bash .gitlab/ci.sh save_cache" + , "bash .gitlab/ci.sh save_test_output" , "bash .gitlab/ci.sh clean" ] | otherwise = [ ".gitlab/ci.sh save_cache" + , ".gitlab/ci.sh save_test_output" , ".gitlab/ci.sh clean" , "cat ci_timings" ] @@ -706,16 +708,19 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , if validateNonmovingGc buildConfig - then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" - else mempty + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -3,6 +3,7 @@ "aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -11,7 +12,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,12 +61,14 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, "aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -73,7 +77,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,12 +122,14 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, "i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -131,7 +138,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,12 +183,14 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, "nightly-aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -189,7 +199,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +248,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -244,6 +256,7 @@ "nightly-aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -252,7 +265,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +310,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -303,6 +318,7 @@ "nightly-aarch64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -311,7 +327,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +372,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -362,6 +380,7 @@ "nightly-i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -370,7 +389,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +434,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -421,6 +442,7 @@ "nightly-x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -429,7 +451,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +500,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -487,6 +511,7 @@ "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -495,7 +520,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +567,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -548,6 +575,7 @@ "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -556,7 +584,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +632,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -610,6 +640,7 @@ "nightly-x86_64-linux-alpine3_12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -618,7 +649,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +697,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -672,6 +705,7 @@ "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -680,7 +714,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +762,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -734,6 +770,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -742,7 +779,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +826,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -795,6 +834,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -803,7 +843,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +890,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -856,6 +898,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -864,7 +907,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +954,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -917,6 +962,7 @@ "nightly-x86_64-linux-centos7-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -925,7 +971,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1017,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -977,6 +1025,7 @@ "nightly-x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -985,7 +1034,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1079,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1036,6 +1087,7 @@ "nightly-x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1044,7 +1096,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1141,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1095,6 +1149,7 @@ "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1103,7 +1158,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1204,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1155,6 +1212,7 @@ "nightly-x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1163,7 +1221,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1266,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1214,6 +1274,7 @@ "nightly-x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1222,7 +1283,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1328,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1273,6 +1336,7 @@ "nightly-x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1281,7 +1345,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1390,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1332,6 +1398,7 @@ "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1340,7 +1407,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1391,6 +1460,7 @@ "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1399,7 +1469,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1515,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1452,6 +1524,7 @@ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1460,7 +1533,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1580,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1575,6 +1650,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1583,7 +1659,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1630,6 +1707,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1637,6 +1715,7 @@ "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1645,7 +1724,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1689,6 +1769,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1696,6 +1777,7 @@ "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1704,7 +1786,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1756,6 +1839,7 @@ "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1764,7 +1848,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1808,6 +1893,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1815,6 +1901,7 @@ "nightly-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1823,7 +1910,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1957,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1876,6 +1965,7 @@ "nightly-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1884,7 +1974,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1931,6 +2022,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1938,6 +2030,7 @@ "nightly-x86_64-linux-fedora33-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1946,7 +2039,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1992,6 +2086,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1999,6 +2094,7 @@ "nightly-x86_64-linux-rocky8-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2007,7 +2103,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2052,6 +2149,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2059,6 +2157,7 @@ "nightly-x86_64-linux-ubuntu18_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2067,7 +2166,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2111,6 +2211,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2118,6 +2219,7 @@ "nightly-x86_64-linux-ubuntu20_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2126,7 +2228,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2170,6 +2273,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2177,6 +2281,7 @@ "nightly-x86_64-windows-int_native-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2184,7 +2289,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2229,6 +2335,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2236,6 +2343,7 @@ "nightly-x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2243,7 +2351,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2288,6 +2397,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2295,6 +2405,7 @@ "release-aarch64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2303,7 +2414,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2352,6 +2464,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2359,6 +2472,7 @@ "release-aarch64-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2367,7 +2481,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2413,6 +2528,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2420,6 +2536,7 @@ "release-i386-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2428,7 +2545,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2474,6 +2592,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2481,6 +2600,7 @@ "release-x86_64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2489,7 +2609,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2538,6 +2659,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2548,6 +2670,7 @@ "release-x86_64-linux-alpine3_12-int_native-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2556,7 +2679,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2604,6 +2728,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2611,6 +2736,7 @@ "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2619,7 +2745,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2667,6 +2794,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2674,6 +2802,7 @@ "release-x86_64-linux-alpine3_12-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2682,7 +2811,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2730,6 +2860,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2737,6 +2868,7 @@ "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2745,7 +2877,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2791,6 +2924,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2798,6 +2932,7 @@ "release-x86_64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2806,7 +2941,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2852,6 +2988,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2859,6 +2996,7 @@ "release-x86_64-linux-deb10-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2867,7 +3005,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2913,6 +3052,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2984,6 +3124,7 @@ "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2992,7 +3133,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3038,6 +3180,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -3045,6 +3188,7 @@ "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3053,7 +3197,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3107,6 +3252,7 @@ "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3115,7 +3261,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3308,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3168,6 +3316,7 @@ "release-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3176,7 +3325,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3374,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3231,6 +3382,7 @@ "release-x86_64-linux-fedora33-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3239,7 +3391,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3287,6 +3440,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3294,6 +3448,7 @@ "release-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3302,7 +3457,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3350,6 +3506,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3357,6 +3514,7 @@ "release-x86_64-linux-rocky8-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3365,7 +3523,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3411,6 +3570,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3418,6 +3578,7 @@ "release-x86_64-linux-ubuntu18_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3426,7 +3587,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3472,6 +3634,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3479,6 +3642,7 @@ "release-x86_64-linux-ubuntu20_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3487,7 +3651,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3533,6 +3698,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3540,6 +3706,7 @@ "release-x86_64-windows-int_native-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3547,7 +3714,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3593,6 +3761,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3600,6 +3769,7 @@ "release-x86_64-windows-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3607,7 +3777,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3824,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3660,6 +3832,7 @@ "x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3668,7 +3841,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3716,6 +3890,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3725,6 +3900,7 @@ "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3733,7 +3909,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3779,12 +3956,14 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3793,7 +3972,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3840,12 +4020,14 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3854,7 +4036,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3900,12 +4083,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3914,7 +4099,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3961,12 +4147,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3975,7 +4163,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4022,12 +4211,14 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4036,7 +4227,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4080,12 +4272,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, "x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4094,7 +4288,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4139,12 +4334,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4153,7 +4350,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4198,12 +4396,14 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4212,7 +4412,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4256,12 +4457,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4270,7 +4473,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4314,12 +4518,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4328,7 +4534,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4372,12 +4579,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4386,7 +4595,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4430,12 +4640,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4444,7 +4656,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4490,6 +4703,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4497,6 +4711,7 @@ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4505,7 +4720,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4551,6 +4767,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, @@ -4618,6 +4835,7 @@ "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4626,7 +4844,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4673,12 +4892,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, "x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4687,7 +4908,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4738,6 +4960,7 @@ "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4746,7 +4969,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4792,12 +5016,14 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, "x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -4805,7 +5031,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4850,6 +5077,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--unexpected-output-dir", help="directory in which to place unexpected output") parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") @@ -128,6 +129,9 @@ if args.top: if args.test_package_db: config.test_package_db = args.test_package_db +if args.unexpected_output_dir: + config.unexpected_output_dir = Path(args.unexpected_output_dir) + if args.only: config.only = args.only config.run_only_some_tests = True ===================================== testsuite/driver/testglobals.py ===================================== @@ -203,7 +203,7 @@ class TestConfig: self.baseline_commit = None # type: Optional[GitRef] # Additional package dbs to inspect for test dependencies. - self.test_package_db = [] # type: [PathToPackageDb] + self.test_package_db = [] # type: List[PathToPackageDb] # Should we skip performance tests self.skip_perf_tests = False @@ -225,6 +225,10 @@ class TestConfig: # See Note [Haddock runtime stats files] at the bottom of this file. self.stats_files_dir = Path('/please_set_stats_files_dir') + # Where to place observed output files on when unexpected output + # is observed. + self.unexpected_output_dir = None # type: Optional[Path] + # Should we cleanup after test runs? self.cleanup = True ===================================== testsuite/driver/testlib.py ===================================== @@ -2262,11 +2262,15 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool: # new output. Returns true if output matched or was accepted, false # otherwise. See Note [Output comparison] for the meaning of the # normaliser and whitespace_normaliser parameters. -async def compare_outputs(way: WayName, - kind: str, - normaliser: OutputNormalizer, - expected_file, actual_file, diff_file=None, - whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: +async def compare_outputs( + way: WayName, + kind: str, + normaliser: OutputNormalizer, + expected_file: Path, + actual_file: Path, + diff_file: Optional[Path]=None, + whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options if kind == 'stderr' and getTestOpts().ignore_stderr: return True @@ -2343,6 +2347,12 @@ async def compare_outputs(way: WayName, expected_path.unlink() return True else: + if config.unexpected_output_dir is not None: + ghc_root = expected_path.relative_to(config.top.parent) + out = config.unexpected_output_dir / ghc_root + out.parent.mkdir(exist_ok=True, parents=True) + write_file(out, actual_raw) + return False # Checks that each line from pattern_file is present in actual_file as @@ -2397,6 +2407,15 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs # squash all whitespace, making the diff unreadable. Instead we rely # on the `diff` program to ignore whitespace changes as much as # possible (#10152). +# +# In addition, to aid CI users we will optionally collect all +# of the unexpected output that we encountered in the +# directory at config.unexpected_output_dir. The intent here is for this +# directory to be preserved as a CI artifact which can then +# be downloaded by the user and committed to their branch +# to address CI failures on platforms which they cannot +# test locally. + # Note [Null device handling] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f3cf00db26ed6c6adf19486ceaa0f47d867a3fa...13e66fb97e83d2cb7072190666a8d36d23f4481c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f3cf00db26ed6c6adf19486ceaa0f47d867a3fa...13e66fb97e83d2cb7072190666a8d36d23f4481c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 18:33:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 14:33:34 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 44 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a708fe29b71_184979aec682646e7@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 5b55b0ad by Ben Gamari at 2023-07-06T14:29:43-04:00 Drop circle-ci-job.sh - - - - - 00f4a13e by Ben Gamari at 2023-07-06T14:29:43-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 13e66fb9 by Ben Gamari at 2023-07-06T14:29:43-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 21247f26 by Ben Gamari at 2023-07-06T14:30:45-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 7254ff75 by Ben Gamari at 2023-07-06T14:30:45-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 498fdbf8 by Ben Gamari at 2023-07-06T14:33:19-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d829fcba4a6ca5d686e86bffcddadb4aba22c94...498fdbf8049d1b003fb108d0cbe6eab8799458a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d829fcba4a6ca5d686e86bffcddadb4aba22c94...498fdbf8049d1b003fb108d0cbe6eab8799458a4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:04:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 15:04:09 -0400 Subject: [Git][ghc/ghc][wip/T22011] rts: Add generator for RtsSymbols from libgcc Message-ID: <64a710298dde3_2c735eafdc0994d@gitlab.mail> Ben Gamari pushed to branch wip/T22011 at Glasgow Haskell Compiler / GHC Commits: 7c0486d9 by Ben Gamari at 2023-07-06T15:04:00-04:00 rts: Add generator for RtsSymbols from libgcc - - - - - 4 changed files: - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - rts/RtsSymbols.c - + rts/gen_libgcc_symbols.py Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -59,21 +59,26 @@ rtsDependencies = do jsTarget <- expr isJsTarget useSystemFfi <- expr (flag UseSystemFfi) - let -- headers common to native and JS RTS + let in_include file = rtsPath -/- "include" -/- file + + -- headers common to native and JS RTS common_headers = + map in_include [ "ghcautoconf.h", "ghcplatform.h" , "DerivedConstants.h" ] -- headers specific to the native RTS native_headers = + map in_include [ "rts" -/- "EventTypes.h" , "rts" -/- "EventLogConstants.h" ] - ++ (if useSystemFfi then [] else libffiHeaderFiles) + ++ (if useSystemFfi then [] else map in_include libffiHeaderFiles) + ++ [ in_include $ rtsPath -/- "LibgccSymbols.h" ] headers | jsTarget = common_headers | otherwise = common_headers ++ native_headers - pure $ ((rtsPath -/- "include") -/-) <$> headers + pure headers genapplyDependencies :: Expr [FilePath] genapplyDependencies = do @@ -166,7 +171,7 @@ generatePackageCode context@(Context stage pkg _ _) = do [accessOpsSource, "addr-access-ops", file] [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] + need [primopsSource, ba_ops_txt, addr_ops_txt] -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] @@ -180,13 +185,29 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "include/DerivedConstants.h" %> genPlatformConstantsHeader context root -/- "**" -/- dir -/- "include/rts/EventLogConstants.h" %> genEventTypes "--event-types-defines" root -/- "**" -/- dir -/- "include/rts/EventTypes.h" %> genEventTypes "--event-types-array" + root -/- "**" -/- dir -/- "LibgccSymbols.h" %> genLibgccSymbols context + +genLibgccSymbols :: Context -> FilePath -> Action () +genLibgccSymbols (Context stage _ _ _) outFile = do + libgcc <- getLibgccPath + need [script] + runBuilder Python [script, libgcc, "-o", outFile] [] [] + where + script = "rts" -/- "gen_libgcc_symbols.py" + getLibgccPath :: Action FilePath + getLibgccPath = do + let builder = Cc CompileC stage + needBuilders [builder] + path <- builderPath builder + StdoutTrim libgcc <- quietly $ cmd [path] ["-print-libgcc-file-name"] + return libgcc genEventTypes :: String -> FilePath -> Action () genEventTypes flag file = do - need ["rts" -/- "gen_event_types.py"] - runBuilder Python - ["rts" -/- "gen_event_types.py", flag, file] - [] [] + need [script] + runBuilder Python [script, flag, file] [] [] + where + script = "rts" -/- "gen_event_types.py" genPrimopCode :: Context -> FilePath -> Action () genPrimopCode context@(Context stage _pkg _ _) file = do ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -212,6 +212,7 @@ buildConfInplace rs context at Context {..} _conf = do , path -/- "include/ghcplatform.h" , path -/- "include/rts/EventLogConstants.h" , path -/- "include/rts/EventTypes.h" + , path -/- "LibgccSymbols.h" ] -- we need to generate this file for GMP ===================================== rts/RtsSymbols.c ===================================== @@ -983,6 +983,10 @@ extern char **environ; #define RTS_FINI_ARRAY_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt. This file is generated by +// gen_libgcc_symbols.py. +#include "LibgccSymbols.h" + /* entirely bogus claims about types of these symbols */ #define SymI_NeedsProto(vvv) extern void vvv(void); #define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; @@ -1014,6 +1018,7 @@ RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +RTS_LIBGCC_SYMBOLS #undef SymI_NeedsProto #undef SymI_NeedsDataProto @@ -1055,9 +1060,7 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS -#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) -#include "AArch64Symbols.h" -#endif + RTS_LIBGCC_SYMBOLS SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, ===================================== rts/gen_libgcc_symbols.py ===================================== @@ -0,0 +1,33 @@ +#!/usr/bin/env python3 + +import sys +import subprocess +import argparse +from typing import Set +from pathlib import Path + +def list_symbols(lib: Path) -> Set[str]: + out = subprocess.check_output([ + 'nm', '--format=posix', '--extern-only', '--defined-only', lib + ], encoding='ASCII') + syms = set() + for l in out.split('\n'): + parts = l.split(' ') + if len(parts) == 4: + syms.add(parts[0]) + + return syms + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('libgcc', type=Path, help='path to libgcc') + parser.add_argument('-o', '--output', default=sys.stdout, type=argparse.FileType('w'), help='output file name') + args = parser.parse_args() + + syms = list_symbols(args.libgcc) + print('#define RTS_LIBGCC_SYMBOLS \\', file=args.output) + print('\n'.join(f' SymE_NeedsProto({sym}) \\' for sym in sorted(syms)), + file=args.output) + +if __name__ == '__main__': + main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c0486d9a996bd56287d0f51c4a918e43fda2c0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c0486d9a996bd56287d0f51c4a918e43fda2c0a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:23:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 15:23:35 -0400 Subject: [Git][ghc/ghc][wip/T22011] rts: Add generator for RtsSymbols from libgcc Message-ID: <64a714b7cbe40_2c735eafc9410200@gitlab.mail> Ben Gamari pushed to branch wip/T22011 at Glasgow Haskell Compiler / GHC Commits: 22d01b1b by Ben Gamari at 2023-07-06T15:23:28-04:00 rts: Add generator for RtsSymbols from libgcc - - - - - 4 changed files: - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - rts/RtsSymbols.c - + rts/gen_libgcc_symbols.py Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -59,21 +59,26 @@ rtsDependencies = do jsTarget <- expr isJsTarget useSystemFfi <- expr (flag UseSystemFfi) - let -- headers common to native and JS RTS + let in_include file = rtsPath -/- "include" -/- file + + -- headers common to native and JS RTS common_headers = + map in_include [ "ghcautoconf.h", "ghcplatform.h" , "DerivedConstants.h" ] -- headers specific to the native RTS native_headers = + map in_include [ "rts" -/- "EventTypes.h" , "rts" -/- "EventLogConstants.h" ] - ++ (if useSystemFfi then [] else libffiHeaderFiles) + ++ (if useSystemFfi then [] else map in_include libffiHeaderFiles) + ++ [ in_include $ rtsPath -/- "LibgccSymbols.h" ] headers | jsTarget = common_headers | otherwise = common_headers ++ native_headers - pure $ ((rtsPath -/- "include") -/-) <$> headers + pure headers genapplyDependencies :: Expr [FilePath] genapplyDependencies = do @@ -166,7 +171,7 @@ generatePackageCode context@(Context stage pkg _ _) = do [accessOpsSource, "addr-access-ops", file] [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] + need [primopsSource, ba_ops_txt, addr_ops_txt] -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] @@ -180,13 +185,29 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "include/DerivedConstants.h" %> genPlatformConstantsHeader context root -/- "**" -/- dir -/- "include/rts/EventLogConstants.h" %> genEventTypes "--event-types-defines" root -/- "**" -/- dir -/- "include/rts/EventTypes.h" %> genEventTypes "--event-types-array" + root -/- "**" -/- dir -/- "LibgccSymbols.h" %> genLibgccSymbols context + +genLibgccSymbols :: Context -> FilePath -> Action () +genLibgccSymbols (Context stage _ _ _) outFile = do + libgcc <- getLibgccPath + need [script] + runBuilder Python [script, libgcc, "-o", outFile] [] [] + where + script = "rts" -/- "gen_libgcc_symbols.py" + getLibgccPath :: Action FilePath + getLibgccPath = do + let builder = Cc CompileC stage + needBuilders [builder] + path <- builderPath builder + StdoutTrim libgcc <- quietly $ cmd [path] ["-print-libgcc-file-name"] + return libgcc genEventTypes :: String -> FilePath -> Action () genEventTypes flag file = do - need ["rts" -/- "gen_event_types.py"] - runBuilder Python - ["rts" -/- "gen_event_types.py", flag, file] - [] [] + need [script] + runBuilder Python [script, flag, file] [] [] + where + script = "rts" -/- "gen_event_types.py" genPrimopCode :: Context -> FilePath -> Action () genPrimopCode context@(Context stage _pkg _ _) file = do ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -212,6 +212,7 @@ buildConfInplace rs context at Context {..} _conf = do , path -/- "include/ghcplatform.h" , path -/- "include/rts/EventLogConstants.h" , path -/- "include/rts/EventTypes.h" + , path -/- "LibgccSymbols.h" ] -- we need to generate this file for GMP ===================================== rts/RtsSymbols.c ===================================== @@ -947,26 +947,6 @@ extern char **environ; RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS -// 64-bit support functions in libgcc.a -#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32) -#define RTS_LIBGCC_SYMBOLS \ - SymI_NeedsProto(__divdi3) \ - SymI_NeedsProto(__udivdi3) \ - SymI_NeedsProto(__moddi3) \ - SymI_NeedsProto(__umoddi3) \ - SymI_NeedsProto(__muldi3) \ - SymI_NeedsProto(__ashldi3) \ - SymI_NeedsProto(__ashrdi3) \ - SymI_NeedsProto(__lshrdi3) \ - SymI_NeedsProto(__fixunsdfdi) -#elif defined(__GNUC__) && SIZEOF_VOID_P == 8 -#define RTS_LIBGCC_SYMBOLS \ - SymI_NeedsProto(__udivti3) \ - SymI_NeedsProto(__umodti3) -#else -#define RTS_LIBGCC_SYMBOLS -#endif - // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -983,6 +963,10 @@ extern char **environ; #define RTS_FINI_ARRAY_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt. This file is generated by +// gen_libgcc_symbols.py. +#include "LibgccSymbols.h" + /* entirely bogus claims about types of these symbols */ #define SymI_NeedsProto(vvv) extern void vvv(void); #define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; @@ -1055,9 +1039,6 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS -#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) -#include "AArch64Symbols.h" -#endif SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, ===================================== rts/gen_libgcc_symbols.py ===================================== @@ -0,0 +1,33 @@ +#!/usr/bin/env python3 + +import sys +import subprocess +import argparse +from typing import Set +from pathlib import Path + +def list_symbols(lib: Path) -> Set[str]: + out = subprocess.check_output([ + 'nm', '--format=posix', '--extern-only', '--defined-only', lib + ], encoding='ASCII') + syms = set() + for l in out.split('\n'): + parts = l.split(' ') + if len(parts) == 4: + syms.add(parts[0]) + + return syms + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('libgcc', type=Path, help='path to libgcc') + parser.add_argument('-o', '--output', default=sys.stdout, type=argparse.FileType('w'), help='output file name') + args = parser.parse_args() + + syms = list_symbols(args.libgcc) + lines = [ '#define RTS_LIBGCC_SYMBOLS' ] + lines += [ f' SymE_NeedsProto({sym})' for sym in sorted(syms) ] + print(' \\\n'.join(lines), file=args.output) + +if __name__ == '__main__': + main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22d01b1be6bfe86fd36f3f59bba4f5d0426b9cc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22d01b1be6bfe86fd36f3f59bba4f5d0426b9cc7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:26:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 15:26:14 -0400 Subject: [Git][ghc/ghc][wip/T22012] rts/RtsSymbols: Add AArch64 outline atomic operations Message-ID: <64a715567bde4_2c735eafde8102493@gitlab.mail> Ben Gamari pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: 9d471794 by Ben Gamari at 2023-07-06T15:26:05-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python ops = [] ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.append(f'__aarch64_{op}{n}_{order}') for m in [1,2,4,8,16]: ops.append(f'__aarch64_cas{n}_{order}') print('\n'.join(f' SymE_NeedsProto({op}),' for op in sorted(ops))) ``` - - - - - 2 changed files: - + rts/AArch64Symbols.h - rts/RtsSymbols.c Changes: ===================================== rts/AArch64Symbols.h ===================================== @@ -0,0 +1,101 @@ +#define RTS_AARCH64_SYMBOLS \ + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_acq_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_rel), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_cas8_relax), + SymE_NeedsProto(__aarch64_ldadd1_acq), + SymE_NeedsProto(__aarch64_ldadd1_acq_rel), + SymE_NeedsProto(__aarch64_ldadd1_rel), + SymE_NeedsProto(__aarch64_ldadd1_relax), + SymE_NeedsProto(__aarch64_ldadd2_acq), + SymE_NeedsProto(__aarch64_ldadd2_acq_rel), + SymE_NeedsProto(__aarch64_ldadd2_rel), + SymE_NeedsProto(__aarch64_ldadd2_relax), + SymE_NeedsProto(__aarch64_ldadd4_acq), + SymE_NeedsProto(__aarch64_ldadd4_acq_rel), + SymE_NeedsProto(__aarch64_ldadd4_rel), + SymE_NeedsProto(__aarch64_ldadd4_relax), + SymE_NeedsProto(__aarch64_ldadd8_acq), + SymE_NeedsProto(__aarch64_ldadd8_acq_rel), + SymE_NeedsProto(__aarch64_ldadd8_rel), + SymE_NeedsProto(__aarch64_ldadd8_relax), + SymE_NeedsProto(__aarch64_ldclr1_acq), + SymE_NeedsProto(__aarch64_ldclr1_acq_rel), + SymE_NeedsProto(__aarch64_ldclr1_rel), + SymE_NeedsProto(__aarch64_ldclr1_relax), + SymE_NeedsProto(__aarch64_ldclr2_acq), + SymE_NeedsProto(__aarch64_ldclr2_acq_rel), + SymE_NeedsProto(__aarch64_ldclr2_rel), + SymE_NeedsProto(__aarch64_ldclr2_relax), + SymE_NeedsProto(__aarch64_ldclr4_acq), + SymE_NeedsProto(__aarch64_ldclr4_acq_rel), + SymE_NeedsProto(__aarch64_ldclr4_rel), + SymE_NeedsProto(__aarch64_ldclr4_relax), + SymE_NeedsProto(__aarch64_ldclr8_acq), + SymE_NeedsProto(__aarch64_ldclr8_acq_rel), + SymE_NeedsProto(__aarch64_ldclr8_rel), + SymE_NeedsProto(__aarch64_ldclr8_relax), + SymE_NeedsProto(__aarch64_ldeor1_acq), + SymE_NeedsProto(__aarch64_ldeor1_acq_rel), + SymE_NeedsProto(__aarch64_ldeor1_rel), + SymE_NeedsProto(__aarch64_ldeor1_relax), + SymE_NeedsProto(__aarch64_ldeor2_acq), + SymE_NeedsProto(__aarch64_ldeor2_acq_rel), + SymE_NeedsProto(__aarch64_ldeor2_rel), + SymE_NeedsProto(__aarch64_ldeor2_relax), + SymE_NeedsProto(__aarch64_ldeor4_acq), + SymE_NeedsProto(__aarch64_ldeor4_acq_rel), + SymE_NeedsProto(__aarch64_ldeor4_rel), + SymE_NeedsProto(__aarch64_ldeor4_relax), + SymE_NeedsProto(__aarch64_ldeor8_acq), + SymE_NeedsProto(__aarch64_ldeor8_acq_rel), + SymE_NeedsProto(__aarch64_ldeor8_rel), + SymE_NeedsProto(__aarch64_ldeor8_relax), + SymE_NeedsProto(__aarch64_ldset1_acq), + SymE_NeedsProto(__aarch64_ldset1_acq_rel), + SymE_NeedsProto(__aarch64_ldset1_rel), + SymE_NeedsProto(__aarch64_ldset1_relax), + SymE_NeedsProto(__aarch64_ldset2_acq), + SymE_NeedsProto(__aarch64_ldset2_acq_rel), + SymE_NeedsProto(__aarch64_ldset2_rel), + SymE_NeedsProto(__aarch64_ldset2_relax), + SymE_NeedsProto(__aarch64_ldset4_acq), + SymE_NeedsProto(__aarch64_ldset4_acq_rel), + SymE_NeedsProto(__aarch64_ldset4_rel), + SymE_NeedsProto(__aarch64_ldset4_relax), + SymE_NeedsProto(__aarch64_ldset8_acq), + SymE_NeedsProto(__aarch64_ldset8_acq_rel), + SymE_NeedsProto(__aarch64_ldset8_rel), + SymE_NeedsProto(__aarch64_ldset8_relax), + SymE_NeedsProto(__aarch64_swp1_acq), + SymE_NeedsProto(__aarch64_swp1_acq_rel), + SymE_NeedsProto(__aarch64_swp1_rel), + SymE_NeedsProto(__aarch64_swp1_relax), + SymE_NeedsProto(__aarch64_swp2_acq), + SymE_NeedsProto(__aarch64_swp2_acq_rel), + SymE_NeedsProto(__aarch64_swp2_rel), + SymE_NeedsProto(__aarch64_swp2_relax), + SymE_NeedsProto(__aarch64_swp4_acq), + SymE_NeedsProto(__aarch64_swp4_acq_rel), + SymE_NeedsProto(__aarch64_swp4_rel), + SymE_NeedsProto(__aarch64_swp4_relax), + SymE_NeedsProto(__aarch64_swp8_acq), + SymE_NeedsProto(__aarch64_swp8_acq_rel), + SymE_NeedsProto(__aarch64_swp8_rel), + SymE_NeedsProto(__aarch64_swp8_relax), ===================================== rts/RtsSymbols.c ===================================== @@ -967,6 +967,13 @@ extern char **environ; #define RTS_LIBGCC_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt for AArch64's outline atomics. +#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) +#include "AArch64Symbols.h" +#else +#define RTS_AARCH64_SYMBOLS +#endif + // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -1014,6 +1021,7 @@ RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +RTS_AARCH64_SYMBOLS #undef SymI_NeedsProto #undef SymI_NeedsDataProto @@ -1055,6 +1063,7 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS + RTS_AARCH64_SYMBOLS SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d4717944ad5650db136037cadf91bbe2640dd2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d4717944ad5650db136037cadf91bbe2640dd2b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:33:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 15:33:02 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] gitlab-ci: Preserve unexpected output Message-ID: <64a716eece1f6_2c735eaed80102937@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: b47106bf by Ben Gamari at 2023-07-06T15:32:27-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -43,12 +43,13 @@ $0 - GHC continuous integration driver Common Modes: - usage Show this usage message. - setup Prepare environment for a build. - configure Run ./configure. - clean Clean the tree - shell Run an interactive shell with a configured build environment. - save_cache Preserve the cabal cache + usage Show this usage message. + setup Prepare environment for a build. + configure Run ./configure. + clean Clean the tree + shell Run an interactive shell with a configured build environment. + save_test_output Generate unexpected-test-output.tar.gz + save_cache Preserve the cabal cache Hadrian build system build_hadrian Build GHC via the Hadrian build system @@ -614,12 +615,16 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --docs=none \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "cross-compiled hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "cross-compiled hadrian main testsuite" elif [[ -n "${CROSS_TARGET:-}" ]] && [[ "${CROSS_TARGET:-}" == *"wasm"* ]]; then run_hadrian \ test \ --summary-junit=./junit.xml \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite targetting $CROSS_TARGET" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite targetting $CROSS_TARGET" elif [ -n "${CROSS_TARGET:-}" ]; then local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -635,7 +640,9 @@ function test_hadrian() { --test-compiler=stage-cabal \ --test-root-dirs=testsuite/tests/perf \ --test-root-dirs=testsuite/tests/typecheck \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian cabal-install test" else local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -673,12 +680,13 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { @@ -770,6 +778,10 @@ function run_abi_test() { check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes" } +function save_test_output() { + tar -czf unexpected-test-output.tar.gz unexpected-test-output +} + function save_cache () { info "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..." rm -Rf "$CABAL_CACHE" @@ -935,6 +947,7 @@ case ${1:-help} in lint_author) shift; lint_author "$@" ;; compare_interfaces_of) shift; compare_interfaces_of "$@" ;; clean) clean ;; + save_test_output) save_test_output ;; save_cache) save_cache ;; shell) shift; shell "$@" ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -680,10 +680,12 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAfterScript | Windows <- opsys = [ "bash .gitlab/ci.sh save_cache" + , "bash .gitlab/ci.sh save_test_output" , "bash .gitlab/ci.sh clean" ] | otherwise = [ ".gitlab/ci.sh save_cache" + , ".gitlab/ci.sh save_test_output" , ".gitlab/ci.sh clean" , "cat ci_timings" ] @@ -706,16 +708,19 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , if validateNonmovingGc buildConfig - then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" - else mempty + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -3,6 +3,7 @@ "aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -11,7 +12,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,12 +61,14 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, "aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -73,7 +77,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,12 +122,14 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, "i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -131,7 +138,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,12 +183,14 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, "nightly-aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -189,7 +199,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +248,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -244,6 +256,7 @@ "nightly-aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -252,7 +265,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +310,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -303,6 +318,7 @@ "nightly-aarch64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -311,7 +327,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +372,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -362,6 +380,7 @@ "nightly-i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -370,7 +389,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +434,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -421,6 +442,7 @@ "nightly-x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -429,7 +451,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +500,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -487,6 +511,7 @@ "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -495,7 +520,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +567,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -548,6 +575,7 @@ "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -556,7 +584,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +632,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -610,6 +640,7 @@ "nightly-x86_64-linux-alpine3_12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -618,7 +649,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +697,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -672,6 +705,7 @@ "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -680,7 +714,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +762,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -734,6 +770,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -742,7 +779,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +826,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -795,6 +834,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -803,7 +843,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +890,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -856,6 +898,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -864,7 +907,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +954,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -917,6 +962,7 @@ "nightly-x86_64-linux-centos7-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -925,7 +971,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1017,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -977,6 +1025,7 @@ "nightly-x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -985,7 +1034,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1079,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1036,6 +1087,7 @@ "nightly-x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1044,7 +1096,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1141,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1095,6 +1149,7 @@ "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1103,7 +1158,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1204,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1155,6 +1212,7 @@ "nightly-x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1163,7 +1221,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1266,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1214,6 +1274,7 @@ "nightly-x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1222,7 +1283,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1328,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1273,6 +1336,7 @@ "nightly-x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1281,7 +1345,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1390,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1332,6 +1398,7 @@ "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1340,7 +1407,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1391,6 +1460,7 @@ "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1399,7 +1469,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1515,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1452,6 +1524,7 @@ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1460,7 +1533,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1580,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1513,6 +1588,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1521,7 +1597,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1645,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", "XZ_OPT": "-9" } @@ -1575,6 +1653,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1583,7 +1662,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1630,6 +1710,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1637,6 +1718,7 @@ "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1645,7 +1727,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1689,6 +1772,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1696,6 +1780,7 @@ "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1704,7 +1789,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1756,6 +1842,7 @@ "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1764,7 +1851,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1808,6 +1896,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1815,6 +1904,7 @@ "nightly-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1823,7 +1913,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1960,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1876,6 +1968,7 @@ "nightly-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1884,7 +1977,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1931,6 +2025,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1938,6 +2033,7 @@ "nightly-x86_64-linux-fedora33-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1946,7 +2042,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1992,6 +2089,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1999,6 +2097,7 @@ "nightly-x86_64-linux-rocky8-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2007,7 +2106,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2052,6 +2152,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2059,6 +2160,7 @@ "nightly-x86_64-linux-ubuntu18_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2067,7 +2169,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2111,6 +2214,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2118,6 +2222,7 @@ "nightly-x86_64-linux-ubuntu20_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2126,7 +2231,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2170,6 +2276,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2177,6 +2284,7 @@ "nightly-x86_64-windows-int_native-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2184,7 +2292,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2229,6 +2338,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2236,6 +2346,7 @@ "nightly-x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2243,7 +2354,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2288,6 +2400,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2295,6 +2408,7 @@ "release-aarch64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2303,7 +2417,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2352,6 +2467,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2359,6 +2475,7 @@ "release-aarch64-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2367,7 +2484,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2413,6 +2531,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2420,6 +2539,7 @@ "release-i386-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2428,7 +2548,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2474,6 +2595,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2481,6 +2603,7 @@ "release-x86_64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2489,7 +2612,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2538,6 +2662,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2548,6 +2673,7 @@ "release-x86_64-linux-alpine3_12-int_native-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2556,7 +2682,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2604,6 +2731,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2611,6 +2739,7 @@ "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2619,7 +2748,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2667,6 +2797,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2674,6 +2805,7 @@ "release-x86_64-linux-alpine3_12-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2682,7 +2814,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2730,6 +2863,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2737,6 +2871,7 @@ "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2745,7 +2880,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2791,6 +2927,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2798,6 +2935,7 @@ "release-x86_64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2806,7 +2944,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2852,6 +2991,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2859,6 +2999,7 @@ "release-x86_64-linux-deb10-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2867,7 +3008,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2913,6 +3055,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2920,6 +3063,7 @@ "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2928,7 +3072,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2977,6 +3122,7 @@ "CROSS_TARGET": "javascript-unknown-ghcjs", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", "XZ_OPT": "-9" } @@ -2984,6 +3130,7 @@ "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2992,7 +3139,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3038,6 +3186,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -3045,6 +3194,7 @@ "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3053,7 +3203,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3107,6 +3258,7 @@ "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3115,7 +3267,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3314,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3168,6 +3322,7 @@ "release-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3176,7 +3331,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3380,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3231,6 +3388,7 @@ "release-x86_64-linux-fedora33-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3239,7 +3397,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3287,6 +3446,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3294,6 +3454,7 @@ "release-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3302,7 +3463,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3350,6 +3512,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3357,6 +3520,7 @@ "release-x86_64-linux-rocky8-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3365,7 +3529,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3411,6 +3576,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3418,6 +3584,7 @@ "release-x86_64-linux-ubuntu18_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3426,7 +3593,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3472,6 +3640,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3479,6 +3648,7 @@ "release-x86_64-linux-ubuntu20_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3487,7 +3657,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3533,6 +3704,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3540,6 +3712,7 @@ "release-x86_64-windows-int_native-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3547,7 +3720,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3593,6 +3767,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3600,6 +3775,7 @@ "release-x86_64-windows-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3607,7 +3783,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3830,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3660,6 +3838,7 @@ "x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3668,7 +3847,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3716,6 +3896,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3725,6 +3906,7 @@ "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3733,7 +3915,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3779,12 +3962,14 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3793,7 +3978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3840,12 +4026,14 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3854,7 +4042,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3900,12 +4089,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3914,7 +4105,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3961,12 +4153,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3975,7 +4169,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4022,12 +4217,14 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4036,7 +4233,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4080,12 +4278,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, "x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4094,7 +4294,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4139,12 +4340,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4153,7 +4356,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4198,12 +4402,14 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4212,7 +4418,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4256,12 +4463,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4270,7 +4479,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4314,12 +4524,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4328,7 +4540,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4372,12 +4585,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4386,7 +4601,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4430,12 +4646,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4444,7 +4662,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4490,6 +4709,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4497,6 +4717,7 @@ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4505,7 +4726,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4551,12 +4773,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4565,7 +4789,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4612,12 +4837,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4626,7 +4853,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4673,12 +4901,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, "x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4687,7 +4917,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4738,6 +4969,7 @@ "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4746,7 +4978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4792,12 +5025,14 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, "x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -4805,7 +5040,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4850,6 +5086,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b47106bf968c02311effe8e0af261963966af30e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b47106bf968c02311effe8e0af261963966af30e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:40:20 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 15:40:20 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 3 commits: Improve a little bit the mixing of Ids and ClassIds Message-ID: <64a718a473d18_2c735eafc9410389d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 84acba98 by Rodrigo Mesquita at 2023-07-06T20:16:47+01:00 Improve a little bit the mixing of Ids and ClassIds tWeaks Don't use EG.rebuild as a view pattern Debuggging Touches Fix to representId over multiple (different) nablas Paper over Chagnes2 Then....Start going the other direction - - - - - 822fedd7 by Rodrigo Mesquita at 2023-07-06T20:16:55+01:00 Revert "Improve a little bit the mixing of Ids and ClassIds" This reverts commit 84acba988c354c8e273895e815af41ccdf3e004e. - - - - - 5d225dc6 by Rodrigo Mesquita at 2023-07-06T20:40:08+01:00 Improvement to repId attempt - - - - - 3 changed files: - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -960,10 +960,9 @@ addCoreCt nabla x e = do bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) - xid <- StateT $ \nabla -> pure $ representId x nabla - core_expr xid e - pure xid + x <- StateT $ \nabla -> lift (mkPmMatchId (exprType e) nabla) + core_expr x e + pure x -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -1588,8 +1587,9 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma let gammas = substTheta sigma_ex (eqSpecPreds eq_spec ++ thetas) -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys - arg_ids <- mapM mkPmId field_tys' - let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids + arg_ids <- mapM mkPmId field_tys' -- unfortunate, if PhiConCt received ClassIds instead of Ids we wouldn't need this. ROMES:TODO Explore + -- (arg_ids, nabla') <- runStateT (mapM (StateT @Nabla . mkPmMatchId) field_tys') nabla + let (arg_class_ids, nabla') = representIds arg_ids nabla tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty @@ -2036,12 +2036,11 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do - y <- lift $ mkPmId arg_ty - let (yid,nabla') = representId y nabla + (y, nabla') <- lift $ mkPmMatchId arg_ty nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] - instantiate_newtype_chain yid nabla'' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [y] + instantiate_newtype_chain y nabla'' dcs instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] @@ -2149,7 +2148,7 @@ updateVarInfo :: Functor f => ClassId -> (VarInfo -> f VarInfo) -> Nabla -> f Na -- Update the data at class @xid@ using lenses and the monadic action @go@ updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg -eclassMatchId :: HasCallStack => ClassId -> Nabla -> Id +eclassMatchId :: ClassId -> Nabla -> Id eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) eclassType :: ClassId -> Nabla -> Type @@ -2157,3 +2156,11 @@ eclassType cid = idType . eclassMatchId cid -- ROMES:TODO: When exactly to rebuild? + +-- | Generate a fresh class for matching, returning the class-id as the match-id +mkPmMatchId :: Type -> Nabla -> DsM (ClassId, Nabla) +mkPmMatchId ty (MkNabla tyst ts at TmSt{ts_facts = egr}) = do + x <- mkPmId ty -- romes:Todo: for now, we still use mkPmId to get an Id for emptyVarInfo, but we want to get rid of this too + let (xid, egr') = EG.newEClass (emptyVarInfo x) egr + return (xid, MkNabla tyst ts{ts_facts=egr'}) +{-# NOINLINE mkPmMatchId #-} -- We'll CPR deeply, that should be enough ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Prelude import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id +import GHC.Types.Var.Env import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Core.Equality @@ -155,6 +156,8 @@ data TmState = TmSt { ts_facts :: !TmEGraph -- ^ Facts about terms. + , ts_reps :: !(IdEnv ClassId) + -- ^ A mapping from match-id Ids to the class-id representing that match-id -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know -- which nodes to upward merge, perhaps we can get rid of it too. @@ -242,7 +245,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty + ppr (TmSt eg idmp dirty) = text (show eg) $$ ppr idmp $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -263,7 +266,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt EG.emptyEGraph IS.empty +initTmState = TmSt EG.emptyEGraph mempty IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -320,7 +323,7 @@ emptyVarInfo x -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? -- romes:TodO should return VarInfo rather than Maybe VarInfo lookupVarInfo :: TmState -> ClassId -> VarInfo -lookupVarInfo (TmSt eg _) x +lookupVarInfo (TmSt eg _ _) x -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. = eg ^._class x._data @@ -836,9 +839,11 @@ instance Show VarInfo where representId :: Id -> Nabla -> (ClassId, Nabla) -- Will need to justify this well -representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) +representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) + = case lookupVarEnv idmp x of + Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + Just xid -> (xid, MkNabla tyst tmst) representIds :: [Id] -> Nabla -> ([ClassId], Nabla) representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 +Subproject commit 014e5c2b7acab76675ba2d2e16dd03a3dd19ee5d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0917a6917582e0ae102bf2235329c97b9c7e6b7...5d225dc6363dcea82fb913cf44374b2b5435e55d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0917a6917582e0ae102bf2235329c97b9c7e6b7...5d225dc6363dcea82fb913cf44374b2b5435e55d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:43:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 15:43:16 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 2 commits: Improvement to repId attempt Message-ID: <64a71954779d3_2c735eafde8106412@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: a3e2f726 by Rodrigo Mesquita at 2023-07-06T20:42:52+01:00 Improvement to repId attempt - - - - - 421416dc by Rodrigo Mesquita at 2023-07-06T20:43:04+01:00 Add TODO - - - - - 4 changed files: - + TODO - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== TODO ===================================== @@ -0,0 +1,12 @@ +Oh, we'll really need a "universal" Id that maps to each class-id on each nabla. + +* It still feels like the right thing to do is have PhiCt receive ClassIds +instead of Ids + * especially because of mkPmMatchId, which generates new match-ids without requiring them to be Ids. + * but the complication is having one representative across all Nabla(s) in Nablas + +Do one improvement at a time, and benchmark accordingly. +Ideas: +VarId -> Maybe VarId +Better representation than DeBruijnF, seems wasteful, we only care about +debruijnization for lambdas in view patterns, which don't happen that often. ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -105,8 +105,6 @@ import qualified Data.Equality.Graph as EG import Data.Bifunctor (second) import Data.Function ((&)) import qualified Data.IntSet as IS -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) -- -- * Main exports @@ -960,10 +958,9 @@ addCoreCt nabla x e = do bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) - xid <- StateT $ \nabla -> pure $ representId x nabla - core_expr xid e - pure xid + x <- StateT $ \nabla -> lift (mkPmMatchId (exprType e) nabla) + core_expr x e + pure x -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -1588,8 +1585,9 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma let gammas = substTheta sigma_ex (eqSpecPreds eq_spec ++ thetas) -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys - arg_ids <- mapM mkPmId field_tys' - let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids + arg_ids <- mapM mkPmId field_tys' -- unfortunate, if PhiConCt received ClassIds instead of Ids we wouldn't need this. ROMES:TODO Explore + -- (arg_ids, nabla') <- runStateT (mapM (StateT @Nabla . mkPmMatchId) field_tys') nabla + let (arg_class_ids, nabla') = representIds arg_ids nabla tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty @@ -2036,12 +2034,11 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do - y <- lift $ mkPmId arg_ty - let (yid,nabla') = representId y nabla + (y, nabla') <- lift $ mkPmMatchId arg_ty nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] - instantiate_newtype_chain yid nabla'' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [y] + instantiate_newtype_chain y nabla'' dcs instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] @@ -2149,7 +2146,7 @@ updateVarInfo :: Functor f => ClassId -> (VarInfo -> f VarInfo) -> Nabla -> f Na -- Update the data at class @xid@ using lenses and the monadic action @go@ updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg -eclassMatchId :: HasCallStack => ClassId -> Nabla -> Id +eclassMatchId :: ClassId -> Nabla -> Id eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) eclassType :: ClassId -> Nabla -> Type @@ -2157,3 +2154,11 @@ eclassType cid = idType . eclassMatchId cid -- ROMES:TODO: When exactly to rebuild? + +-- | Generate a fresh class for matching, returning the class-id as the match-id +mkPmMatchId :: Type -> Nabla -> DsM (ClassId, Nabla) +mkPmMatchId ty (MkNabla tyst ts at TmSt{ts_facts = egr}) = do + x <- mkPmId ty -- romes:Todo: for now, we still use mkPmId to get an Id for emptyVarInfo, but we want to get rid of this too + let (xid, egr') = EG.newEClass (emptyVarInfo x) egr + return (xid, MkNabla tyst ts{ts_facts=egr'}) +{-# NOINLINE mkPmMatchId #-} -- We'll CPR deeply, that should be enough ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Prelude import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id +import GHC.Types.Var.Env import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Core.Equality @@ -155,6 +156,8 @@ data TmState = TmSt { ts_facts :: !TmEGraph -- ^ Facts about terms. + , ts_reps :: !(IdEnv ClassId) + -- ^ A mapping from match-id Ids to the class-id representing that match-id -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know -- which nodes to upward merge, perhaps we can get rid of it too. @@ -242,7 +245,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty + ppr (TmSt eg idmp dirty) = text (show eg) $$ ppr idmp $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -263,7 +266,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt EG.emptyEGraph IS.empty +initTmState = TmSt EG.emptyEGraph mempty IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -320,7 +323,7 @@ emptyVarInfo x -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? -- romes:TodO should return VarInfo rather than Maybe VarInfo lookupVarInfo :: TmState -> ClassId -> VarInfo -lookupVarInfo (TmSt eg _) x +lookupVarInfo (TmSt eg _ _) x -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. = eg ^._class x._data @@ -836,9 +839,11 @@ instance Show VarInfo where representId :: Id -> Nabla -> (ClassId, Nabla) -- Will need to justify this well -representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) +representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) + = case lookupVarEnv idmp x of + Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + Just xid -> (xid, MkNabla tyst tmst) representIds :: [Id] -> Nabla -> ([ClassId], Nabla) representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 +Subproject commit 014e5c2b7acab76675ba2d2e16dd03a3dd19ee5d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d225dc6363dcea82fb913cf44374b2b5435e55d...421416dc49a5b37d1d240d7f2a9eedcd5200fb01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d225dc6363dcea82fb913cf44374b2b5435e55d...421416dc49a5b37d1d240d7f2a9eedcd5200fb01 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:48:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 15:48:34 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 4 commits: gitlab-ci: Preserve unexpected output Message-ID: <64a71a924c3c8_2c735eafcbc10704c@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: b47106bf by Ben Gamari at 2023-07-06T15:32:27-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 375eba30 by Ben Gamari at 2023-07-06T15:47:57-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - fac83e2f by Ben Gamari at 2023-07-06T15:47:57-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 51244bd7 by Ben Gamari at 2023-07-06T15:47:57-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 20 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - testsuite/tests/ghci/scripts/ghci008.stdout - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - + testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== .gitlab/ci.sh ===================================== @@ -43,12 +43,13 @@ $0 - GHC continuous integration driver Common Modes: - usage Show this usage message. - setup Prepare environment for a build. - configure Run ./configure. - clean Clean the tree - shell Run an interactive shell with a configured build environment. - save_cache Preserve the cabal cache + usage Show this usage message. + setup Prepare environment for a build. + configure Run ./configure. + clean Clean the tree + shell Run an interactive shell with a configured build environment. + save_test_output Generate unexpected-test-output.tar.gz + save_cache Preserve the cabal cache Hadrian build system build_hadrian Build GHC via the Hadrian build system @@ -614,12 +615,16 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --docs=none \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "cross-compiled hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "cross-compiled hadrian main testsuite" elif [[ -n "${CROSS_TARGET:-}" ]] && [[ "${CROSS_TARGET:-}" == *"wasm"* ]]; then run_hadrian \ test \ --summary-junit=./junit.xml \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite targetting $CROSS_TARGET" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite targetting $CROSS_TARGET" elif [ -n "${CROSS_TARGET:-}" ]; then local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -635,7 +640,9 @@ function test_hadrian() { --test-compiler=stage-cabal \ --test-root-dirs=testsuite/tests/perf \ --test-root-dirs=testsuite/tests/typecheck \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian cabal-install test" else local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -673,12 +680,14 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" + tar -czf unexpected-test-output.tar.gz unexpected-test-output info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { @@ -770,6 +779,10 @@ function run_abi_test() { check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes" } +function save_test_output() { + tar -czf unexpected-test-output.tar.gz unexpected-test-output +} + function save_cache () { info "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..." rm -Rf "$CABAL_CACHE" @@ -935,6 +948,7 @@ case ${1:-help} in lint_author) shift; lint_author "$@" ;; compare_interfaces_of) shift; compare_interfaces_of "$@" ;; clean) clean ;; + save_test_output) save_test_output ;; save_cache) save_cache ;; shell) shift; shell "$@" ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -680,10 +680,12 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAfterScript | Windows <- opsys = [ "bash .gitlab/ci.sh save_cache" + , "bash .gitlab/ci.sh save_test_output" , "bash .gitlab/ci.sh clean" ] | otherwise = [ ".gitlab/ci.sh save_cache" + , ".gitlab/ci.sh save_test_output" , ".gitlab/ci.sh clean" , "cat ci_timings" ] @@ -706,16 +708,19 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , if validateNonmovingGc buildConfig - then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" - else mempty + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -3,6 +3,7 @@ "aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -11,7 +12,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,12 +61,14 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, "aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -73,7 +77,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,12 +122,14 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, "i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -131,7 +138,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,12 +183,14 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, "nightly-aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -189,7 +199,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +248,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -244,6 +256,7 @@ "nightly-aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -252,7 +265,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +310,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -303,6 +318,7 @@ "nightly-aarch64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -311,7 +327,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +372,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -362,6 +380,7 @@ "nightly-i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -370,7 +389,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +434,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -421,6 +442,7 @@ "nightly-x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -429,7 +451,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +500,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -487,6 +511,7 @@ "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -495,7 +520,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +567,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -548,6 +575,7 @@ "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -556,7 +584,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +632,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -610,6 +640,7 @@ "nightly-x86_64-linux-alpine3_12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -618,7 +649,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +697,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -672,6 +705,7 @@ "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -680,7 +714,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +762,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -734,6 +770,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -742,7 +779,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +826,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -795,6 +834,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -803,7 +843,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +890,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -856,6 +898,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -864,7 +907,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +954,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -917,6 +962,7 @@ "nightly-x86_64-linux-centos7-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -925,7 +971,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1017,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -977,6 +1025,7 @@ "nightly-x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -985,7 +1034,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1079,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1036,6 +1087,7 @@ "nightly-x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1044,7 +1096,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1141,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1095,6 +1149,7 @@ "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1103,7 +1158,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1204,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1155,6 +1212,7 @@ "nightly-x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1163,7 +1221,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1266,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1214,6 +1274,7 @@ "nightly-x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1222,7 +1283,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1328,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1273,6 +1336,7 @@ "nightly-x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1281,7 +1345,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1390,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1332,6 +1398,7 @@ "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1340,7 +1407,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1391,6 +1460,7 @@ "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1399,7 +1469,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1515,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1452,6 +1524,7 @@ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1460,7 +1533,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1580,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1513,6 +1588,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1521,7 +1597,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1645,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", "XZ_OPT": "-9" } @@ -1575,6 +1653,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1583,7 +1662,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1630,6 +1710,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1637,6 +1718,7 @@ "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1645,7 +1727,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1689,6 +1772,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1696,6 +1780,7 @@ "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1704,7 +1789,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1756,6 +1842,7 @@ "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1764,7 +1851,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1808,6 +1896,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1815,6 +1904,7 @@ "nightly-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1823,7 +1913,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1960,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1876,6 +1968,7 @@ "nightly-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1884,7 +1977,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1931,6 +2025,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1938,6 +2033,7 @@ "nightly-x86_64-linux-fedora33-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1946,7 +2042,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1992,6 +2089,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1999,6 +2097,7 @@ "nightly-x86_64-linux-rocky8-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2007,7 +2106,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2052,6 +2152,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2059,6 +2160,7 @@ "nightly-x86_64-linux-ubuntu18_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2067,7 +2169,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2111,6 +2214,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2118,6 +2222,7 @@ "nightly-x86_64-linux-ubuntu20_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2126,7 +2231,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2170,6 +2276,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2177,6 +2284,7 @@ "nightly-x86_64-windows-int_native-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2184,7 +2292,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2229,6 +2338,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2236,6 +2346,7 @@ "nightly-x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2243,7 +2354,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2288,6 +2400,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2295,6 +2408,7 @@ "release-aarch64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2303,7 +2417,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2352,6 +2467,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2359,6 +2475,7 @@ "release-aarch64-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2367,7 +2484,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2413,6 +2531,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2420,6 +2539,7 @@ "release-i386-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2428,7 +2548,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2474,6 +2595,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2481,6 +2603,7 @@ "release-x86_64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2489,7 +2612,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2538,6 +2662,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2548,6 +2673,7 @@ "release-x86_64-linux-alpine3_12-int_native-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2556,7 +2682,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2604,6 +2731,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2611,6 +2739,7 @@ "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2619,7 +2748,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2667,6 +2797,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2674,6 +2805,7 @@ "release-x86_64-linux-alpine3_12-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2682,7 +2814,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2730,6 +2863,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2737,6 +2871,7 @@ "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2745,7 +2880,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2791,6 +2927,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2798,6 +2935,7 @@ "release-x86_64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2806,7 +2944,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2852,6 +2991,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2859,6 +2999,7 @@ "release-x86_64-linux-deb10-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2867,7 +3008,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2913,6 +3055,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2920,6 +3063,7 @@ "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2928,7 +3072,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2977,6 +3122,7 @@ "CROSS_TARGET": "javascript-unknown-ghcjs", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", "XZ_OPT": "-9" } @@ -2984,6 +3130,7 @@ "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2992,7 +3139,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3038,6 +3186,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -3045,6 +3194,7 @@ "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3053,7 +3203,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3107,6 +3258,7 @@ "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3115,7 +3267,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3314,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3168,6 +3322,7 @@ "release-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3176,7 +3331,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3380,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3231,6 +3388,7 @@ "release-x86_64-linux-fedora33-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3239,7 +3397,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3287,6 +3446,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3294,6 +3454,7 @@ "release-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3302,7 +3463,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3350,6 +3512,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3357,6 +3520,7 @@ "release-x86_64-linux-rocky8-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3365,7 +3529,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3411,6 +3576,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3418,6 +3584,7 @@ "release-x86_64-linux-ubuntu18_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3426,7 +3593,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3472,6 +3640,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3479,6 +3648,7 @@ "release-x86_64-linux-ubuntu20_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3487,7 +3657,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3533,6 +3704,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3540,6 +3712,7 @@ "release-x86_64-windows-int_native-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3547,7 +3720,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3593,6 +3767,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3600,6 +3775,7 @@ "release-x86_64-windows-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3607,7 +3783,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3830,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3660,6 +3838,7 @@ "x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3668,7 +3847,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3716,6 +3896,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3725,6 +3906,7 @@ "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3733,7 +3915,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3779,12 +3962,14 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3793,7 +3978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3840,12 +4026,14 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3854,7 +4042,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3900,12 +4089,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3914,7 +4105,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3961,12 +4153,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3975,7 +4169,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4022,12 +4217,14 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4036,7 +4233,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4080,12 +4278,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, "x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4094,7 +4294,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4139,12 +4340,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4153,7 +4356,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4198,12 +4402,14 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4212,7 +4418,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4256,12 +4463,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4270,7 +4479,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4314,12 +4524,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4328,7 +4540,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4372,12 +4585,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4386,7 +4601,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4430,12 +4646,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4444,7 +4662,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4490,6 +4709,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4497,6 +4717,7 @@ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4505,7 +4726,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4551,12 +4773,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4565,7 +4789,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4612,12 +4837,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4626,7 +4853,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4673,12 +4901,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, "x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4687,7 +4917,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4738,6 +4969,7 @@ "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4746,7 +4978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4792,12 +5025,14 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, "x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -4805,7 +5040,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4850,6 +5086,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -834,10 +834,13 @@ When printing an interface file (--show-iface), we want to print everything unqualified, so we can just print the OccName directly. -} +-- | Show a declaration but not its RHS. showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing , ss_forall = ShowForAllWhen } +-- | Show declaration and its RHS, including GHc-internal information (e.g. +-- for @--show-iface@). showToIface :: ShowSub showToIface = ShowSub { ss_how_much = ShowIface , ss_forall = ShowForAllWhen } @@ -848,18 +851,20 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome Nothing _ }) doc + = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome (Just f) _ }) thing + = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1361,21 +1361,18 @@ data ShowSub newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch - = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + = ShowHeader AltPpr -- ^ Header information only, not rhs + | ShowSome (Maybe (OccName -> Bool)) AltPpr + -- ^ Show the declaration and its RHS. The @Maybe@ predicate + -- allows filtering of the sub-components which should be printing; + -- any sub-components filtered out will be elided with @... at . | ShowIface - -- ^Everything including GHC-internal information (used in --show-iface) + -- ^ Everything including GHC-internal information (used in --show-iface) instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc pprIfaceSigmaType show_forall ty ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,16 +145,24 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = case parents thing of + -- If there are no parents print everything. + [] -> print_it Nothing thing + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let subs = map getOccName (thing:rest) + filt = (`elem` subs) + in print_it (Just filt) thing' where - go ss thing - = case tyThingParent_maybe thing of - Just parent -> - go (getOccName thing : ss) parent - Nothing -> - pprTyThing - (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) - thing + parents = go + where + go thing = + case tyThingParent_maybe thing of + Just parent -> parent : go parent + Nothing -> [] + + print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc + print_it mb_filt thing = + pprTyThing (show_sub { ss_how_much = ShowSome mb_filt (AltPpr Nothing) }) thing -- | Like 'pprTyThingInContext', but adds the defining location. pprTyThingInContextLoc :: TyThing -> SDoc @@ -171,8 +179,8 @@ pprTyThing ss ty_thing pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing) where ss' = case ss_how_much ss of - ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } - ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' } + ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } + ShowSome filt (AltPpr Nothing) -> ss { ss_how_much = ShowSome filt ppr' } _ -> ss ppr' = AltPpr $ ppr_bndr $ getName ty_thing ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/ghci/scripts/ghci008.stdout ===================================== @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ -base-4.16.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘base-4.16.0.0:Data.OldList’ +base-4.18.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.18.0.0:Data.OldList’ ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,243 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc, mkVarOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons ++ + map mkVarOcc integerConversionIds + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + + -- Conversion functions in GHC.Integer which are only exposed on 32-bit + -- platforms + integerConversionIds = + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> nest 2 (text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}") + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/498fdbf8049d1b003fb108d0cbe6eab8799458a4...51244bd7e51feaa0b2ef6c75c77ede3c5657f21d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/498fdbf8049d1b003fb108d0cbe6eab8799458a4...51244bd7e51feaa0b2ef6c75c77ede3c5657f21d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 19:49:12 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 15:49:12 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 2 commits: compiler: Rework ShowSome Message-ID: <64a71ab898266_2c735eafca81079da@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: d9e755db by Ben Gamari at 2023-07-06T15:49:02-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 0a0009fa by Ben Gamari at 2023-07-06T15:49:02-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 17 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - testsuite/tests/ghci/scripts/ghci008.stdout - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - + testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -834,10 +834,13 @@ When printing an interface file (--show-iface), we want to print everything unqualified, so we can just print the OccName directly. -} +-- | Show a declaration but not its RHS. showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing , ss_forall = ShowForAllWhen } +-- | Show declaration and its RHS, including GHc-internal information (e.g. +-- for @--show-iface@). showToIface :: ShowSub showToIface = ShowSub { ss_how_much = ShowIface , ss_forall = ShowForAllWhen } @@ -848,18 +851,20 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome Nothing _ }) doc + = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome (Just f) _ }) thing + = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1361,21 +1361,18 @@ data ShowSub newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch - = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + = ShowHeader AltPpr -- ^ Header information only, not rhs + | ShowSome (Maybe (OccName -> Bool)) AltPpr + -- ^ Show the declaration and its RHS. The @Maybe@ predicate + -- allows filtering of the sub-components which should be printing; + -- any sub-components filtered out will be elided with @... at . | ShowIface - -- ^Everything including GHC-internal information (used in --show-iface) + -- ^ Everything including GHC-internal information (used in --show-iface) instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc pprIfaceSigmaType show_forall ty ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,16 +145,24 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = case parents thing of + -- If there are no parents print everything. + [] -> print_it Nothing thing + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let subs = map getOccName (thing:rest) + filt = (`elem` subs) + in print_it (Just filt) thing' where - go ss thing - = case tyThingParent_maybe thing of - Just parent -> - go (getOccName thing : ss) parent - Nothing -> - pprTyThing - (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) - thing + parents = go + where + go thing = + case tyThingParent_maybe thing of + Just parent -> parent : go parent + Nothing -> [] + + print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc + print_it mb_filt thing = + pprTyThing (show_sub { ss_how_much = ShowSome mb_filt (AltPpr Nothing) }) thing -- | Like 'pprTyThingInContext', but adds the defining location. pprTyThingInContextLoc :: TyThing -> SDoc @@ -171,8 +179,8 @@ pprTyThing ss ty_thing pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing) where ss' = case ss_how_much ss of - ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } - ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' } + ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } + ShowSome filt (AltPpr Nothing) -> ss { ss_how_much = ShowSome filt ppr' } _ -> ss ppr' = AltPpr $ ppr_bndr $ getName ty_thing ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/ghci/scripts/ghci008.stdout ===================================== @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ -base-4.16.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘base-4.16.0.0:Data.OldList’ +base-4.18.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.18.0.0:Data.OldList’ ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,243 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc, mkVarOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons ++ + map mkVarOcc integerConversionIds + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + + -- Conversion functions in GHC.Integer which are only exposed on 32-bit + -- platforms + integerConversionIds = + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> nest 2 (text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}") + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51244bd7e51feaa0b2ef6c75c77ede3c5657f21d...0a0009facd317512fb16f19ed8c7556758726c6d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51244bd7e51feaa0b2ef6c75c77ede3c5657f21d...0a0009facd317512fb16f19ed8c7556758726c6d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 20:25:27 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 16:25:27 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Add TODO Message-ID: <64a7233770d6c_2c735eafde81226c0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 40552c65 by Rodrigo Mesquita at 2023-07-06T21:25:17+01:00 Add TODO - - - - - 2 changed files: - + TODO - compiler/GHC/HsToCore/Pmc/Solver.hs Changes: ===================================== TODO ===================================== @@ -0,0 +1,12 @@ +Oh, we'll really need a "universal" Id that maps to each class-id on each nabla. + +* It still feels like the right thing to do is have PhiCt receive ClassIds +instead of Ids + * especially because of mkPmMatchId, which generates new match-ids without requiring them to be Ids. + * but the complication is having one representative across all Nabla(s) in Nablas + +Do one improvement at a time, and benchmark accordingly. +Ideas: +VarId -> Maybe VarId +Better representation than DeBruijnF, seems wasteful, we only care about +debruijnization for lambdas in view patterns, which don't happen that often. ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -843,7 +843,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so case equate env x y of -- Add the constraints we had for x to y - -- See Note [Joining e-classes PMC] todo mention from joinA + -- See Note (TODO) [Joining e-classes PMC] todo mention from joinA -- Now, here's a really tricky bit (TODO Write note, is it the one above?) -- Bc the joinA operation is unlawful, and because the makeA operation for -- expressions is also unlawful (sets the type to ()::(), mostly out of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40552c651cc38f8db397171f0b5b573e3c9f178f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40552c651cc38f8db397171f0b5b573e3c9f178f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 20:28:10 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 06 Jul 2023 16:28:10 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 2 commits: Improvement to repId attempt Message-ID: <64a723dae8bc3_2c735eafc9412320@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 25f926d1 by Rodrigo Mesquita at 2023-07-06T21:27:53+01:00 Improvement to repId attempt submodule hegg update for no reason - - - - - 7539a46a by Rodrigo Mesquita at 2023-07-06T21:28:01+01:00 Add TODO - - - - - 4 changed files: - + TODO - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - libraries/hegg Changes: ===================================== TODO ===================================== @@ -0,0 +1,12 @@ +Oh, we'll really need a "universal" Id that maps to each class-id on each nabla. + +* It still feels like the right thing to do is have PhiCt receive ClassIds +instead of Ids + * especially because of mkPmMatchId, which generates new match-ids without requiring them to be Ids. + * but the complication is having one representative across all Nabla(s) in Nablas + +Do one improvement at a time, and benchmark accordingly. +Ideas: +VarId -> Maybe VarId +Better representation than DeBruijnF, seems wasteful, we only care about +debruijnization for lambdas in view patterns, which don't happen that often. ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -105,8 +105,6 @@ import qualified Data.Equality.Graph as EG import Data.Bifunctor (second) import Data.Function ((&)) import qualified Data.IntSet as IS -import Data.Tuple (swap) -import Data.Traversable (mapAccumL) -- -- * Main exports @@ -845,7 +843,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so case equate env x y of -- Add the constraints we had for x to y - -- See Note [Joining e-classes PMC] todo mention from joinA + -- See Note (TODO) [Joining e-classes PMC] todo mention from joinA -- Now, here's a really tricky bit (TODO Write note, is it the one above?) -- Bc the joinA operation is unlawful, and because the makeA operation for -- expressions is also unlawful (sets the type to ()::(), mostly out of @@ -960,10 +958,9 @@ addCoreCt nabla x e = do bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do - x <- lift (lift (mkPmId (exprType e))) - xid <- StateT $ \nabla -> pure $ representId x nabla - core_expr xid e - pure xid + x <- StateT $ \nabla -> lift (mkPmMatchId (exprType e) nabla) + core_expr x e + pure x -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -1588,8 +1585,9 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma let gammas = substTheta sigma_ex (eqSpecPreds eq_spec ++ thetas) -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys - arg_ids <- mapM mkPmId field_tys' - let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids + arg_ids <- mapM mkPmId field_tys' -- unfortunate, if PhiConCt received ClassIds instead of Ids we wouldn't need this. ROMES:TODO Explore + -- (arg_ids, nabla') <- runStateT (mapM (StateT @Nabla . mkPmMatchId) field_tys') nabla + let (arg_class_ids, nabla') = representIds arg_ids nabla tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty @@ -2036,12 +2034,11 @@ generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do - y <- lift $ mkPmId arg_ty - let (yid,nabla') = representId y nabla + (y, nabla') <- lift $ mkPmMatchId arg_ty nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] - instantiate_newtype_chain yid nabla'' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [y] + instantiate_newtype_chain y nabla'' dcs instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] @@ -2149,7 +2146,7 @@ updateVarInfo :: Functor f => ClassId -> (VarInfo -> f VarInfo) -> Nabla -> f Na -- Update the data at class @xid@ using lenses and the monadic action @go@ updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg -eclassMatchId :: HasCallStack => ClassId -> Nabla -> Id +eclassMatchId :: ClassId -> Nabla -> Id eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) eclassType :: ClassId -> Nabla -> Type @@ -2157,3 +2154,11 @@ eclassType cid = idType . eclassMatchId cid -- ROMES:TODO: When exactly to rebuild? + +-- | Generate a fresh class for matching, returning the class-id as the match-id +mkPmMatchId :: Type -> Nabla -> DsM (ClassId, Nabla) +mkPmMatchId ty (MkNabla tyst ts at TmSt{ts_facts = egr}) = do + x <- mkPmId ty -- romes:Todo: for now, we still use mkPmId to get an Id for emptyVarInfo, but we want to get rid of this too + let (xid, egr') = EG.newEClass (emptyVarInfo x) egr + return (xid, MkNabla tyst ts{ts_facts=egr'}) +{-# NOINLINE mkPmMatchId #-} -- We'll CPR deeply, that should be enough ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Prelude import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id +import GHC.Types.Var.Env import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Core.Equality @@ -155,6 +156,8 @@ data TmState = TmSt { ts_facts :: !TmEGraph -- ^ Facts about terms. + , ts_reps :: !(IdEnv ClassId) + -- ^ A mapping from match-id Ids to the class-id representing that match-id -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know -- which nodes to upward merge, perhaps we can get rid of it too. @@ -242,7 +245,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty + ppr (TmSt eg idmp dirty) = text (show eg) $$ ppr idmp $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -263,7 +266,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt EG.emptyEGraph IS.empty +initTmState = TmSt EG.emptyEGraph mempty IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -320,7 +323,7 @@ emptyVarInfo x -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? -- romes:TodO should return VarInfo rather than Maybe VarInfo lookupVarInfo :: TmState -> ClassId -> VarInfo -lookupVarInfo (TmSt eg _) x +lookupVarInfo (TmSt eg _ _) x -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. = eg ^._class x._data @@ -836,9 +839,11 @@ instance Show VarInfo where representId :: Id -> Nabla -> (ClassId, Nabla) -- Will need to justify this well -representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) - = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) +representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) + = case lookupVarEnv idmp x of + Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + Just xid -> (xid, MkNabla tyst tmst) representIds :: [Id] -> Nabla -> ([ClassId], Nabla) representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 238557096a773b8cbe70d141ed63aef302918a62 +Subproject commit 014e5c2b7acab76675ba2d2e16dd03a3dd19ee5d View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40552c651cc38f8db397171f0b5b573e3c9f178f...7539a46aa34f431fe019507a19b345e96fceeb7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40552c651cc38f8db397171f0b5b573e3c9f178f...7539a46aa34f431fe019507a19b345e96fceeb7f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 20:52:22 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Thu, 06 Jul 2023 16:52:22 -0400 Subject: [Git][ghc/ghc][wip/clc-86] 79 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64a729864010a_2c735eafca8127637@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 137f1c50 by Melanie Phoenix at 2023-07-06T16:52:11-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa934bd958cb8addc84ba76566008b8a0712ecfb...137f1c50c261dfd0335dfc399dbe0f281270e5a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa934bd958cb8addc84ba76566008b8a0712ecfb...137f1c50c261dfd0335dfc399dbe0f281270e5a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 21:46:26 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Thu, 06 Jul 2023 17:46:26 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 57 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a73632dfc00_2c735eafdc0131415@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 7ef0df43 by Alan Zimmerman at 2023-07-05T18:11:34+01:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - 57d22fd5 by Alan Zimmerman at 2023-07-05T18:30:15+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 313c0865 by Alan Zimmerman at 2023-07-05T18:35:14+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - f8388127 by Alan Zimmerman at 2023-07-05T18:42:33+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 65060d46 by Alan Zimmerman at 2023-07-05T20:12:18+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 1da9ad10 by Alan Zimmerman at 2023-07-05T20:12:23+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - df8e93b4 by Alan Zimmerman at 2023-07-05T20:12:57+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - baee838d by Alan Zimmerman at 2023-07-05T20:12:59+01:00 EPA: Fix span for GRHS - - - - - 1d005e61 by Alan Zimmerman at 2023-07-05T20:12:59+01:00 EPA: Fix span for Located Context - - - - - 1588e03d by Alan Zimmerman at 2023-07-05T20:12:59+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - a815db20 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 EPA: widen more TrailingAnn usages - - - - - 269dd8c3 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 4d8a8c4a by Alan Zimmerman at 2023-07-05T20:13:00+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - e45fbcf0 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 WIP - - - - - b81dd3ac by Alan Zimmerman at 2023-07-05T20:13:00+01:00 Fixup after rebase - - - - - c4b5d528 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 9b64e7c5 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 98b84d09 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - a0f2c442 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 8af744d7 by Alan Zimmerman at 2023-07-05T20:13:00+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 7192357f by Alan Zimmerman at 2023-07-05T20:13:00+01:00 EPA: More extending anchors to full span in Parser.y - - - - - b3820fc5 by Alan Zimmerman at 2023-07-05T20:13:29+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - bc761a1f by Alan Zimmerman at 2023-07-05T21:07:55+01:00 EPA: Fix simple tests - - - - - bb9a4b73 by Alan Zimmerman at 2023-07-05T21:08:02+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 44776878 by Alan Zimmerman at 2023-07-06T22:43:48+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90b2ee280996c4a37d9c570d0526d944aa0d2d4a...447768785d6b83535680eed111c7b70191f910cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90b2ee280996c4a37d9c570d0526d944aa0d2d4a...447768785d6b83535680eed111c7b70191f910cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 22:19:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 06 Jul 2023 18:19:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Filter out nontrivial substituted expressions in substTickish Message-ID: <64a73defa176e_2c735eafc94138816@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - c1ea1959 by Sylvain Henry at 2023-07-06T18:19:21-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - e3898940 by Sylvain Henry at 2023-07-06T18:19:21-04:00 JS: rename VarType/Vt into JSRep - - - - - fde10755 by Sylvain Henry at 2023-07-06T18:19:21-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - a3a326fd by Sylvain Henry at 2023-07-06T18:19:21-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 2cacc09d by Matthew Pickering at 2023-07-06T18:19:22-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - a26b1150 by Matthew Pickering at 2023-07-06T18:19:22-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - docs/users_guide/debugging.rst - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/openFile003.stdout-javascript-unknown-ghcjs - libraries/base/tests/all.T - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/ghc-api/target-contents/all.T - testsuite/tests/ghci/linking/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/numeric/should_run/all.T - testsuite/tests/primops/should_run/all.T - testsuite/tests/programs/jtod_circint/test.T - testsuite/tests/rts/all.T - testsuite/tests/simplCore/T9646/test.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09564528f481f9189a9e39a54a0a0688f0cb547c...a26b115068432695452c1ab31f8a1ca906a21bb7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09564528f481f9189a9e39a54a0a0688f0cb547c...a26b115068432695452c1ab31f8a1ca906a21bb7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 6 22:35:58 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 06 Jul 2023 18:35:58 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Try dropping the early-preInlineUnconditionally test Message-ID: <64a741ce6ceb8_2c735eafdc0144179@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: fbec913a by Simon Peyton Jones at 2023-07-06T23:35:50+01:00 Try dropping the early-preInlineUnconditionally test - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -417,6 +417,7 @@ simplAuxBind _str env bndr new_rhs = return (emptyFloats env, env) -- Here c is dead, and we avoid -- creating the binding c = (a,b) +{- Try not doing this -- The cases would be inlined unconditionally by completeBind: -- but it seems not uncommon, and avoids faff to do it here -- This is safe because it's only used for auxiliary bindings, which @@ -429,6 +430,7 @@ simplAuxBind _str env bndr new_rhs , case new_rhs of Coercion co -> extendCvSubst env bndr co _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) +-} | otherwise = do { -- ANF-ise the RHS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fbec913af8ed7a42d01792c7bf6768f8996d5d2e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fbec913af8ed7a42d01792c7bf6768f8996d5d2e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 00:10:37 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 20:10:37 -0400 Subject: [Git][ghc/ghc][ghc-9.8] Deleted 1 commit: template-haskell Message-ID: <64a757fda03c8_2c735eafcd015597d@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: d2224ad0 by Ben Gamari at 2023-07-05T09:26:32-04:00 template-haskell - - - - - 1 changed file: - compiler/ghc.cabal.in Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -104,7 +104,7 @@ Library containers >= 0.6.2.1 && < 0.7, array >= 0.1 && < 0.6, filepath >= 1 && < 1.5, - template-haskell == 2.20.*, + template-haskell == 2.21.*, hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2224ad00d71de83ba75ac6d6a82487cf4ba9061 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2224ad00d71de83ba75ac6d6a82487cf4ba9061 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 00:11:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 20:11:41 -0400 Subject: [Git][ghc/ghc][ghc-9.8] Deleted 3 commits: base: Bump version to 4.19 Message-ID: <64a7583d241df_2c735eafe1015618b@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: b66c4692 by Ben Gamari at 2023-07-05T09:26:15-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 692afb12 by Ben Gamari at 2023-07-05T09:26:32-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - d93c1d86 by Ben Gamari at 2023-07-05T09:26:32-04:00 template-haskell: Bump version to 2.21.0.0 - - - - - 22 changed files: - compiler/ghc.cabal.in - configure.ac - libraries/array - libraries/base/base.cabal - libraries/directory - libraries/exceptions - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/ghc-compact.cabal - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/parsec - libraries/semaphore-compat - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/unix - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout - testsuite/tests/gadt/T19847a.stderr - utils/haddock - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -94,7 +94,7 @@ Library extra-libraries: zstd CPP-Options: -DHAVE_LIBZSTD - Build-Depends: base >= 4.11 && < 4.19, + Build-Depends: base >= 4.11 && < 4.20, deepseq >= 1.4 && < 1.6, directory >= 1 && < 1.4, process >= 1 && < 1.7, ===================================== configure.ac ===================================== @@ -224,7 +224,7 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -MinBootGhcVersion="9.2" +MinBootGhcVersion="9.4" FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[$MinBootGhcVersion], [AC_MSG_ERROR([GHC version $MinBootGhcVersion or later is required to compile GHC.])]) ===================================== libraries/array ===================================== @@ -1 +1 @@ -Subproject commit f487b8de85f2b271a3831c14ab6439b9bc9b8343 +Subproject commit 734dfe636914bd43b110543282a9ff8a8265b0a5 ===================================== libraries/base/base.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 3.0 name: base -version: 4.18.0.0 +version: 4.19.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3ae36d84e44737fa9800d74d55ae1e30b75628cf +Subproject commit a0c9361817db13917df7777f669a97c4d787f44e ===================================== libraries/exceptions ===================================== @@ -1 +1 @@ -Subproject commit a473e4fa1acdbcfc7cc96f84ae3f2cb38261e08b +Subproject commit b1cbf778844a28203f7da1ef286a9b4e7d6e4bb9 ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit bb0e5cd49655b41bd3209b100f7a5a74698cbe83 +Subproject commit 6da411d1bdc4a0731bc8135f11ad16181f9e2d6d ===================================== libraries/ghc-boot-th/ghc-boot-th.cabal.in ===================================== @@ -36,4 +36,4 @@ Library GHC.ForeignSrcLang.Type GHC.Lexeme - build-depends: base >= 4.7 && < 4.19 + build-depends: base >= 4.7 && < 4.20 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -70,7 +70,7 @@ Library GHC.Version GHC.Platform.Host - build-depends: base >= 4.7 && < 4.19, + build-depends: base >= 4.7 && < 4.20, binary == 0.8.*, bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, ===================================== libraries/ghc-compact/ghc-compact.cabal ===================================== @@ -40,7 +40,7 @@ library CPP build-depends: ghc-prim >= 0.5.3 && < 0.11, - base >= 4.9.0 && < 4.19, + base >= 4.9.0 && < 4.20, bytestring >= 0.10.6.0 && <0.12 ghc-options: -Wall ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -75,7 +75,7 @@ library Build-Depends: rts, array == 0.5.*, - base >= 4.8 && < 4.19, + base >= 4.8 && < 4.20, ghc-prim >= 0.5.0 && < 0.11, binary == 0.8.*, bytestring >= 0.10 && < 0.12, @@ -84,7 +84,7 @@ library filepath == 1.4.*, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, - template-haskell == 2.20.*, + template-haskell == 2.21.*, transformers >= 0.5 && < 0.7 if !os(windows) ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 1c2ad91edc936a9836d1ad80a26f8be03a7d8bb0 +Subproject commit 0ea07e223685787893dccbcbb67f1720ef4cf80e ===================================== libraries/parsec ===================================== @@ -1 +1 @@ -Subproject commit 1f542120d9adc5e22f8791a6d595210e93c6c389 +Subproject commit ddcd0cbafe7637b15fda48f1c7cf735f3ccfd8c9 ===================================== libraries/semaphore-compat ===================================== @@ -1 +1 @@ -Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e +Subproject commit c8fc7b1757b4eecbd10239038fbc6602340105b1 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit 86172e75bd4f5c400b3a6f0cd3945bdb7c03bcdd +Subproject commit f8582bd6e31df73b4f18f676650ae183624d8eb2 ===================================== libraries/template-haskell/template-haskell.cabal.in ===================================== @@ -3,7 +3,7 @@ -- template-haskell.cabal. name: template-haskell -version: 2.20.0.0 +version: 2.21.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE @@ -55,7 +55,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base >= 4.11 && < 4.19, + base >= 4.11 && < 4.20, ghc-boot-th == @ProjectVersionMunged@, ghc-prim, pretty == 1.1.* ===================================== libraries/terminfo ===================================== @@ -1 +1 @@ -Subproject commit 98100776edcf33796ddf2e752233e6ef179b876d +Subproject commit 4d26c55fb2f4af9649c318ef17abba13fbb214a4 ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit 720debbf5b89366007bac473e8d7fd18e4114f1a +Subproject commit 5c3f316cf13b1c5a2c8622065cccd8eb81a81b89 ===================================== testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout ===================================== @@ -1,25 +1,25 @@ -Preprocessing library 'p' for bkpcabal08-0.1.0.0.. +Preprocessing library 'impl' for bkpcabal08-0.1.0.0... +Building library 'impl' for bkpcabal08-0.1.0.0... +Preprocessing library 'p' for bkpcabal08-0.1.0.0... Building library 'p' instantiated with A = B = -for bkpcabal08-0.1.0.0.. +for bkpcabal08-0.1.0.0... [2 of 2] Compiling B[sig] ( p/B.hsig, nothing ) -Preprocessing library 'q' for bkpcabal08-0.1.0.0.. +Preprocessing library 'q' for bkpcabal08-0.1.0.0... Building library 'q' instantiated with A = B = -for bkpcabal08-0.1.0.0.. +for bkpcabal08-0.1.0.0... [2 of 4] Compiling B[sig] ( q/B.hsig, nothing ) [3 of 4] Compiling M ( q/M.hs, nothing ) [A changed] -[4 of 4] Instantiating bkpcabal08-0.1.0.0-EyPgBicvfbiC7dE1n4Leie-p -Preprocessing library 'impl' for bkpcabal08-0.1.0.0.. -Building library 'impl' for bkpcabal08-0.1.0.0.. -Preprocessing library 'q' for bkpcabal08-0.1.0.0.. +[4 of 4] Instantiating bkpcabal08-0.1.0.0-5O1mUtZZLBeDZEqqtwJcCj-p +Preprocessing library 'q' for bkpcabal08-0.1.0.0... Building library 'q' instantiated with - A = bkpcabal08-0.1.0.0-7fVENJzzGcJGpTFnmRtPuV-impl:A - B = bkpcabal08-0.1.0.0-7fVENJzzGcJGpTFnmRtPuV-impl:B -for bkpcabal08-0.1.0.0.. -[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-ECOfUnn43H71QBN16LasXC-q+GMGlyMx4Le5H1wfFVpXzYJ/A.o ) [Prelude package changed] -[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-ECOfUnn43H71QBN16LasXC-q+GMGlyMx4Le5H1wfFVpXzYJ/B.o ) [Prelude package changed] -Preprocessing library 'r' for bkpcabal08-0.1.0.0.. -Building library 'r' for bkpcabal08-0.1.0.0.. + A = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:A + B = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:B +for bkpcabal08-0.1.0.0... +[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/A.o ) [Prelude package changed] +[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/B.o ) [Prelude package changed] +Preprocessing library 'r' for bkpcabal08-0.1.0.0... +Building library 'r' for bkpcabal08-0.1.0.0... ===================================== testsuite/tests/gadt/T19847a.stderr ===================================== @@ -9,4 +9,4 @@ DATA CONSTRUCTORS (x ~ y, c ~ [x], Ord x) => x -> y -> T (x, y) b c Dependent modules: [] -Dependent packages: [base-4.18.0.0] +Dependent packages: [base-4.19.0.0] ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4bf963f87b5d994b1ddc72ee4bd2bd968637e2de +Subproject commit 7df029a19f38234af266ab1183eee768ad2d8516 ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit f70b360b295298e4da10afe02ebf022b21342008 +Subproject commit 1ee25e923b769c8df310f7e8690ad7622eb4d446 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/afbdcbb75e2a6204f7266776617f89d65c3e9de1...d93c1d86a5290ebc408cf7beef7f08a225c9e4fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/afbdcbb75e2a6204f7266776617f89d65c3e9de1...d93c1d86a5290ebc408cf7beef7f08a225c9e4fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 00:11:55 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 20:11:55 -0400 Subject: [Git][ghc/ghc][ghc-9.8] Deleted 1 commit: Bump deepseq bound to allow 1.5 Message-ID: <64a7584be7a70_2c735eafca81563b0@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: afbdcbb7 by Ben Gamari at 2023-07-01T17:47:10-04:00 Bump deepseq bound to allow 1.5 - - - - - 12 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/containers - libraries/deepseq - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghci/ghci.cabal.in - libraries/hpc - libraries/process - libraries/text - utils/hpc - utils/iserv/iserv.cabal.in Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -95,7 +95,7 @@ Library CPP-Options: -DHAVE_LIBZSTD Build-Depends: base >= 4.11 && < 4.19, - deepseq >= 1.4 && < 1.5, + deepseq >= 1.4 && < 1.6, directory >= 1 && < 1.4, process >= 1 && < 1.7, bytestring >= 0.9 && < 0.12, ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -56,7 +56,7 @@ Executable ghc if flag(internal-interpreter) -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: - deepseq == 1.4.*, + deepseq >= 1.4 && < 1.6, ghc-prim >= 0.5.0 && < 0.11, ghci == @ProjectVersionMunged@, haskeline == 0.8.*, ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit e71f6f263aa4d7ce7a145eb5ac417f2f580f2288 +Subproject commit 75e340ceb9beaea9dfc4347684519b0ca3d6a8f8 ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd +Subproject commit 8663795322622ac77cc78566185bffbc84e299f2 ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit 0bfe57809f8ecaf1921b82a6791d1ecc317d1998 +Subproject commit eb1eff5236d2a38e10f49e12301daa52ad20915b ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -76,7 +76,7 @@ Library containers >= 0.5 && < 0.7, directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, - deepseq >= 1.4 && < 1.5, + deepseq >= 1.4 && < 1.6, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -80,7 +80,7 @@ library binary == 0.8.*, bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, - deepseq == 1.4.*, + deepseq >= 1.4 && < 1.6, filepath == 1.4.*, ghc-boot == @ProjectVersionMunged@, ghc-heap == @ProjectVersionMunged@, ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit efd3826085953f618a1626b6c701c0314ba8b9bc +Subproject commit 50d520bf6002ab55032e233dced0556ad63ad0c0 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 6092a13f6bf2ef76105683c7f9e278c0dcadceec +Subproject commit 4fb076dc1f8fe5ccc6dfab041bd5e621aa9e8e2c ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit deaaef6216d3df524f8b998c54b317478094473c ===================================== utils/hpc ===================================== @@ -1 +1 @@ -Subproject commit b376045cb3f3d28815ca29d9c07df2e843cec1c3 +Subproject commit eb800fe76409f54660335496592f777ae215ff92 ===================================== utils/iserv/iserv.cabal.in ===================================== @@ -35,7 +35,7 @@ Executable iserv binary >= 0.7 && < 0.11, bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, - deepseq >= 1.4 && < 1.5, + deepseq >= 1.4 && < 1.6, ghci == @ProjectVersionMunged@ if os(windows) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afbdcbb75e2a6204f7266776617f89d65c3e9de1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afbdcbb75e2a6204f7266776617f89d65c3e9de1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 00:12:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 20:12:18 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 8 commits: Add support for deprecating exported items (proposal #134) Message-ID: <64a758628b526_2c735eaed941567e6@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - afbdcbb7 by Ben Gamari at 2023-07-01T17:47:10-04:00 Bump deepseq bound to allow 1.5 - - - - - b66c4692 by Ben Gamari at 2023-07-05T09:26:15-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 692afb12 by Ben Gamari at 2023-07-05T09:26:32-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - 39706ce9 by Ben Gamari at 2023-07-06T20:08:18-04:00 template-haskell: Bump version to 2.21.0.0 - - - - - 5a35933b by Matthew Pickering at 2023-07-06T20:08:19-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 (cherry picked from commit 6295416ba0bc3e729b1f3dea56ef5d722f98ee9d) - - - - - d7ed0ae9 by Matthew Pickering at 2023-07-06T20:08:19-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 (cherry picked from commit 75b8b39a860a643b78405787bac582ba7cc3cb21) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - compiler/GHC.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModIface.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4162591821d661929db3d54d119b2d4ca15e834...d7ed0ae9f41153f8a1158f64c14f29f49fb4ac02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c4162591821d661929db3d54d119b2d4ca15e834...d7ed0ae9f41153f8a1158f64c14f29f49fb4ac02 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 02:57:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 06 Jul 2023 22:57:46 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch` Message-ID: <64a77f2a32944_2c735eafc94169592@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: 30643a1b by Ben Gamari at 2023-07-06T22:57:34-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 23 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - + compiler/GHC/Utils/Touch.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Settings/Default.hs - libraries/unix - m4/fp_settings.m4 - − utils/touchy/Makefile - − utils/touchy/touchy.c - − utils/touchy/touchy.cabal Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -259,6 +259,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Utils.Touch import qualified GHC.LanguageExtensions as LangExt @@ -269,7 +270,6 @@ import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) import GHC.Data.Maybe -import qualified GHC.SysTools import GHC.SysTools (initSysTools) import GHC.SysTools.BaseDir (findTopDir) @@ -1262,7 +1262,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do -- .hie files. let hie_file = ml_hie_file mod_location whenM (doesFileExist hie_file) $ - GHC.SysTools.touch logger dflags "Touching hie file" hie_file + GHC.Utils.Touch.touch hie_file else -- See Note [Strictness in ModIface] forceModIface iface ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -72,6 +72,7 @@ import System.IO import GHC.Linker.ExtraObj import GHC.Linker.Dynamic import GHC.Utils.Panic +import GHC.Utils.Touch import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder @@ -363,14 +364,10 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- | Run the JS Backend postHsc phase. runJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath -runJsPhase _pipe_env hsc_env _location input_fn = do - let dflags = hsc_dflags hsc_env - let logger = hsc_logger hsc_env - +runJsPhase _pipe_env _hsc_env _location input_fn = do -- The object file is already generated. We only touch it to ensure the -- timestamp is refreshed, see Note [JS Backend .o file procedure]. - touchObjectFile logger dflags input_fn - + touchObjectFile input_fn return input_fn -- | Deal with foreign JS files (embed them into .o files) @@ -552,7 +549,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - HsBootFile -> touchObjectFile logger dflags o_file + HsBootFile -> touchObjectFile o_file HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" -- MP: I wonder if there are any lurking bugs here because we @@ -1148,10 +1145,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do -touchObjectFile :: Logger -> DynFlags -> FilePath -> IO () -touchObjectFile logger dflags path = do +touchObjectFile :: FilePath -> IO () +touchObjectFile path = do createDirectoryIfMissing True $ takeDirectory path - GHC.SysTools.touch logger dflags "Touching object file" path + GHC.Utils.Touch.touch path -- Note [-fPIC for assembler] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_l, sPgm_lm, sPgm_dll, - sPgm_T, sPgm_windres, sPgm_ar, sPgm_ranlib, @@ -137,7 +136,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_dll, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags -pgm_T :: DynFlags -> String -pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Settings , sPgm_l , sPgm_lm , sPgm_dll - , sPgm_T , sPgm_windres , sPgm_ar , sPgm_otool @@ -111,7 +110,6 @@ data ToolSettings = ToolSettings -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String , toolSettings_pgm_otool :: String @@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings sPgm_dll :: Settings -> (String, [Option]) sPgm_dll = toolSettings_pgm_dll . sToolSettings -sPgm_T :: Settings -> String -sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String sPgm_windres = toolSettings_pgm_windres . sToolSettings sPgm_ar :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -125,8 +125,6 @@ initSettings top_dir = do install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" - touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -191,7 +189,6 @@ initSettings top_dir = do , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) - , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path , toolSettings_pgm_otool = otool_path ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do mb_env <- getGccEnv cc_args runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env -touch :: Logger -> DynFlags -> String -> String -> IO () -touch logger dflags purpose arg = traceSystoolCommand logger "touch" $ - runSomething logger purpose (pgm_T dflags) [FileOption "" arg] ===================================== compiler/GHC/Utils/Touch.hs ===================================== @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} + +module GHC.Utils.Touch (touch) where + +import GHC.Prelude + +#if defined(mingw32_HOST_OS) +import System.Win32.File +import System.Win32.Time +#else +import System.Posix.Files +import System.Posix.IO +#endif + +-- | Set the mtime of the given file to the current time. +touch :: FilePath -> IO () +touch file = do +#if defined(mingw32_HOST_OS) + hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing + t <- getSystemTimeAsFileTime + setFileTime hdl Nothing Nothing (Just t) + closeHandle hdl +#else +#if MIN_VERSION_unix(2,8,0) + let oflags = defaultFileFlags { noctty = True, creat = Just 0o666 } + fd <- openFd file WriteOnly oflags +#else + let oflags = defaultFileFlags { noctty = True } + fd <- openFd file WriteOnly (Just 0o666) oflags +#endif + touchFd fd + closeFd fd +#endif + ===================================== compiler/ghc.cabal.in ===================================== @@ -902,6 +902,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== hadrian/bindist/Makefile ===================================== @@ -102,7 +102,6 @@ lib/settings : config.mk @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsTouchCommand = @SettingsTouchCommand@ SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ -settings-touch-command = @SettingsTouchCommand@ settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -236,7 +236,6 @@ instance H.Builder Builder where pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the @@ -245,7 +244,6 @@ instance H.Builder Builder where return $ [ unlitPath ] ++ ghcdeps - ++ [ touchyPath | windowsHost ] ++ [ root -/- mingwStamp | windowsHost ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -49,8 +49,8 @@ class ShakeValue b => Builder b where -- capture the @stdout@ result and return it. askBuilderWith :: b -> BuildInfo -> Action String - -- | Runtime dependencies of a builder. For example, on Windows GHC requires - -- the utility @touchy.exe@ to be available on a specific path. + -- | Runtime dependencies of a builder. For example, GHC requires the + -- utility @unlit@ to be available on a specific path. runtimeDependencies :: b -> Action [FilePath] runtimeDependencies _ = return [] ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -125,7 +125,6 @@ data SettingsFileSetting | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand @@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -40,7 +40,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, - terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, + terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package @@ -117,7 +117,6 @@ terminfo = lib "terminfo" text = lib "text" time = lib "time" timeout = util "timeout" `setPath` "testsuite/timeout" -touchy = util "touchy" transformers = lib "transformers" unlit = util "unlit" unix = lib "unix" @@ -192,12 +191,12 @@ programName Context {..} = do -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context at Context {..} = do - -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of - -- @bin@, which is likely just a historical accident that should be fixed. - -- See: https://github.com/snowleopard/hadrian/issues/570 - -- Likewise for @iserv@ and @unlit at . + -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory + -- instead of @bin@, which is likely just a historical accident that should + -- be fixed. See: + -- https://github.com/snowleopard/hadrian/issues/570 name <- programName context - path <- if package `elem` [iserv, touchy, unlit] + path <- if package `elem` [iserv, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage return $ path -/- name <.> exe @@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) -- TODO: Combine this with 'programName'. -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -461,7 +461,6 @@ generateSettings = do , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do (True, s) | s > stage0InTree -> do srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -105,7 +105,6 @@ stage0Packages = do ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] - ++ [ touchy | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] @@ -155,9 +154,8 @@ stage1Packages = do , runGhc ] , when (winTarget && not cross) - [ touchy - -- See Note [Hadrian's ghci-wrapper package] - , ghciWrapper + [ -- See Note [Hadrian's ghci-wrapper package] + ghciWrapper ] ] ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit 720debbf5b89366007bac473e8d7fd18e4114f1a +Subproject commit 203db4f8058b3cd9bfa5c1217b2e06ecb9daf392 ===================================== m4/fp_settings.m4 ===================================== @@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS], SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' else # This case handles the "normal" platforms (e.g. not Windows) where we @@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="$WindresCmd" fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi - if test "$EnableDistroToolchain" = "YES"; then # If the user specified --enable-distro-toolchain then we just use the # executable names, not paths. @@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) ===================================== utils/touchy/Makefile deleted ===================================== @@ -1,37 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -# -# Substitute for 'touch' on win32 platforms (without an Unix toolset installed). -# -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=touchy.c -C_PROG=touchy -SRC_CC_OPTS += -O - -# -# Install touchy in lib/.* -# -INSTALL_LIBEXECS += $(C_PROG) - -include $(TOP)/mk/target.mk - -# Get it over with! -boot :: all - -binary-dist: - $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy - $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/ - $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/ - ===================================== utils/touchy/touchy.c deleted ===================================== @@ -1,123 +0,0 @@ -/* - * Simple 'touch' program for Windows - * - */ -#if !defined(_WIN32) -#error "Win32-only, the platform you're using is supposed to have 'touch' already." -#else -#include -#include -#include -#include -#include -#include -#include - -/* -touch is used by GHC both during building and during compilation of -Haskell files. Unfortunately this means we need a 'touch' like program -in the GHC bindist. Since touch is not standard on Windows and msys2 -doesn't include a mingw-w64 build of coreutils we need touchy for now. - -With Windows 7 in a virtual box VM on OS X, some very odd things happen -with dates and time stamps when SSHing into cygwin. e.g. here the -"Change" time is in the past: - -$ date; touch foo; stat foo -Fri Dec 2 16:58:07 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:58:07.414457900 +0000 -Modify: 2011-12-02 16:58:07.414457900 +0000 -Change: 2011-12-02 16:58:03.495141800 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - -And if we copy such a file, then the copy is older (as determined by the -"Modify" time) than the original: - -$ date; touch foo; stat foo; cp foo bar; stat bar -Fri Dec 2 16:59:10 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:10.118457900 +0000 -Modify: 2011-12-02 16:59:10.118457900 +0000 -Change: 2011-12-02 16:59:06.189477700 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - File: `bar' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:06.394555800 +0000 -Modify: 2011-12-02 16:59:06.394555800 +0000 -Change: 2011-12-02 16:59:06.395532400 +0000 - Birth: 2011-12-02 16:58:40.921899600 +0000 - -This means that make thinks that things are out of date when it -shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS -infinite-recursion test triggers. - -The touchy program, like most other programs, creates files with both -Modify and Change in the past, which is still a little odd, but is -consistent, so doesn't break make. - -We used to use _utime(argv[i],NULL)) to set the file modification times, -but after a BST -> GMT change this started giving files a modification -time an hour in the future: - -$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile -Tue, Oct 30, 2012 11:33:06 PM - File: `testfile' - Size: 0 Blocks: 0 IO Block: 65536 regular empty file -Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1 -Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2012-10-31 00:33:06.000000000 +0000 -Modify: 2012-10-31 00:33:06.000000000 +0000 -Change: 2012-10-30 23:33:06.769118900 +0000 - Birth: 2012-10-30 23:33:06.769118900 +0000 - -so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime. -*/ - -int -main(int argc, char** argv) -{ - int i; - FILETIME ft; - BOOL b; - HANDLE hFile; - - if (argc == 1) { - fprintf(stderr, "Usage: %s \n", argv[0]); - return 1; - } - - for (i = 1; i < argc; i++) { - hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, - FILE_ATTRIBUTE_NORMAL, NULL); - if (hFile == INVALID_HANDLE_VALUE) { - fprintf(stderr, "Unable to open %s\n", argv[i]); - exit(1); - } - GetSystemTimeAsFileTime(&ft); - b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft); - if (b == 0) { - fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]); - exit(1); - } - b = CloseHandle(hFile); - if (b == 0) { - fprintf(stderr, "Closing failed for %s\n", argv[i]); - exit(1); - } - } - - return 0; -} -#endif ===================================== utils/touchy/touchy.cabal deleted ===================================== @@ -1,15 +0,0 @@ -cabal-version: 2.2 -Name: touchy -Version: 0.1 -Copyright: XXX -License: BSD-3-Clause -Author: XXX -Maintainer: XXX -Synopsis: @touch@ for windows -Description: XXX -Category: Development -build-type: Simple - -Executable touchy - Default-Language: Haskell2010 - Main-Is: touchy.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30643a1b5c606232cec50af9aa784a27c745913e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30643a1b5c606232cec50af9aa784a27c745913e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 03:28:40 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Thu, 06 Jul 2023 23:28:40 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to enable/disable incoherent instances Message-ID: <64a78668de5e8_2c735eafcbc1716b5@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 0a7fcb54 by Gergő Érdi at 2023-07-07T04:26:18+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 24 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/Basic.hs - testsuite/tests/simplCore/should_run/T22448.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -11,7 +11,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv. module GHC.Core.InstEnv ( DFunId, InstMatch, ClsInstLookupResult, - Coherence(..), PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, + Canonical, PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst, @@ -122,10 +122,11 @@ fuzzyClsInstCmp x y = cmp (RM_KnownTc _, RM_WildCard) = GT cmp (RM_KnownTc x, RM_KnownTc y) = stableNameCmp x y -isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool +isOverlappable, isOverlapping, isIncoherent, isNonCanonical :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i)) isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i)) +isNonCanonical i = hasNonCanonicalFlag (overlapMode (is_flag i)) {- Note [ClsInst laziness and the rough-match fields] @@ -812,8 +813,33 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. But sometimes that is +fine, because the programmer promises that it doesn't matter which one is +chosen. A good example is in the `optics` library: + + data IxEq i is js where { IxEq :: IxEq i is is } + + class AppendIndices xs ys ks | xs ys -> ks where + appendIndices :: IxEq i (Curry xs (Curry ys i)) (Curry ks i) + + instance {-# INCOHERENT #-} xs ~ zs => AppendIndices xs '[] zs where + appendIndices = IxEq + + instance ys ~ zs => AppendIndices '[] ys zs where + appendIndices = IxEq + +Here `xs` and `ys` are type-level lists, and for type inference purposes we want to +solve the `AppendIndices` constraint when /either/ of them are the empty list. The +dictionaries are the same in both cases (indeed the dictionary type is a singleton!), +so we really don't care which is used. See #23287 for discussion. + +In short, sometimes we want to specialise on these incoherently-selected dictionaries, +and sometimes we don't. It would be best to have a per-instance pragma, but for now +we have a global flag. The flag `-fspecialise-incoherents` (on by default) enables +specialisation on incoherent evidence (as has been the case previously). +The rest of this note describes what happens with `-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -850,7 +876,7 @@ Here are the moving parts: * `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into (nospec f d) if `d` is incoherent. It has to do a dependency analysis to determine transitive dependencies, but we need to do that anyway. - See Note [Desugaring incoherent evidence] in GHC.HsToCore.Binds. + See Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds. See also Note [nospecId magic] in GHC.Types.Id.Make. -} @@ -955,10 +981,13 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +type Canonical = Bool -- See Note [Recording coherence information in `PotentialUnifiers`] -data PotentialUnifiers = NoUnifiers Coherence +data PotentialUnifiers = NoUnifiers Canonical + -- NoUnifiers True: We have a unique solution modulo canonicity + -- NoUnifiers False: The solutions is not canonical, and thus + -- we shouldn't specialise on it. | OneOrMoreUnifiers (NonEmpty ClsInst) -- This list is lazy as we only look at all the unifiers when -- printing an error message. It can be expensive to compute all @@ -972,28 +1001,19 @@ in `matchInstEnv`. According to Note [Rules for instance lookup] steps IL4 and IL6, we only care about non-`INCOHERENT` instances for this purpose. -It is only when we don't have any potential unifiers (i.e. we know -that we have a unique solution modulo `INCOHERENT` instances) that we -care about that unique solution being coherent or not (see -Note [Coherence and specialisation: overview] for why we care at all). -So we only need the `Coherent` flag in the case where the set of -potential unifiers is otherwise empty. +If we don't have any potential unifiers (i.e. we know that we have a +unique solution modulo `INCOHERENT` instances), we need to know if +that unique solution is canonical or not (see Note [Coherence and +specialisation: overview] for why we care at all). So when the set of +potential unifiers is empty, we record if it's `Canonical`. -} -instance Outputable Coherence where - ppr IsCoherent = text "coherent" - ppr IsIncoherent = text "incoherent" - instance Outputable PotentialUnifiers where - ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c + ppr (NoUnifiers c) = text "NoUnifiers" <+> if c then text "canonical" else text "non-canonical" ppr xs = ppr (getPotentialUnifiers xs) -instance Semigroup Coherence where - IsCoherent <> IsCoherent = IsCoherent - _ <> _ = IsIncoherent - instance Semigroup PotentialUnifiers where - NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 <> c2) + NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 && c2) NoUnifiers _ <> u = u OneOrMoreUnifiers (unifier :| unifiers) <> u = OneOrMoreUnifiers (unifier :| (unifiers <> getPotentialUnifiers u)) @@ -1039,22 +1059,24 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys = acc - incoherently_matched :: PotentialUnifiers -> PotentialUnifiers - incoherently_matched (NoUnifiers _) = NoUnifiers IsIncoherent - incoherently_matched u = u + noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers + noncanonically_matched (NoUnifiers _) = NoUnifiers False + noncanonically_matched u = u check_unifier :: [ClsInst] -> PotentialUnifiers - check_unifier [] = NoUnifiers IsCoherent + check_unifier [] = NoUnifiers True check_unifier (item at ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items) | not (instIsVisible vis_mods item) = check_unifier items -- See Note [Instance lookup and orphan instances] | Just {} <- tcMatchTys tpl_tys tys = check_unifier items -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] + -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview] + | isNonCanonical item + = noncanonically_matched $ check_unifier items -- Ignore ones that are incoherent: Note [Incoherent instances] - -- Record that we encountered incoherent instances: Note [Coherence and specialisation: overview] | isIncoherent item - = incoherently_matched $ check_unifier items + = check_unifier items | otherwise = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set) @@ -1111,7 +1133,7 @@ lookupInstEnv check_overlap_safe -- If the selected match is incoherent, discard all unifiers final_unifs = case final_matches of - (m:_) | isIncoherent (fst m) -> NoUnifiers IsCoherent + (m:_) | isIncoherent (fst m) -> NoUnifiers True _ -> all_unifs -- Note [Safe Haskell isSafeOverlap] @@ -1289,7 +1311,7 @@ noMatches = InstMatches { instMatches = [], instGuards = [] } pruneOverlappedMatches :: [InstMatch] -> [InstMatch] -- ^ Remove from the argument list any InstMatches for which another -- element of the list is more specific, and overlaps it, using the --- rules of Nove [Rules for instance lookup] +-- rules of Note [Rules for instance lookup] pruneOverlappedMatches all_matches = instMatches $ foldr insert_overlapping noMatches all_matches ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -911,6 +911,7 @@ ppOverlapPragma mb = 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 where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Hs -- lots of things import GHC.Core -- lots of things import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Core.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( etaExpand ) @@ -1152,14 +1152,14 @@ evidence that is used in `e`. This question arose when thinking about deep subsumption; see https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649). -Note [Desugaring incoherent evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the evidence is coherent, we desugar WpEvApp by simply passing +Note [Desugaring non-canonical evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the evidence is canonical, we desugar WpEvApp by simply passing core_tm directly to k: k core_tm -If the evidence is not coherent, we mark the application with nospec: +If the evidence is not canonical, we mark the application with nospec: nospec @(cls => a) k core_tm @@ -1170,14 +1170,14 @@ of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). See Note [Coherence and specialisation: overview] for why we shouldn't specialise incoherent evidence. -We can find out if a given evidence is coherent or not during the -desugaring of its WpLet wrapper: an evidence is incoherent if its +We can find out if a given evidence is canonical or not during the +desugaring of its WpLet wrapper: an evidence is non-canonical if its own resolution was incoherent (see Note [Incoherent instances]), or -if its definition refers to other incoherent evidence. dsEvBinds is +if its definition refers to other non-canonical evidence. dsEvBinds is the convenient place to compute this, since it already needs to do inter-evidence dependency analysis to generate well-scoped -bindings. We then record this coherence information in the -dsl_coherence field of DsM's local environment. +bindings. We then record this specialisability information in the +dsl_unspecables field of DsM's local environment. -} @@ -1201,20 +1201,27 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring non-canonical evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } +-- We are about to construct an evidence application `f dict`. If the dictionary is +-- non-specialisable, instead construct +-- nospec f dict +-- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1232,7 +1239,7 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- * Desugars the ev_binds, sorts them into dependency order, and -- passes the resulting [CoreBind] to thing_inside --- * Extends the DsM (dsl_coherence field) with coherence information +-- * Extends the DsM (dsl_unspecable field) with specialisability information -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside @@ -1240,53 +1247,50 @@ dsEvBinds ev_binds thing_inside ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where - go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a + go ::[SCC (Node EvVar (Canonical, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False - - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where - ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + ((v, rhs), (this_canonical, deps)) = unpack_node node + transitively_unspecable = not this_canonical || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where - (pairs, direct_coherence) = unzip $ map unpack_node nodes + (pairs, direct_canonicity) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not this_canonical || any is_unspecable_remote deps | (this_canonical, deps) <- direct_canonicity ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring non-canonical evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty - unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) + unpack_node DigraphNode { node_key = v, node_payload = (canonical, rhs), node_dependencies = deps } = ((v, rhs), (canonical, deps)) -sort_ev_binds :: Bag (Id, Coherence, CoreExpr) -> [SCC (Node EvVar (Coherence, CoreExpr))] +sort_ev_binds :: Bag (Id, Canonical, CoreExpr) -> [SCC (Node EvVar (Canonical, CoreExpr))] -- We do SCC analysis of the evidence bindings, /after/ desugaring -- them. This is convenient: it means we can use the GHC.Core -- free-variable functions rather than having to do accurate free vars -- for EvTerm. sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges where - edges :: [ Node EvVar (Coherence, CoreExpr) ] + edges :: [ Node EvVar (Canonical, CoreExpr) ] edges = foldr ((:) . mk_node) [] ds_binds - mk_node :: (Id, Coherence, CoreExpr) -> Node EvVar (Coherence, CoreExpr) - mk_node (var, coherence, rhs) - = DigraphNode { node_payload = (coherence, rhs) + mk_node :: (Id, Canonical, CoreExpr) -> Node EvVar (Canonical, CoreExpr) + mk_node (var, canonical, rhs) + = DigraphNode { node_payload = (canonical, rhs) , node_key = var , node_dependencies = nonDetEltsUniqSet $ exprFreeVars rhs `unionVarSet` @@ -1295,13 +1299,13 @@ sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges -- is still deterministic even if the edges are in nondeterministic order -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. -dsEvBind :: EvBind -> DsM (Id, Coherence, CoreExpr) +dsEvBind :: EvBind -> DsM (Id, Canonical, CoreExpr) dsEvBind (EvBind { eb_lhs = v, eb_rhs = r, eb_info = info }) = do e <- dsEvTerm r - let coherence = case info of - EvBindGiven{} -> IsCoherent - EvBindWanted{ ebi_coherence = coherence } -> coherence - return (v, coherence, e) + let canonical = case info of + EvBindGiven{} -> True + EvBindWanted{ ebi_canonical = canonical } -> canonical + return (v, canonical, e) {-********************************************************************** ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -357,7 +357,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +413,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -2628,6 +2628,7 @@ repOverlap mb = Overlapping _ -> just =<< dataCon overlappingDataConName Overlaps _ -> just =<< dataCon overlapsDataConName Incoherent _ -> just =<< dataCon incoherentDataConName + NonCanonical _ -> just =<< dataCon incoherentDataConName where nothing = coreNothing overlapTyConName just = coreJust overlapTyConName ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -79,9 +79,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar - -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + , dsl_unspecables :: S.Set EvVar + -- ^ See Note [Desugaring non-canonical evidence]: this field collects + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1212,11 +1212,11 @@ addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty ; case dest of EvVarDest evar - -> addTcEvBind ev_binds_var $ mkWantedEvBind evar IsCoherent err_tm + -> addTcEvBind ev_binds_var $ mkWantedEvBind evar True err_tm HoleDest hole -> do { -- See Note [Deferred errors for coercion holes] let co_var = coHoleCoVar hole - ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var IsCoherent err_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var True err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2514,6 +2514,7 @@ reifyClassInstance is_poly_tvs i Overlapping _ -> Just TH.Overlapping Overlaps _ -> Just TH.Overlaps Incoherent _ -> Just TH.Incoherent + NonCanonical _ -> Just TH.Incoherent ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -92,7 +92,7 @@ data ClsInstResult | OneInst { cir_new_theta :: [TcPredType] , cir_mk_ev :: [EvExpr] -> EvTerm - , cir_coherence :: Coherence -- See Note [Coherence and specialisation: overview] + , cir_canonical :: Canonical -- See Note [Coherence and specialisation: overview] , cir_what :: InstanceWhat } | NotSure -- Multiple matches and/or one or more unifiers @@ -162,7 +162,7 @@ matchInstEnv dflags short_cut_solver clas tys ; return NoInstance } -- A single match (& no safe haskell failure) - ([(ispec, inst_tys)], NoUnifiers coherence, False) + ([(ispec, inst_tys)], NoUnifiers canonical, False) | short_cut_solver -- Called from the short-cut solver , isOverlappable ispec -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT @@ -175,12 +175,11 @@ matchInstEnv dflags short_cut_solver clas tys | otherwise -> do { let dfun_id = instanceDFunId ispec ; traceTc "matchClass success" $ - vcat [text "dict" <+> ppr pred, - ppr coherence, + vcat [text "dict" <+> ppr pred <+> parens (if canonical then text "canonical" else text "non-canonical"), text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ] -- Record that this dfun is needed - ; match_one (null unsafeOverlaps) coherence dfun_id inst_tys } + ; match_one (null unsafeOverlaps) canonical dfun_id inst_tys } -- More than one matches (or Safe Haskell fail!). Defer any -- reactions of a multitude until we learn more about the reagent @@ -191,15 +190,15 @@ matchInstEnv dflags short_cut_solver clas tys where pred = mkClassPred clas tys -match_one :: SafeOverlapping -> Coherence -> DFunId -> [DFunInstType] -> TcM ClsInstResult +match_one :: SafeOverlapping -> Canonical -> DFunId -> [DFunInstType] -> TcM ClsInstResult -- See Note [DFunInstType: instantiating types] in GHC.Core.InstEnv -match_one so coherence dfun_id mb_inst_tys +match_one so canonical dfun_id mb_inst_tys = do { traceTc "match_one" (ppr dfun_id $$ ppr mb_inst_tys) ; (tys, theta) <- instDFunType dfun_id mb_inst_tys ; traceTc "match_one 2" (ppr dfun_id $$ ppr tys $$ ppr theta) ; return $ OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = TopLevInstance { iw_dfun_id = dfun_id , iw_safe_over = so } } } @@ -235,7 +234,7 @@ matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys , cir_mk_ev = tuple_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! where @@ -399,7 +398,7 @@ makeLitDict clas ty et , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) = return $ OneInst { cir_new_theta = [] , cir_mk_ev = \_ -> ev_tm - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } | otherwise @@ -448,7 +447,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_canonical = False -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } @@ -555,7 +554,7 @@ Some further observations about `withDict`: k (sv |> (sub co2 ; sym co))) That is, we cast the method using a coercion, and apply k to - it. Moreover, we mark the evidence as incoherent, resulting in + it. Moreover, we mark the evidence as non-canonical, resulting in the use of the 'nospec' magicId (see Note [nospecId magic] in GHC.Types.Id.Make) to ensure that the typeclass specialiser doesn't incorrectly common-up distinct evidence terms. This is @@ -641,7 +640,7 @@ doFunTy :: Class -> Type -> Mult -> Type -> Type -> TcM ClsInstResult doFunTy clas ty mult arg_ty ret_ty = return $ OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] @@ -658,7 +657,7 @@ doTyConApp clas ty tc kind_args | tyConIsTypeable tc = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) kind_args , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinTypeableInstance tc } | otherwise = return NoInstance @@ -690,7 +689,7 @@ doTyApp clas ty f tk | otherwise = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2) @@ -711,7 +710,7 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc mk_ev _ = panic "doTyLit" ; return (OneInst { cir_new_theta = [kc_pred] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) } {- Note [Typeable (T a b c)] @@ -946,7 +945,7 @@ matchHasField dflags short_cut clas tys ; keepAlive (greName gre) ; return OneInst { cir_new_theta = theta , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } } else matchInstEnv dflags short_cut clas tys } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -33,7 +33,6 @@ import GHC.Data.Bag import GHC.Core.Class import GHC.Core import GHC.Core.DataCon -import GHC.Core.InstEnv ( Coherence(IsCoherent) ) import GHC.Core.Make import GHC.Driver.DynFlags import GHC.Data.FastString @@ -612,7 +611,7 @@ solveImplicationUsingUnsatGiven go_simple ct = case ctEvidence ct of CtWanted { ctev_pred = pty, ctev_dest = dst } -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty - ; setWantedEvTerm dst IsCoherent $ EvExpr ev_expr } + ; setWantedEvTerm dst True $ EvExpr ev_expr } _ -> return () -- | Create an evidence expression for an arbitrary constraint using ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Hs.Type( HsIPName(..) ) import GHC.Core import GHC.Core.Type -import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) +import GHC.Core.InstEnv ( DFunInstType ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) @@ -184,7 +184,7 @@ solveCallStack ev ev_cs -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] = do { cs_tm <- evCallStack ev_cs ; let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) - ; setEvBindIfWanted ev IsCoherent ev_tm } + ; setEvBindIfWanted ev True ev_tm } {- Note [Shadowing of implicit parameters] @@ -394,7 +394,7 @@ solveEqualityDict ev cls tys ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ evDataConApp data_con tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } @@ -715,10 +715,10 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys -- the inert from the work-item or vice-versa. ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) - ; setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + ; setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) - ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) + ; setEvBindIfWanted ev_i True (ctEvTerm ev_w) ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } @@ -784,7 +784,7 @@ shortCutSolver dflags ev_w ev_i ; case inst_res of OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = what } | safeOverlap what , all isTyFamFree preds -- Note [Shortcut solving: type families] @@ -804,7 +804,7 @@ shortCutSolver dflags ev_w ev_i ; let ev_tm = mk_ev (map getEvExpr evc_vs) ev_binds' = extendEvBinds ev_binds $ - mkWantedEvBind (ctEvEvId ev) coherence ev_tm + mkWantedEvBind (ctEvEvId ev) canonical ev_tm ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ freshGoals evc_vs } @@ -847,7 +847,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls -- See Note [No Given/Given fundeps] | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached - = do { setEvBindIfWanted ev IsCoherent (ctEvTerm solved_ev) + = do { setEvBindIfWanted ev True (ctEvTerm solved_ev) ; stopWith ev "Dict/Top (cached)" } | otherwise -- Wanted, but not cached @@ -869,14 +869,14 @@ chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev - , cir_coherence = coherence }) + , cir_canonical = canonical }) = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) (ppr work_item) ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta - ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; setEvBindIfWanted work_item canonical (mk_ev (map getEvExpr evc_vars)) ; emitWorkNC (freshGoals evc_vars) ; stopWith work_item "Dict/Top (solved wanted)" } where @@ -1070,7 +1070,7 @@ matchLocalInst pred loc -> do { let result = OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = LocalInstance } ; traceTcS "Best local instance found:" $ vcat [ text "pred:" <+> ppr pred @@ -1317,7 +1317,7 @@ last_resort inerts (DictCt { di_ev = ev_w, di_cls = cls, di_tys = xis }) , Just ct_i <- lookupInertDict inerts loc_w cls xis , let ev_i = dictCtEvidence ct_i , isGiven ev_i - = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + = do { setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ TcRnLoopySuperclassSolve loc_w (ctEvPred ev_w) ; return $ Stop ev_w (text "Loopy superclass") } @@ -2158,4 +2158,3 @@ constraints. See also Note [Evidence for quantified constraints] in GHC.Core.Predicate. -} - ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -32,7 +32,6 @@ import GHC.Core.Coercion import GHC.Core.Coercion.Axiom import GHC.Core.Reduction import GHC.Core.Unify( tcUnifyTyWithTFs ) -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.FamInstEnv ( FamInstEnvs, FamInst(..), apartnessCheck , lookupFamInstEnvByTyCon ) import GHC.Core @@ -357,7 +356,7 @@ can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ -- Literals can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ | l1 == l2 - = do { setEvBindIfWanted ev IsCoherent (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) + = do { setEvBindIfWanted ev True (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } -- Decompose FunTy: (s -> t) and (c => t) @@ -1847,7 +1846,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Provide Refl evidence for the constraint -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted new_ev IsCoherent $ + ; setEvBindIfWanted new_ev True $ evCoercion (mkNomReflCo final_rhs) -- Kick out any constraints that can now be rewritten @@ -1958,7 +1957,7 @@ canEqReflexive :: CtEvidence -- ty ~ ty -> TcType -- ty -> TcS (StopOrContinue a) -- always Stop canEqReflexive ev eq_rel ty - = do { setEvBindIfWanted ev IsCoherent $ + = do { setEvBindIfWanted ev True $ evCoercion (mkReflCo (eqRelRole eq_rel) ty) ; stopWith ev "Solved by reflexivity" } @@ -2541,7 +2540,7 @@ tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item - -> do { setEvBindIfWanted ev IsCoherent $ + -> do { setEvBindIfWanted ev True $ evCoercion (maybeSymCo swapped $ downgradeRole (eqRelRole eq_rel) (ctEvRole ev_i) @@ -3188,4 +3187,4 @@ To avoid this situation we do not cache as solved any workitems (or inert) which did not really made a 'step' towards proving some goal. Solved's are just an optimization so we don't lose anything in terms of completeness of solving. --} \ No newline at end of file +-} ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -15,7 +15,6 @@ import GHC.Tc.Solver.Monad import GHC.Tc.Types.Evidence import GHC.Core.Coercion -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Types.Basic( SwapFlag(..) ) @@ -74,9 +73,9 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) + KeepInert -> do { setEvBindIfWanted ev_w True (swap_me swap ev_i) ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } - KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) + KeepWork -> do { setEvBindIfWanted ev_i True (swap_me swap ev_w) ; updInertCans (updIrreds (\_ -> others)) ; continueWith () } } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1688,19 +1688,19 @@ setWantedEq (HoleDest hole) co setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) -- | Good for both equalities and non-equalities -setWantedEvTerm :: TcEvDest -> Coherence -> EvTerm -> TcS () -setWantedEvTerm (HoleDest hole) _coherence tm +setWantedEvTerm :: TcEvDest -> Canonical -> EvTerm -> TcS () +setWantedEvTerm (HoleDest hole) _canonical tm | Just co <- evTermCoercion_maybe tm = do { useVars (coVarsOfCo co) ; fillCoercionHole hole co } | otherwise = -- See Note [Yukky eq_sel for a HoleDest] do { let co_var = coHoleCoVar hole - ; setEvBind (mkWantedEvBind co_var IsCoherent tm) + ; setEvBind (mkWantedEvBind co_var True tm) ; fillCoercionHole hole (mkCoVarCo co_var) } -setWantedEvTerm (EvVarDest ev_id) coherence tm - = setEvBind (mkWantedEvBind ev_id coherence tm) +setWantedEvTerm (EvVarDest ev_id) canonical tm + = setEvBind (mkWantedEvBind ev_id canonical tm) {- Note [Yukky eq_sel for a HoleDest] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1726,10 +1726,10 @@ fillCoercionHole hole co = do { wrapTcS $ TcM.fillCoercionHole hole co ; kickOutAfterFillingCoercionHole hole } -setEvBindIfWanted :: CtEvidence -> Coherence -> EvTerm -> TcS () -setEvBindIfWanted ev coherence tm +setEvBindIfWanted :: CtEvidence -> Canonical -> EvTerm -> TcS () +setEvBindIfWanted ev canonical tm = case ev of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest coherence tm + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest canonical tm _ -> return () newTcEvBinds :: TcS EvBindsVar ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -20,7 +20,6 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate import GHC.Core.Reduction import GHC.Core.Coercion @@ -427,7 +426,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars , et_binds = ev_binds, et_body = w_id } @@ -556,7 +555,7 @@ finish_rewrite ev@(CtWanted { ctev_dest = dest (Reduction co new_pred) new_rewriters = do { mb_new_ev <- newWanted loc rewriters' new_pred ; massert (coercionRole co == ctEvRole ev) - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ mkEvCast (getEvExpr mb_new_ev) (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) ; case mb_new_ev of @@ -631,7 +630,7 @@ runTcPluginsWanted wc@(WC { wc_simple = simples1 }) where setEv :: (EvTerm,Ct) -> TcS () setEv (ev,ct) = case ctEvidence ct of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest IsCoherent ev -- TODO: plugins should be able to signal non-coherence + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest True ev -- TODO: plugins should be able to signal non-canonicity _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" -- | A pair of (given, wanted) constraints to pass to plugins ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1482,7 +1482,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_top_name <- newName (mkSuperDictAuxOcc n (getOccName cls)) ; sc_ev_id <- newEvVar sc_pred - ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id True sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred sc_top_id = mkLocalId sc_top_name ManyTy sc_top_ty export = ABE { abe_wrap = idHsWrapper ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Types.Basic import GHC.Core import GHC.Core.Class (Class, classSCSelId ) import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Utils.Misc import GHC.Utils.Panic @@ -451,7 +451,7 @@ instance Outputable EvBindMap where data EvBindInfo = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver } - | EvBindWanted { ebi_coherence :: Coherence -- See Note [Desugaring incoherent evidence] + | EvBindWanted { ebi_canonical :: Canonical -- See Note [Desugaring non-canonical evidence] } ----------------- @@ -465,7 +465,7 @@ data EvBind evBindVar :: EvBind -> EvVar evBindVar = eb_lhs -mkWantedEvBind :: EvVar -> Coherence -> EvTerm -> EvBind +mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind mkWantedEvBind ev c tm = EvBind { eb_info = EvBindWanted c, eb_lhs = ev, eb_rhs = tm } -- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, RecursiveDo #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -820,16 +821,31 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt LangExt.OverlappingInstances dflags - incoherent_ok = xopt LangExt.IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags + noncanonical_incoherence = not $ gopt Opt_SpecialiseIncoherents dflags + use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent NoSourceText) | overlap_ok = use (Overlaps NoSourceText) | otherwise = use (NoOverlap NoSourceText) - final_oflag = setOverlapModeMaybe default_oflag overlap_mode + oflag = setOverlapModeMaybe default_oflag overlap_mode + final_oflag = effective_oflag noncanonical_incoherence oflag ; return final_oflag } + where + effective_oflag noncanonical_incoherence oflag at OverlapFlag{ overlapMode = overlap_mode } + = oflag { overlapMode = effective_overlap_mode noncanonical_incoherence overlap_mode } + + -- The `-fspecialise-incoherents` flag controls the meaning of the + -- `Incoherent` overlap mode: as either an Incoherent overlap + -- flag, or a NonCanonical overlap flag. See Note [Coherence and specialisation: overview] + -- in GHC.Core.InstEnv for why we care about this distinction. + effective_overlap_mode noncanonical_incoherence = \case + Incoherent s | noncanonical_incoherence -> NonCanonical s + overlap_mode -> overlap_mode + tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, - hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, + hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag, Boxity(..), isBoxed, @@ -628,6 +628,7 @@ hasIncoherentFlag :: OverlapMode -> Bool hasIncoherentFlag mode = case mode of Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappableFlag :: OverlapMode -> Bool @@ -636,6 +637,7 @@ hasOverlappableFlag mode = Overlappable _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappingFlag :: OverlapMode -> Bool @@ -644,8 +646,14 @@ hasOverlappingFlag mode = Overlapping _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False +hasNonCanonicalFlag :: OverlapMode -> Bool +hasNonCanonicalFlag = \case + NonCanonical{} -> True + _ -> False + data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv = NoOverlap SourceText -- See Note [Pragma source text] @@ -700,6 +708,16 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv -- instantiating 'b' would change which instance -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv" + | NonCanonical SourceText + -- ^ Behave like Incoherent, but the instance choice is observable + -- by the program behaviour. See Note [Coherence and specialisation: overview]. + -- + -- We don't have surface syntax for the distinction between + -- Incoherent and NonCanonical instances; instead, the flag + -- `-f{no-}specialise-incoherents` (on by default) controls + -- whether `INCOHERENT` instances are regarded as Incoherent or + -- NonCanonical. + deriving (Eq, Data) @@ -712,6 +730,7 @@ instance Outputable OverlapMode where ppr (Overlapping _) = text "[overlapping]" ppr (Overlaps _) = text "[overlap ok]" ppr (Incoherent _) = text "[incoherent]" + ppr (NonCanonical _) = text "[noncanonical]" instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s @@ -719,6 +738,7 @@ instance Binary OverlapMode where put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s + put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s get bh = do h <- getByte bh case h of @@ -727,6 +747,7 @@ instance Binary OverlapMode where 2 -> (get bh) >>= \s -> return $ Incoherent s 3 -> (get bh) >>= \s -> return $ Overlapping s 4 -> (get bh) >>= \s -> return $ Overlappable s + 5 -> (get bh) >>= \s -> return $ NonCanonical s _ -> panic ("get OverlapMode" ++ show h) ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2081,6 +2081,11 @@ instance ExactPrint (LocatedP OverlapMode) where an1 <- markAnnCloseP an0 return (L (SrcSpanAnn an1 l) (Incoherent src)) + exact (L (SrcSpanAnn an l) (NonCanonical src)) = do + an0 <- markAnnOpenP an src "{-# INCOHERENT" + an1 <- markAnnCloseP an0 + return (L (SrcSpanAnn an1 l) (Incoherent src)) + -- --------------------------------------------------------------------- instance ExactPrint (HsBind GhcPs) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a7fcb545dc7923964d7527480565d8fbc04010a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a7fcb545dc7923964d7527480565d8fbc04010a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 04:06:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 00:06:01 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 6 commits: Bump deepseq bound to allow 1.5 Message-ID: <64a78f29fe3_2c735eafde817266d@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 1228d3a4 by Ben Gamari at 2023-07-06T20:16:06-04:00 Bump deepseq bound to allow 1.5 - - - - - d3ffdaf9 by Ben Gamari at 2023-07-06T20:21:22-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - bf57fc9a by Ben Gamari at 2023-07-06T21:50:24-04:00 template-haskell: Bump version to 2.21.0.0 - - - - - d4a87ca4 by Ben Gamari at 2023-07-06T23:10:02-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 1085d7e8 by Matthew Pickering at 2023-07-06T23:10:19-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 (cherry picked from commit 6295416ba0bc3e729b1f3dea56ef5d722f98ee9d) - - - - - 865b08e1 by Matthew Pickering at 2023-07-06T23:10:24-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 (cherry picked from commit 75b8b39a860a643b78405787bac582ba7cc3cb21) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - compiler/ghc.cabal.in - configure.ac - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/array - libraries/base/base.cabal - libraries/containers - libraries/deepseq - libraries/directory - libraries/exceptions - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/ghc-compact.cabal - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/hpc - libraries/parsec - libraries/process - libraries/semaphore-compat - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/text - libraries/unix - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout - testsuite/tests/gadt/T19847a.stderr - testsuite/tests/ghci/scripts/T21110.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7ed0ae9f41153f8a1158f64c14f29f49fb4ac02...865b08e13daba291b8d1f12aa6a39f83a0baad02 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7ed0ae9f41153f8a1158f64c14f29f49fb4ac02...865b08e13daba291b8d1f12aa6a39f83a0baad02 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 04:50:22 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Fri, 07 Jul 2023 00:50:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bump-bytestring-0.11.5.0 Message-ID: <64a7998e2733b_2c735eafc94179070@gitlab.mail> Matthew Craven pushed new branch wip/bump-bytestring-0.11.5.0 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bump-bytestring-0.11.5.0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 06:40:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 07 Jul 2023 02:40:05 -0400 Subject: [Git][ghc/ghc][master] 4 commits: JS: cleanup utils (#23314) Message-ID: <64a7b344f334b_2c735eafe10186745@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 10 changed files: - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -471,10 +471,6 @@ unboxJsArg arg Just arg3_tycon = maybe_arg3_tycon -boxJsResult :: Type - -> DsM (Type, CoreExpr -> CoreExpr) -boxJsResult result_ty - | isRuntimeRepKindedTy result_ty = panic "boxJsResult: runtime rep ty" -- fixme -- Takes the result of the user-level ccall: -- either (IO t), -- or maybe just t for an side-effect-free call @@ -485,7 +481,7 @@ boxJsResult result_ty -- where t' is the unwrapped form of t. If t is simply (), then -- the result type will be -- State# RealWorld -> (# State# RealWorld #) - +boxJsResult :: Type -> DsM (Type, CoreExpr -> CoreExpr) boxJsResult result_ty | Just (io_tycon, io_res_ty) <- tcSplitIOType_maybe result_ty -- isIOType_maybe handles the case where the type is a @@ -585,7 +581,6 @@ jsResultWrapper -- E.g. foreign import foo :: Int -> IO T -- Then resultWrapper deals with marshalling the 'T' part jsResultWrapper result_ty - | isRuntimeRepKindedTy result_ty = return (Nothing, id) -- fixme this seems like a hack -- Base case 1a: unboxed tuples | Just (tc, args) <- splitTyConApp_maybe result_ty , isUnboxedTupleTyCon tc {- && False -} = do ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -153,7 +153,7 @@ genApp ctx i args -- object representation -- - returns the object directly, otherwise | [] <- args - , [vt] <- idVt i + , [vt] <- idJSRep i , isUnboxable vt , ctxIsEvaluated ctx i = do ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -118,7 +118,7 @@ genStaticArg a = case a of Nothing -> reg Just expr -> unfloated expr where - r = uTypeVt . stgArgType $ a + r = unaryTypeJSRep . stgArgType $ a reg | isVoid r = return [] @@ -159,8 +159,8 @@ genArg a = case a of where -- if our argument is a joinid, it can be an unboxed tuple - r :: HasDebugCallStack => VarType - r = uTypeVt . stgArgType $ a + r :: HasDebugCallStack => JSRep + r = unaryTypeJSRep . stgArgType $ a unfloated :: HasDebugCallStack => CgStgExpr -> G [JExpr] unfloated = \case @@ -187,7 +187,7 @@ genIdArgI i | isMultiVar r = mapM (identForIdN i) [1..varSize r] | otherwise = (:[]) <$> identForId i where - r = uTypeVt . idType $ i + r = unaryTypeJSRep . idType $ i -- | Generate IDs for stack arguments. See 'StgToJS.Expr.loadRetArgs' for use case genIdStackArgI :: HasDebugCallStack => Id -> G [(Ident,StackSlot)] ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -77,8 +77,9 @@ setObjInfoL debug obj rs layout t n a CILayoutFixed sz _ -> sz field_types = case layout of CILayoutVariable -> [] - CILayoutUnknown size -> toTypeList (replicate size ObjV) - CILayoutFixed _ fs -> toTypeList fs + CILayoutUnknown size -> to_type_list (replicate size ObjV) + CILayoutFixed _ fs -> to_type_list fs + to_type_list = concatMap (\x -> replicate (varSize x) (fromEnum x)) setObjInfo :: Bool -- ^ debug: output all symbol names -> Ident -- ^ the thing to modify @@ -241,3 +242,4 @@ varName :: Int -> Ident varName i | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) | otherwise = varCache ! i + ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -304,7 +304,7 @@ genSetConInfo i d l {- srt -} = do emitClosureInfo $ ClosureInfo ei (CIRegs 0 [PtrV]) (mkFastString $ renderWithContext defaultSDocContext (ppr d)) - (fixedLayout $ map uTypeVt fields) + (fixedLayout $ map unaryTypeJSRep fields) (CICon $ dataConTag d) sr return (mkDataEntry ei) @@ -350,8 +350,8 @@ genToplevelRhs i rhs = case rhs of r <- updateThunk pure (StaticThunk (Just (eidt, map StaticObjArg lidents')), CIRegs 0 [PtrV],r) else return (StaticFun eidt (map StaticObjArg lidents'), - (if null lidents then CIRegs 1 (concatMap idVt args) - else CIRegs 0 (PtrV : concatMap idVt args)) + (if null lidents then CIRegs 1 (concatMap idJSRep args) + else CIRegs 0 (PtrV : concatMap idJSRep args)) , mempty) setcc <- ifProfiling $ if et == CIThunk @@ -360,7 +360,7 @@ genToplevelRhs i rhs = case rhs of emitClosureInfo (ClosureInfo eid regs idt - (fixedLayout $ map (uTypeVt . idType) lids) + (fixedLayout $ map (unaryTypeJSRep . idType) lids) et sr) ccId <- costCentreStackLbl cc ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -241,7 +241,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = let f = (bh <> lvs <> body) emitClosureInfo $ ClosureInfo ei - (CIRegs 0 $ concatMap idVt args) + (CIRegs 0 $ concatMap idJSRep args) (eii <> ", " <> mkFastString (renderWithContext defaultSDocContext (ppr i))) (fixedLayout . reverse $ map (stackSlotType . fst) (ctxLneFrameVars ctx)) @@ -275,9 +275,9 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) = else enterCostCentreFun cc sr <- genStaticRefsRhs rhs emitClosureInfo $ ClosureInfo ei - (CIRegs 0 $ PtrV : concatMap idVt args) + (CIRegs 0 $ PtrV : concatMap idJSRep args) (eii <> ", " <> mkFastString (renderWithContext defaultSDocContext (ppr i))) - (fixedLayout $ map (uTypeVt . idType) live) + (fixedLayout $ map (unaryTypeJSRep . idType) live) et sr emitToplevel (jFunction ei [] (mconcat [ll, llv, upd, setcc, body])) @@ -285,15 +285,12 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) = entryCtx = ctxSetTarget [] (ctxClearLneFrame ctx) -- | Generate the entry function types for identifiers. Note that this only --- returns either 'CIThunk' or 'CIFun'. Everything else (PAP Blackhole etc.) is --- filtered as not a RuntimeRepKinded type. +-- returns either 'CIThunk' or 'CIFun'. genEntryType :: HasDebugCallStack => [Id] -> G CIType genEntryType [] = return CIThunk -genEntryType args0 = do +genEntryType args = do args' <- mapM genIdArg args return $ CIFun (length args) (length $ concat args') - where - args = filter (not . isRuntimeRepKindedTy . idType) args0 -- | Generate the body of an object genBody :: HasDebugCallStack @@ -373,7 +370,7 @@ verifyRuntimeReps xs = do where verifyRuntimeRep i = do i' <- varsForId i - pure $ go i' (idVt i) + pure $ go i' (idJSRep i) go js (VoidV:vs) = go js vs go (j1:j2:js) (LongV:vs) = v "h$verify_rep_long" [j1,j2] <> go js vs go (j1:j2:js) (AddrV:vs) = v "h$verify_rep_addr" [j1,j2] <> go js vs @@ -491,11 +488,11 @@ optimizeFree -- -- Bool: True when the slot already contains a value optimizeFree offset ids = do -- this line goes wrong vvvvvvv - let -- ids' = concat $ map (\i -> map (i,) [1..varSize . uTypeVt . idType $ i]) ids + let -- ids' = concat $ map (\i -> map (i,) [1..varSize . unaryTypeJSRep . idType $ i]) ids idSize :: Id -> Int - idSize i = sum $ map varSize (typeVt . idType $ i) + idSize i = sum $ map varSize (typeJSRep . idType $ i) ids' = concatMap (\i -> map (i,) [1..idSize i]) ids - -- 1..varSize] . uTypeVt . idType $ i]) (typeVt ids) + -- 1..varSize] . unaryTypeJSRep . idType $ i]) (typeJSRep ids) l = length ids' slots <- drop offset . take l . (++repeat SlotUnknown) <$> getSlots let slm = M.fromList (zip slots [0..]) @@ -630,10 +627,10 @@ genRet ctx e at as l = freshIdent >>= f return (pushLne <> saveCCS <> pushRet) fst3 ~(x,_,_) = x - altRegs :: HasDebugCallStack => [VarType] + altRegs :: HasDebugCallStack => [JSRep] altRegs = case at of - PrimAlt ptc -> [primRepVt ptc] - MultiValAlt _n -> idVt e + PrimAlt ptc -> [primRepToJSRep ptc] + MultiValAlt _n -> idJSRep e _ -> [PtrV] -- special case for popping CCS but preserving stack size @@ -690,7 +687,7 @@ genAlts ctx e at me alts = do -> do ie <- varsForId e (r, bss) <- normalizeBranches ctx <$> - mapM (isolateSlots . mkPrimIfBranch ctx [primRepVt tc]) alts + mapM (isolateSlots . mkPrimIfBranch ctx [primRepToJSRep tc]) alts setSlots [] return (mkSw ie bss, r) @@ -877,7 +874,7 @@ mkAlgBranch top d alt -- | Generate a primitive If-expression mkPrimIfBranch :: ExprCtx - -> [VarType] + -> [JSRep] -> CgStgAlt -> G (Branch (Maybe [JExpr])) mkPrimIfBranch top _vt alt = ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -175,7 +175,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) where tycon = tyConAppTyCon (unwrapType arg_ty) arg_ty = stgArgType a - r = uTypeVt arg_ty + r = unaryTypeJSRep arg_ty saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -509,7 +509,7 @@ instance Binary JSFFIType where put_ bh = putEnum bh get bh = getEnum bh -instance Binary VarType where +instance Binary JSRep where put_ bh = putEnum bh get bh = getEnum bh ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -110,7 +110,7 @@ data ClosureInfo = ClosureInfo data CIRegs = CIRegsUnknown -- ^ A value witnessing a state of unknown registers | CIRegs { ciRegsSkip :: Int -- ^ unused registers before actual args start - , ciRegsTypes :: [VarType] -- ^ args + , ciRegsTypes :: [JSRep] -- ^ args } deriving stock (Eq, Ord, Show) @@ -122,7 +122,7 @@ data CILayout } | CILayoutFixed -- ^ whole layout known { layoutSize :: !Int -- ^ closure size in array positions, including entry - , layout :: [VarType] -- ^ The set of sized Types to layout + , layout :: [JSRep] -- ^ The list of JSReps to layout } deriving stock (Eq, Ord, Show) @@ -149,8 +149,8 @@ instance ToJExpr CIStatic where toJExpr (CIStaticRefs []) = null_ -- [je| null |] toJExpr (CIStaticRefs rs) = toJExpr (map TxtI rs) --- | Free variable types -data VarType +-- | JS primitive representations +data JSRep = PtrV -- ^ pointer = reference to heap object (closure object), lifted or not. -- Can also be some RTS object (e.g. TVar#, MVar#, MutVar#, Weak#) | VoidV -- ^ no fields @@ -162,7 +162,7 @@ data VarType | ArrV -- ^ boxed array deriving stock (Eq, Ord, Enum, Bounded, Show) -instance ToJExpr VarType where +instance ToJExpr JSRep where toJExpr = toJExpr . fromEnum -- | The type of identifiers. These determine the suffix of generated functions ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -2,76 +2,44 @@ {-# LANGUAGE LambdaCase #-} module GHC.StgToJS.Utils - ( assignToTypedExprs - , assignCoerce1 + ( assignCoerce1 , assignToExprCtx - -- * Core Utils + , fixedLayout + , assocIdExprs + -- * Unboxable datacon , isUnboxableCon , isUnboxable - , SlotCount(..) + , isBoolDataCon + -- * JSRep , slotCount , varSize - , varSlotCount , typeSize , isVoid - , isPtr - , isSingleVar , isMultiVar - , isMatchable - , tyConVt - , idVt - , typeVt - , uTypeVt - , primRepVt - , typePrimRep' - , tyConPrimRep' - , kindPrimRep' - , primTypeVt - , argVt - , dataConType - , isBoolDataCon - , fixedLayout + , idJSRep + , typeJSRep + , unaryTypeJSRep + , primRepToJSRep , stackSlotType - , idPrimReps - , typePrimReps , primRepSize - , assocPrimReps - , assocIdPrimReps - , assocIdExprs , mkArityTag - , toTypeList - -- * Stg Utils - , bindingRefs - , rhsRefs + -- * References and Ids , exprRefs - , altRefs - , argRefs , hasExport , collectTopIds , collectIds - , removeTick + -- * Live variables , LiveVars , liveStatic , liveVars - , stgTopBindLive - , stgBindLive - , stgBindRhsLive , stgRhsLive - , stgArgLive , stgExprLive - , stgAltLive - , stgLetNoEscapeLive - , bindees , isUpdatableRhs - , stgLneLive , stgLneLive' , stgLneLiveExpr , isInlineExpr - , inspectInlineBinding - , inspectInlineRhs - , isInlineForeignCall - , isInlineApp - ) where + ) +where import GHC.Prelude @@ -91,8 +59,6 @@ import GHC.Stg.Syntax import GHC.Tc.Utils.TcType -import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Builtin.Names import GHC.Builtin.PrimOps (PrimOp(SeqOp), primOpIsReallyInline) @@ -163,7 +129,7 @@ assignCoerce p1 p2 = assignTypedExprs [p1] [p2] isUnboxableCon :: DataCon -> Bool isUnboxableCon dc | [t] <- dataConRepArgTys dc - , [t1] <- typeVt (scaledThing t) + , [t1] <- typeJSRep (scaledThing t) = isUnboxable t1 && dataConTag dc == 1 && length (tyConDataCons $ dataConTyCon dc) == 1 @@ -171,7 +137,7 @@ isUnboxableCon dc -- | one-constructor types with one primitive field represented as a JS Number -- can be unboxed -isUnboxable :: VarType -> Bool +isUnboxable :: JSRep -> Bool isUnboxable DoubleV = True isUnboxable IntV = True -- includes Char# isUnboxable _ = False @@ -194,153 +160,56 @@ slotCount = \case TwoSlots -> 2 --- | Number of slots occupied by a value with the given VarType -varSize :: VarType -> Int -varSize = slotCount . varSlotCount +-- | Number of slots occupied by a value with the given JSRep +varSize :: JSRep -> Int +varSize = slotCount . jsRepSlots -varSlotCount :: VarType -> SlotCount -varSlotCount VoidV = NoSlot -varSlotCount LongV = TwoSlots -- hi, low -varSlotCount AddrV = TwoSlots -- obj/array, offset -varSlotCount _ = OneSlot +jsRepSlots :: JSRep -> SlotCount +jsRepSlots VoidV = NoSlot +jsRepSlots LongV = TwoSlots -- hi, low +jsRepSlots AddrV = TwoSlots -- obj/array, offset +jsRepSlots _ = OneSlot typeSize :: Type -> Int -typeSize t = sum . map varSize . typeVt $ t +typeSize t = sum . map varSize . typeJSRep $ t -isVoid :: VarType -> Bool +isVoid :: JSRep -> Bool isVoid VoidV = True isVoid _ = False -isPtr :: VarType -> Bool -isPtr PtrV = True -isPtr _ = False - -isSingleVar :: VarType -> Bool -isSingleVar v = varSlotCount v == OneSlot - -isMultiVar :: VarType -> Bool -isMultiVar v = case varSlotCount v of +isMultiVar :: JSRep -> Bool +isMultiVar v = case jsRepSlots v of NoSlot -> False OneSlot -> False TwoSlots -> True --- | can we pattern match on these values in a case? -isMatchable :: [VarType] -> Bool -isMatchable [DoubleV] = True -isMatchable [IntV] = True -isMatchable _ = False +idJSRep :: HasDebugCallStack => Id -> [JSRep] +idJSRep = typeJSRep . idType -tyConVt :: HasDebugCallStack => TyCon -> [VarType] -tyConVt = typeVt . mkTyConTy - -idVt :: HasDebugCallStack => Id -> [VarType] -idVt = typeVt . idType - -typeVt :: HasDebugCallStack => Type -> [VarType] -typeVt t | isRuntimeRepKindedTy t = [] -typeVt t = map primRepVt (typePrimRep t)-- map uTypeVt (repTypeArgs t) +typeJSRep :: HasDebugCallStack => Type -> [JSRep] +typeJSRep t = map primRepToJSRep (typePrimRep t) -- only use if you know it's not an unboxed tuple -uTypeVt :: HasDebugCallStack => UnaryType -> VarType -uTypeVt ut - | isRuntimeRepKindedTy ut = VoidV --- | isRuntimeRepTy ut = VoidV - -- GHC panics on this otherwise - | Just (tc, ty_args) <- splitTyConApp_maybe ut - , length ty_args /= tyConArity tc = PtrV - | isPrimitiveType ut = (primTypeVt ut) - | otherwise = - case typePrimRep' ut of - [] -> VoidV - [pt] -> primRepVt pt - _ -> pprPanic "uTypeVt: not unary" (ppr ut) - -primRepVt :: HasDebugCallStack => PrimRep -> VarType -primRepVt VoidRep = VoidV -primRepVt (BoxedRep _) = PtrV -- fixme does ByteArray# ever map to this? -primRepVt IntRep = IntV -primRepVt Int8Rep = IntV -primRepVt Int16Rep = IntV -primRepVt Int32Rep = IntV -primRepVt WordRep = IntV -primRepVt Word8Rep = IntV -primRepVt Word16Rep = IntV -primRepVt Word32Rep = IntV -primRepVt Int64Rep = LongV -primRepVt Word64Rep = LongV -primRepVt AddrRep = AddrV -primRepVt FloatRep = DoubleV -primRepVt DoubleRep = DoubleV -primRepVt (VecRep{}) = error "uTypeVt: vector types are unsupported" - -typePrimRep' :: HasDebugCallStack => UnaryType -> [PrimRep] -typePrimRep' ty = kindPrimRep' empty (typeKind ty) - --- | Find the primitive representation of a 'TyCon'. Defined here to --- avoid module loops. Call this only on unlifted tycons. -tyConPrimRep' :: HasDebugCallStack => TyCon -> [PrimRep] -tyConPrimRep' tc = kindPrimRep' empty res_kind - where - res_kind = tyConResKind tc - --- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's --- of values of types of this kind. -kindPrimRep' :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] -kindPrimRep' doc ki - | Just ki' <- coreView ki - = kindPrimRep' doc ki' -kindPrimRep' doc (TyConApp _typ [runtime_rep]) - = -- ASSERT( typ `hasKey` tYPETyConKey ) - runtimeRepPrimRep doc runtime_rep -kindPrimRep' doc ki - = pprPanic "kindPrimRep'" (ppr ki $$ doc) - -primTypeVt :: HasDebugCallStack => Type -> VarType -primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of - Nothing -> error "primTypeVt: not a TyCon" - Just tc - | tc == charPrimTyCon -> IntV - | tc == intPrimTyCon -> IntV - | tc == wordPrimTyCon -> IntV - | tc == floatPrimTyCon -> DoubleV - | tc == doublePrimTyCon -> DoubleV - | tc == int8PrimTyCon -> IntV - | tc == word8PrimTyCon -> IntV - | tc == int16PrimTyCon -> IntV - | tc == word16PrimTyCon -> IntV - | tc == int32PrimTyCon -> IntV - | tc == word32PrimTyCon -> IntV - | tc == int64PrimTyCon -> LongV - | tc == word64PrimTyCon -> LongV - | tc == addrPrimTyCon -> AddrV - | tc == stablePtrPrimTyCon -> AddrV - | tc == stableNamePrimTyCon -> PtrV - | tc == statePrimTyCon -> VoidV - | tc == proxyPrimTyCon -> VoidV - | tc == realWorldTyCon -> VoidV - | tc == threadIdPrimTyCon -> PtrV - | tc == weakPrimTyCon -> PtrV - | tc == arrayPrimTyCon -> ArrV - | tc == smallArrayPrimTyCon -> ArrV - | tc == byteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutableArrayPrimTyCon -> ArrV - | tc == smallMutableArrayPrimTyCon -> ArrV - | tc == mutableByteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutVarPrimTyCon -> PtrV - | tc == mVarPrimTyCon -> PtrV - | tc == tVarPrimTyCon -> PtrV - | tc == bcoPrimTyCon -> PtrV -- unsupported? - | tc == stackSnapshotPrimTyCon -> PtrV - | tc == ioPortPrimTyCon -> PtrV -- unsupported? - | tc == anyTyCon -> PtrV - | tc == compactPrimTyCon -> PtrV -- unsupported? - | tc == eqPrimTyCon -> VoidV -- coercion token? - | tc == eqReprPrimTyCon -> VoidV -- role - | tc == unboxedUnitTyCon -> VoidV -- Void# - | otherwise -> PtrV -- anything else must be some boxed thing - -argVt :: StgArg -> VarType -argVt a = uTypeVt . stgArgType $ a +unaryTypeJSRep :: HasDebugCallStack => UnaryType -> JSRep +unaryTypeJSRep ut = primRepToJSRep (typePrimRep1 ut) + +primRepToJSRep :: HasDebugCallStack => PrimRep -> JSRep +primRepToJSRep VoidRep = VoidV +primRepToJSRep (BoxedRep _) = PtrV +primRepToJSRep IntRep = IntV +primRepToJSRep Int8Rep = IntV +primRepToJSRep Int16Rep = IntV +primRepToJSRep Int32Rep = IntV +primRepToJSRep WordRep = IntV +primRepToJSRep Word8Rep = IntV +primRepToJSRep Word16Rep = IntV +primRepToJSRep Word32Rep = IntV +primRepToJSRep Int64Rep = LongV +primRepToJSRep Word64Rep = LongV +primRepToJSRep AddrRep = AddrV +primRepToJSRep FloatRep = DoubleV +primRepToJSRep DoubleRep = DoubleV +primRepToJSRep (VecRep{}) = error "primRepToJSRep: vector types are unsupported" dataConType :: DataCon -> Type dataConType dc = idType (dataConWrapId dc) @@ -350,16 +219,16 @@ isBoolDataCon dc = isBoolTy (dataConType dc) -- standard fixed layout: payload types -- payload starts at .d1 for heap objects, entry closest to Sp for stack frames -fixedLayout :: [VarType] -> CILayout +fixedLayout :: [JSRep] -> CILayout fixedLayout vts = CILayoutFixed (sum (map varSize vts)) vts -- 2-var values might have been moved around separately, use DoubleV as substitute -- ObjV is 1 var, so this is no problem for implicit metadata -stackSlotType :: Id -> VarType +stackSlotType :: Id -> JSRep stackSlotType i - | OneSlot <- varSlotCount otype = otype - | otherwise = DoubleV - where otype = uTypeVt (idType i) + | OneSlot <- jsRepSlots otype = otype + | otherwise = DoubleV + where otype = unaryTypeJSRep (idType i) idPrimReps :: Id -> [PrimRep] idPrimReps = typePrimReps . idType @@ -368,7 +237,7 @@ typePrimReps :: Type -> [PrimRep] typePrimReps = typePrimRep . unwrapType primRepSize :: PrimRep -> SlotCount -primRepSize p = varSlotCount (primRepVt p) +primRepSize p = jsRepSlots (primRepToJSRep p) -- | Associate the given values to each RrimRep in the given order, taking into -- account the number of slots per PrimRep @@ -393,9 +262,6 @@ assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) mkArityTag :: Int -> Int -> Int mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8) -toTypeList :: [VarType] -> [Int] -toTypeList = concatMap (\x -> replicate (varSize x) (fromEnum x)) - -------------------------------------------------------------------------------- -- Stg Utils -------------------------------------------------------------------------------- @@ -467,10 +333,6 @@ collectIds unfloated b = | Just m <- nameModule_maybe (getName i) = m == gHC_PRIM | otherwise = False -removeTick :: CgStgExpr -> CgStgExpr -removeTick (StgTick _ e) = e -removeTick e = e - ----------------------------------------------------- -- Live vars -- @@ -484,11 +346,6 @@ liveStatic = filterDVarSet isGlobalId liveVars :: LiveVars -> LiveVars liveVars = filterDVarSet (not . isGlobalId) -stgTopBindLive :: CgStgTopBinding -> [(Id, LiveVars)] -stgTopBindLive = \case - StgTopLifted b -> stgBindLive b - StgTopStringLit {} -> [] - stgBindLive :: CgStgBinding -> [(Id, LiveVars)] stgBindLive = \case StgNonRec b rhs -> [(b, stgRhsLive rhs)] @@ -529,9 +386,6 @@ stgAltLive :: CgStgAlt -> LiveVars stgAltLive alt = delDVarSetList (stgExprLive True (alt_rhs alt)) (alt_bndrs alt) -stgLetNoEscapeLive :: Bool -> StgBinding -> StgExpr -> LiveVars -stgLetNoEscapeLive _someBool _b _e = panic "stgLetNoEscapeLive" - bindees :: CgStgBinding -> [Id] bindees = \case StgNonRec b _e -> [b] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74a4dd2ec6e200b11a56b6f82907feb66e94c90b...d3de8668aea2209fefbfcf8704c38fe73300a99b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74a4dd2ec6e200b11a56b6f82907feb66e94c90b...d3de8668aea2209fefbfcf8704c38fe73300a99b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 06:40:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 07 Jul 2023 02:40:42 -0400 Subject: [Git][ghc/ghc][master] 2 commits: ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Message-ID: <64a7b36a83c3e_2c735eafcbc19327a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1044,7 +1044,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-windows-validate artifacts: false - - job: nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static + - job: nightly-x86_64-linux-alpine3_12-validate artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false @@ -1081,6 +1081,7 @@ ghcup-metadata-nightly-push: - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" - cp metadata_test.yaml "ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" + - cp metadata_test.yaml "ghcup-metadata/ghcup-nightlies-0.0.7.yaml" - cd ghcup-metadata - git config user.email "ghc-ci at gitlab-haskell.org" - git config user.name "GHC GitLab CI" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -989,7 +989,7 @@ platform_mapping :: Map String (JobGroup BindistInfo) platform_mapping = Map.map go $ Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ v j)), j) | j <- filter hasReleaseBuild job_groups ] where - whitelist = [ "x86_64-linux-alpine3_12-int_native-validate+fully_static" + whitelist = [ "x86_64-linux-alpine3_12-validate" , "x86_64-linux-deb10-validate" , "x86_64-linux-deb11-validate" , "x86_64-linux-fedora33-release" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3de8668aea2209fefbfcf8704c38fe73300a99b...e524fa7f67259a093aeb21aada139137626c581c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3de8668aea2209fefbfcf8704c38fe73300a99b...e524fa7f67259a093aeb21aada139137626c581c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 07:12:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 07 Jul 2023 03:12:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: JS: cleanup utils (#23314) Message-ID: <64a7baf359a73_2c735eafc941971de@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - 65936467 by Ben Gamari at 2023-07-07T03:12:00-04:00 Drop circle-ci-job.sh - - - - - bb2314ee by Ben Gamari at 2023-07-07T03:12:00-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 14e42417 by Ben Gamari at 2023-07-07T03:12:00-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - ba378f15 by Matthew Pickering at 2023-07-07T03:12:00-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 796a5c1f by Mike Pilgrem at 2023-07-07T03:12:06-04:00 Update Hadrian's stack.yaml - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - hadrian/stack.yaml - hadrian/stack.yaml.lock - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T23610.cmm - testsuite/tests/cmm/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1044,7 +1044,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-windows-validate artifacts: false - - job: nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static + - job: nightly-x86_64-linux-alpine3_12-validate artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false @@ -1081,6 +1081,7 @@ ghcup-metadata-nightly-push: - git clone https://gitlab.haskell.org/ghc/ghcup-metadata.git - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" - cp metadata_test.yaml "ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" + - cp metadata_test.yaml "ghcup-metadata/ghcup-nightlies-0.0.7.yaml" - cd ghcup-metadata - git config user.email "ghc-ci at gitlab-haskell.org" - git config user.name "GHC GitLab CI" ===================================== .gitlab/ci.sh ===================================== @@ -43,12 +43,13 @@ $0 - GHC continuous integration driver Common Modes: - usage Show this usage message. - setup Prepare environment for a build. - configure Run ./configure. - clean Clean the tree - shell Run an interactive shell with a configured build environment. - save_cache Preserve the cabal cache + usage Show this usage message. + setup Prepare environment for a build. + configure Run ./configure. + clean Clean the tree + shell Run an interactive shell with a configured build environment. + save_test_output Generate unexpected-test-output.tar.gz + save_cache Preserve the cabal cache Hadrian build system build_hadrian Build GHC via the Hadrian build system @@ -614,12 +615,16 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --docs=none \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "cross-compiled hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "cross-compiled hadrian main testsuite" elif [[ -n "${CROSS_TARGET:-}" ]] && [[ "${CROSS_TARGET:-}" == *"wasm"* ]]; then run_hadrian \ test \ --summary-junit=./junit.xml \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite targetting $CROSS_TARGET" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite targetting $CROSS_TARGET" elif [ -n "${CROSS_TARGET:-}" ]; then local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -635,7 +640,9 @@ function test_hadrian() { --test-compiler=stage-cabal \ --test-root-dirs=testsuite/tests/perf \ --test-root-dirs=testsuite/tests/typecheck \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian cabal-install test" else local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -673,12 +680,13 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { @@ -770,6 +778,10 @@ function run_abi_test() { check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes" } +function save_test_output() { + tar -czf unexpected-test-output.tar.gz unexpected-test-output +} + function save_cache () { info "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..." rm -Rf "$CABAL_CACHE" @@ -935,6 +947,7 @@ case ${1:-help} in lint_author) shift; lint_author "$@" ;; compare_interfaces_of) shift; compare_interfaces_of "$@" ;; clean) clean ;; + save_test_output) save_test_output ;; save_cache) save_cache ;; shell) shift; shell "$@" ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/circle-ci-job.sh deleted ===================================== @@ -1,110 +0,0 @@ -# Circle CI "backend" for Gitlab CI -# ================================= -# -# Usage example: -# .gitlab/circle-ci-job.sh validate-x86_64-linux -# -# There are two things to configure to get artifacts to be -# uploaded to gitlab properly: -# -# - At https:///admin/application_settings, expand the -# Continuous Integration and Deployment section and set the -# "Maximum artifacts size (MB)" field to something large enough -# to contain the bindists (the test reports are tiny in comparison). -# 500MB seems to work fine, but 200MB might be sufficient. -# -# - If gitlab is exposed behind some form of proxy (e.g nginx), make sure -# the maximum client request body size is large enough to contain all the -# artifacts of a build. For nginx, this would be the following configuration -# option: https://nginx.org/en/docs/http/ngx_http_core_module.html#client_max_body_size -# (which can be set with services.nginx.clientMaxBodySize on nixos). - -#!/usr/bin/env sh - -set -e - -GHCCI_URL="localhost:8888" - -[ $# -gt 0 ] || (echo You need to pass the Circle CI job type as argument to this script; exit 1) -[ ${CI_RUNNER_ID:-} ] || (echo "CI_RUNNER_ID is not set"; exit 1) -[ ${CI_JOB_ID:-} ] || (echo "CI_JOB_ID is not set"; exit 1) -[ ${CI_COMMIT_SHA:-} ] || (echo "CI_COMMIT_SHA is not set"; exit 1) -[ ${CI_REPOSITORY_URL:-} ] || (echo "CI_REPOSITORY_URL is not set"; exit 1) -[ ${CI_PIPELINE_ID:-} ] || (echo "CI_PIPELINE_ID is not set"; exit 1) -# the first argument to this script is the Circle CI job type: -# validate-x86_64-linux, validate-i386-linux, ... -CIRCLE_JOB="circleci-$1" - -gitlab_user=$(echo $CI_REPOSITORY_URL | cut -d/ -f4) -gitlab_repo=$(echo $CI_REPOSITORY_URL | cut -d/ -f5 | cut -d. -f1) - -BODY="{ \"jobType\": \"$CIRCLE_JOB\", \"source\": { \"user\": \"$gitlab_user\", \"project\":\"$gitlab_repo\", \"commit\":\"$CI_COMMIT_SHA\" }, \"pipelineID\": $CI_PIPELINE_ID, \"runnerID\": $CI_RUNNER_ID, \"jobID\": $CI_JOB_ID }" - - -RESP=$(curl -s -XPOST -H "Content-Type: application/json" -d "$BODY" \ - http://${GHCCI_URL}/job) - -if [ $? -eq 0 ]; then - build_num=$(echo $RESP | jq '.build_num') - circle_url=$(echo $RESP | jq '.url') -else - echo "Couldn't submit job" - echo $RESP - exit 1 -fi - -echo Circle CI build number: $build_num -echo Circle CI build page: $circle_url - -outcome="null" -STATUS_URL="http://${GHCCI_URL}/job/${build_num}" -STATUS_RESP="" - -while [ "$outcome" == "null" ]; do - sleep 30s - STATUS_RESP=$(curl -s $STATUS_URL) - if [ $? -eq 0 ]; then - new_outcome=$(echo $STATUS_RESP | jq '.outcome') - jq_exitcode=$? - if [ "$new_outcome" == "null" ] && [ $jq_exitcode -ne 0 ]; then - echo "Couldn't read 'outcome' field in JSON:" - echo $STATUS_RESP - echo "Skipping" - else - outcome="$new_outcome" - fi - else - echo "curl failed:" - echo $STATUS_RESP - echo "Skipping" - fi -done - -if [ "$outcome" == "\"success\"" ]; then - echo The build passed - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - exit 0 -else - echo The build failed - - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - - failing_step=$(echo $STATUS_RESP | jq '.steps | .[] | .actions | .[] | select(.status != "success")') - failing_step_name=$(echo $failing_step | jq '.name' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing step: $failing_step_name" - - failing_cmds=$(echo $failing_step | jq '.bash_command' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing command(s):" - echo $failing_cmds - - log_url=$(echo $failing_step | jq '.output_url' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Log url: $log_url" - - last_log_lines=$(curl -s $log_url | gunzip | jq '.[] | select(.type == "out") | .message' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/' | tail -50) - echo End of the build log: - echo $last_log_lines - - exit 1 -fi ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -680,10 +680,12 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAfterScript | Windows <- opsys = [ "bash .gitlab/ci.sh save_cache" + , "bash .gitlab/ci.sh save_test_output" , "bash .gitlab/ci.sh clean" ] | otherwise = [ ".gitlab/ci.sh save_cache" + , ".gitlab/ci.sh save_test_output" , ".gitlab/ci.sh clean" , "cat ci_timings" ] @@ -706,16 +708,19 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , if validateNonmovingGc buildConfig - then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" - else mempty + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } @@ -989,7 +994,7 @@ platform_mapping :: Map String (JobGroup BindistInfo) platform_mapping = Map.map go $ Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ v j)), j) | j <- filter hasReleaseBuild job_groups ] where - whitelist = [ "x86_64-linux-alpine3_12-int_native-validate+fully_static" + whitelist = [ "x86_64-linux-alpine3_12-validate" , "x86_64-linux-deb10-validate" , "x86_64-linux-deb11-validate" , "x86_64-linux-fedora33-release" ===================================== .gitlab/jobs.yaml ===================================== @@ -3,6 +3,7 @@ "aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -11,7 +12,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,12 +61,14 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, "aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -73,7 +77,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,12 +122,14 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, "i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -131,7 +138,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,12 +183,14 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, "nightly-aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -189,7 +199,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +248,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -244,6 +256,7 @@ "nightly-aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -252,7 +265,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +310,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -303,6 +318,7 @@ "nightly-aarch64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -311,7 +327,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +372,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -362,6 +380,7 @@ "nightly-i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -370,7 +389,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +434,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -421,6 +442,7 @@ "nightly-x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -429,7 +451,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +500,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -487,6 +511,7 @@ "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -495,7 +520,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +567,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -548,6 +575,7 @@ "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -556,7 +584,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +632,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -610,6 +640,7 @@ "nightly-x86_64-linux-alpine3_12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -618,7 +649,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +697,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -672,6 +705,7 @@ "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -680,7 +714,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +762,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -734,6 +770,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -742,7 +779,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +826,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -795,6 +834,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -803,7 +843,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +890,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -856,6 +898,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -864,7 +907,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +954,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -917,6 +962,7 @@ "nightly-x86_64-linux-centos7-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -925,7 +971,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1017,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -977,6 +1025,7 @@ "nightly-x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -985,7 +1034,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1079,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1036,6 +1087,7 @@ "nightly-x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1044,7 +1096,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1141,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1095,6 +1149,7 @@ "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1103,7 +1158,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1204,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1155,6 +1212,7 @@ "nightly-x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1163,7 +1221,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1266,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1214,6 +1274,7 @@ "nightly-x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1222,7 +1283,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1328,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1273,6 +1336,7 @@ "nightly-x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1281,7 +1345,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1390,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1332,6 +1398,7 @@ "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1340,7 +1407,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1391,6 +1460,7 @@ "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1399,7 +1469,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1515,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1452,6 +1524,7 @@ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1460,7 +1533,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1580,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1513,6 +1588,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1521,7 +1597,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1645,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", "XZ_OPT": "-9" } @@ -1575,6 +1653,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1583,7 +1662,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1630,6 +1710,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1637,6 +1718,7 @@ "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1645,7 +1727,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1689,6 +1772,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1696,6 +1780,7 @@ "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1704,7 +1789,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1756,6 +1842,7 @@ "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1764,7 +1851,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1808,6 +1896,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1815,6 +1904,7 @@ "nightly-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1823,7 +1913,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1960,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1876,6 +1968,7 @@ "nightly-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1884,7 +1977,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1931,6 +2025,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1938,6 +2033,7 @@ "nightly-x86_64-linux-fedora33-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1946,7 +2042,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1992,6 +2089,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1999,6 +2097,7 @@ "nightly-x86_64-linux-rocky8-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2007,7 +2106,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2052,6 +2152,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2059,6 +2160,7 @@ "nightly-x86_64-linux-ubuntu18_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2067,7 +2169,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2111,6 +2214,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2118,6 +2222,7 @@ "nightly-x86_64-linux-ubuntu20_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2126,7 +2231,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2170,6 +2276,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2177,6 +2284,7 @@ "nightly-x86_64-windows-int_native-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2184,7 +2292,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2229,6 +2338,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2236,6 +2346,7 @@ "nightly-x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2243,7 +2354,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2288,6 +2400,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2295,6 +2408,7 @@ "release-aarch64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2303,7 +2417,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2352,6 +2467,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2359,6 +2475,7 @@ "release-aarch64-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2367,7 +2484,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2413,6 +2531,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2420,6 +2539,7 @@ "release-i386-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2428,7 +2548,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2474,6 +2595,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2481,6 +2603,7 @@ "release-x86_64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2489,7 +2612,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2538,6 +2662,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2548,6 +2673,7 @@ "release-x86_64-linux-alpine3_12-int_native-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2556,7 +2682,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2604,6 +2731,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2611,6 +2739,7 @@ "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2619,7 +2748,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2667,6 +2797,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2674,6 +2805,7 @@ "release-x86_64-linux-alpine3_12-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2682,7 +2814,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2730,6 +2863,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2737,6 +2871,7 @@ "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2745,7 +2880,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2791,6 +2927,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2798,6 +2935,7 @@ "release-x86_64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2806,7 +2944,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2852,6 +2991,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2859,6 +2999,7 @@ "release-x86_64-linux-deb10-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2867,7 +3008,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2913,6 +3055,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2920,6 +3063,7 @@ "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2928,7 +3072,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2977,6 +3122,7 @@ "CROSS_TARGET": "javascript-unknown-ghcjs", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", "XZ_OPT": "-9" } @@ -2984,6 +3130,7 @@ "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2992,7 +3139,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3038,6 +3186,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -3045,6 +3194,7 @@ "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3053,7 +3203,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3107,6 +3258,7 @@ "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3115,7 +3267,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3314,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3168,6 +3322,7 @@ "release-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3176,7 +3331,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3380,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3231,6 +3388,7 @@ "release-x86_64-linux-fedora33-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3239,7 +3397,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3287,6 +3446,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3294,6 +3454,7 @@ "release-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3302,7 +3463,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3350,6 +3512,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3357,6 +3520,7 @@ "release-x86_64-linux-rocky8-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3365,7 +3529,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3411,6 +3576,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3418,6 +3584,7 @@ "release-x86_64-linux-ubuntu18_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3426,7 +3593,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3472,6 +3640,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3479,6 +3648,7 @@ "release-x86_64-linux-ubuntu20_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3487,7 +3657,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3533,6 +3704,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3540,6 +3712,7 @@ "release-x86_64-windows-int_native-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3547,7 +3720,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3593,6 +3767,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3600,6 +3775,7 @@ "release-x86_64-windows-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3607,7 +3783,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3830,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3660,6 +3838,7 @@ "x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3668,7 +3847,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3716,6 +3896,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3725,6 +3906,7 @@ "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3733,7 +3915,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3779,12 +3962,14 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3793,7 +3978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3840,12 +4026,14 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3854,7 +4042,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3900,12 +4089,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3914,7 +4105,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3961,12 +4153,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3975,7 +4169,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4022,12 +4217,14 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4036,7 +4233,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4080,12 +4278,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, "x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4094,7 +4294,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4139,12 +4340,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4153,7 +4356,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4198,12 +4402,14 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4212,7 +4418,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4256,12 +4463,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4270,7 +4479,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4314,12 +4524,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4328,7 +4540,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4372,12 +4585,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4386,7 +4601,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4430,12 +4646,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4444,7 +4662,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4490,6 +4709,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4497,6 +4717,7 @@ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4505,7 +4726,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4551,12 +4773,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4565,7 +4789,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4612,12 +4837,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4626,7 +4853,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4673,12 +4901,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, "x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4687,7 +4917,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4738,6 +4969,7 @@ "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4746,7 +4978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4792,12 +5025,14 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, "x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -4805,7 +5040,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4850,6 +5086,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -850,18 +850,18 @@ llvmManglePipeline pipe_env hsc_env location llc_fn = do else use (T_LlvmMangle pipe_env hsc_env llc_fn) asPipeline False pipe_env hsc_env location mangled_fn -cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath +cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) cmmCppPipeline pipe_env hsc_env input_fn = do output_fn <- use (T_CmmCpp pipe_env hsc_env input_fn) cmmPipeline pipe_env hsc_env output_fn -cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath +cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) cmmPipeline pipe_env hsc_env input_fn = do (fos, output_fn) <- use (T_Cmm pipe_env hsc_env input_fn) mo_fn <- hscPostBackendPipeline pipe_env hsc_env HsSrcFile (backend (hsc_dflags hsc_env)) Nothing output_fn case mo_fn of - Nothing -> panic "CMM pipeline - produced no .o file" - Just mo_fn -> use (T_MergeForeign pipe_env hsc_env mo_fn fos) + Nothing -> return Nothing + Just mo_fn -> Just <$> use (T_MergeForeign pipe_env hsc_env mo_fn fos) jsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath jsPipeline pipe_env hsc_env location input_fn = do @@ -938,8 +938,8 @@ pipelineStart pipe_env hsc_env input_fn mb_phase = fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn fromPhase StopLn = return (Just input_fn) - fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase CmmCpp = cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = cmmPipeline pipe_env hsc_env input_fn fromPhase Js = Just <$> foreignJsPipeline pipe_env hsc_env Nothing input_fn fromPhase MergeForeign = panic "fromPhase: MergeForeign" ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -471,10 +471,6 @@ unboxJsArg arg Just arg3_tycon = maybe_arg3_tycon -boxJsResult :: Type - -> DsM (Type, CoreExpr -> CoreExpr) -boxJsResult result_ty - | isRuntimeRepKindedTy result_ty = panic "boxJsResult: runtime rep ty" -- fixme -- Takes the result of the user-level ccall: -- either (IO t), -- or maybe just t for an side-effect-free call @@ -485,7 +481,7 @@ boxJsResult result_ty -- where t' is the unwrapped form of t. If t is simply (), then -- the result type will be -- State# RealWorld -> (# State# RealWorld #) - +boxJsResult :: Type -> DsM (Type, CoreExpr -> CoreExpr) boxJsResult result_ty | Just (io_tycon, io_res_ty) <- tcSplitIOType_maybe result_ty -- isIOType_maybe handles the case where the type is a @@ -585,7 +581,6 @@ jsResultWrapper -- E.g. foreign import foo :: Int -> IO T -- Then resultWrapper deals with marshalling the 'T' part jsResultWrapper result_ty - | isRuntimeRepKindedTy result_ty = return (Nothing, id) -- fixme this seems like a hack -- Base case 1a: unboxed tuples | Just (tc, args) <- splitTyConApp_maybe result_ty , isUnboxedTupleTyCon tc {- && False -} = do ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -153,7 +153,7 @@ genApp ctx i args -- object representation -- - returns the object directly, otherwise | [] <- args - , [vt] <- idVt i + , [vt] <- idJSRep i , isUnboxable vt , ctxIsEvaluated ctx i = do ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -118,7 +118,7 @@ genStaticArg a = case a of Nothing -> reg Just expr -> unfloated expr where - r = uTypeVt . stgArgType $ a + r = unaryTypeJSRep . stgArgType $ a reg | isVoid r = return [] @@ -159,8 +159,8 @@ genArg a = case a of where -- if our argument is a joinid, it can be an unboxed tuple - r :: HasDebugCallStack => VarType - r = uTypeVt . stgArgType $ a + r :: HasDebugCallStack => JSRep + r = unaryTypeJSRep . stgArgType $ a unfloated :: HasDebugCallStack => CgStgExpr -> G [JExpr] unfloated = \case @@ -187,7 +187,7 @@ genIdArgI i | isMultiVar r = mapM (identForIdN i) [1..varSize r] | otherwise = (:[]) <$> identForId i where - r = uTypeVt . idType $ i + r = unaryTypeJSRep . idType $ i -- | Generate IDs for stack arguments. See 'StgToJS.Expr.loadRetArgs' for use case genIdStackArgI :: HasDebugCallStack => Id -> G [(Ident,StackSlot)] ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -77,8 +77,9 @@ setObjInfoL debug obj rs layout t n a CILayoutFixed sz _ -> sz field_types = case layout of CILayoutVariable -> [] - CILayoutUnknown size -> toTypeList (replicate size ObjV) - CILayoutFixed _ fs -> toTypeList fs + CILayoutUnknown size -> to_type_list (replicate size ObjV) + CILayoutFixed _ fs -> to_type_list fs + to_type_list = concatMap (\x -> replicate (varSize x) (fromEnum x)) setObjInfo :: Bool -- ^ debug: output all symbol names -> Ident -- ^ the thing to modify @@ -241,3 +242,4 @@ varName :: Int -> Ident varName i | i < 0 || i > jsClosureCount = TxtI $ mkFastString ('x' : show i) | otherwise = varCache ! i + ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -304,7 +304,7 @@ genSetConInfo i d l {- srt -} = do emitClosureInfo $ ClosureInfo ei (CIRegs 0 [PtrV]) (mkFastString $ renderWithContext defaultSDocContext (ppr d)) - (fixedLayout $ map uTypeVt fields) + (fixedLayout $ map unaryTypeJSRep fields) (CICon $ dataConTag d) sr return (mkDataEntry ei) @@ -350,8 +350,8 @@ genToplevelRhs i rhs = case rhs of r <- updateThunk pure (StaticThunk (Just (eidt, map StaticObjArg lidents')), CIRegs 0 [PtrV],r) else return (StaticFun eidt (map StaticObjArg lidents'), - (if null lidents then CIRegs 1 (concatMap idVt args) - else CIRegs 0 (PtrV : concatMap idVt args)) + (if null lidents then CIRegs 1 (concatMap idJSRep args) + else CIRegs 0 (PtrV : concatMap idJSRep args)) , mempty) setcc <- ifProfiling $ if et == CIThunk @@ -360,7 +360,7 @@ genToplevelRhs i rhs = case rhs of emitClosureInfo (ClosureInfo eid regs idt - (fixedLayout $ map (uTypeVt . idType) lids) + (fixedLayout $ map (unaryTypeJSRep . idType) lids) et sr) ccId <- costCentreStackLbl cc ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -241,7 +241,7 @@ genEntryLne ctx i rhs@(StgRhsClosure _ext _cc update args body typ) = let f = (bh <> lvs <> body) emitClosureInfo $ ClosureInfo ei - (CIRegs 0 $ concatMap idVt args) + (CIRegs 0 $ concatMap idJSRep args) (eii <> ", " <> mkFastString (renderWithContext defaultSDocContext (ppr i))) (fixedLayout . reverse $ map (stackSlotType . fst) (ctxLneFrameVars ctx)) @@ -275,9 +275,9 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) = else enterCostCentreFun cc sr <- genStaticRefsRhs rhs emitClosureInfo $ ClosureInfo ei - (CIRegs 0 $ PtrV : concatMap idVt args) + (CIRegs 0 $ PtrV : concatMap idJSRep args) (eii <> ", " <> mkFastString (renderWithContext defaultSDocContext (ppr i))) - (fixedLayout $ map (uTypeVt . idType) live) + (fixedLayout $ map (unaryTypeJSRep . idType) live) et sr emitToplevel (jFunction ei [] (mconcat [ll, llv, upd, setcc, body])) @@ -285,15 +285,12 @@ genEntry ctx i rhs@(StgRhsClosure _ext cc {-_bi live-} upd_flag args body typ) = entryCtx = ctxSetTarget [] (ctxClearLneFrame ctx) -- | Generate the entry function types for identifiers. Note that this only --- returns either 'CIThunk' or 'CIFun'. Everything else (PAP Blackhole etc.) is --- filtered as not a RuntimeRepKinded type. +-- returns either 'CIThunk' or 'CIFun'. genEntryType :: HasDebugCallStack => [Id] -> G CIType genEntryType [] = return CIThunk -genEntryType args0 = do +genEntryType args = do args' <- mapM genIdArg args return $ CIFun (length args) (length $ concat args') - where - args = filter (not . isRuntimeRepKindedTy . idType) args0 -- | Generate the body of an object genBody :: HasDebugCallStack @@ -373,7 +370,7 @@ verifyRuntimeReps xs = do where verifyRuntimeRep i = do i' <- varsForId i - pure $ go i' (idVt i) + pure $ go i' (idJSRep i) go js (VoidV:vs) = go js vs go (j1:j2:js) (LongV:vs) = v "h$verify_rep_long" [j1,j2] <> go js vs go (j1:j2:js) (AddrV:vs) = v "h$verify_rep_addr" [j1,j2] <> go js vs @@ -491,11 +488,11 @@ optimizeFree -- -- Bool: True when the slot already contains a value optimizeFree offset ids = do -- this line goes wrong vvvvvvv - let -- ids' = concat $ map (\i -> map (i,) [1..varSize . uTypeVt . idType $ i]) ids + let -- ids' = concat $ map (\i -> map (i,) [1..varSize . unaryTypeJSRep . idType $ i]) ids idSize :: Id -> Int - idSize i = sum $ map varSize (typeVt . idType $ i) + idSize i = sum $ map varSize (typeJSRep . idType $ i) ids' = concatMap (\i -> map (i,) [1..idSize i]) ids - -- 1..varSize] . uTypeVt . idType $ i]) (typeVt ids) + -- 1..varSize] . unaryTypeJSRep . idType $ i]) (typeJSRep ids) l = length ids' slots <- drop offset . take l . (++repeat SlotUnknown) <$> getSlots let slm = M.fromList (zip slots [0..]) @@ -630,10 +627,10 @@ genRet ctx e at as l = freshIdent >>= f return (pushLne <> saveCCS <> pushRet) fst3 ~(x,_,_) = x - altRegs :: HasDebugCallStack => [VarType] + altRegs :: HasDebugCallStack => [JSRep] altRegs = case at of - PrimAlt ptc -> [primRepVt ptc] - MultiValAlt _n -> idVt e + PrimAlt ptc -> [primRepToJSRep ptc] + MultiValAlt _n -> idJSRep e _ -> [PtrV] -- special case for popping CCS but preserving stack size @@ -690,7 +687,7 @@ genAlts ctx e at me alts = do -> do ie <- varsForId e (r, bss) <- normalizeBranches ctx <$> - mapM (isolateSlots . mkPrimIfBranch ctx [primRepVt tc]) alts + mapM (isolateSlots . mkPrimIfBranch ctx [primRepToJSRep tc]) alts setSlots [] return (mkSw ie bss, r) @@ -877,7 +874,7 @@ mkAlgBranch top d alt -- | Generate a primitive If-expression mkPrimIfBranch :: ExprCtx - -> [VarType] + -> [JSRep] -> CgStgAlt -> G (Branch (Maybe [JExpr])) mkPrimIfBranch top _vt alt = ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -175,7 +175,7 @@ genFFIArg isJavaScriptCc a@(StgVarArg i) where tycon = tyConAppTyCon (unwrapType arg_ty) arg_ty = stgArgType a - r = uTypeVt arg_ty + r = unaryTypeJSRep arg_ty saturateFFI :: Int -> JStat -> Sat.JStat saturateFFI u = satJStat (Just . mkFastString $ "ghcjs_ffi_sat_" ++ show u) ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -509,7 +509,7 @@ instance Binary JSFFIType where put_ bh = putEnum bh get bh = getEnum bh -instance Binary VarType where +instance Binary JSRep where put_ bh = putEnum bh get bh = getEnum bh ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -110,7 +110,7 @@ data ClosureInfo = ClosureInfo data CIRegs = CIRegsUnknown -- ^ A value witnessing a state of unknown registers | CIRegs { ciRegsSkip :: Int -- ^ unused registers before actual args start - , ciRegsTypes :: [VarType] -- ^ args + , ciRegsTypes :: [JSRep] -- ^ args } deriving stock (Eq, Ord, Show) @@ -122,7 +122,7 @@ data CILayout } | CILayoutFixed -- ^ whole layout known { layoutSize :: !Int -- ^ closure size in array positions, including entry - , layout :: [VarType] -- ^ The set of sized Types to layout + , layout :: [JSRep] -- ^ The list of JSReps to layout } deriving stock (Eq, Ord, Show) @@ -149,8 +149,8 @@ instance ToJExpr CIStatic where toJExpr (CIStaticRefs []) = null_ -- [je| null |] toJExpr (CIStaticRefs rs) = toJExpr (map TxtI rs) --- | Free variable types -data VarType +-- | JS primitive representations +data JSRep = PtrV -- ^ pointer = reference to heap object (closure object), lifted or not. -- Can also be some RTS object (e.g. TVar#, MVar#, MutVar#, Weak#) | VoidV -- ^ no fields @@ -162,7 +162,7 @@ data VarType | ArrV -- ^ boxed array deriving stock (Eq, Ord, Enum, Bounded, Show) -instance ToJExpr VarType where +instance ToJExpr JSRep where toJExpr = toJExpr . fromEnum -- | The type of identifiers. These determine the suffix of generated functions ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -2,76 +2,44 @@ {-# LANGUAGE LambdaCase #-} module GHC.StgToJS.Utils - ( assignToTypedExprs - , assignCoerce1 + ( assignCoerce1 , assignToExprCtx - -- * Core Utils + , fixedLayout + , assocIdExprs + -- * Unboxable datacon , isUnboxableCon , isUnboxable - , SlotCount(..) + , isBoolDataCon + -- * JSRep , slotCount , varSize - , varSlotCount , typeSize , isVoid - , isPtr - , isSingleVar , isMultiVar - , isMatchable - , tyConVt - , idVt - , typeVt - , uTypeVt - , primRepVt - , typePrimRep' - , tyConPrimRep' - , kindPrimRep' - , primTypeVt - , argVt - , dataConType - , isBoolDataCon - , fixedLayout + , idJSRep + , typeJSRep + , unaryTypeJSRep + , primRepToJSRep , stackSlotType - , idPrimReps - , typePrimReps , primRepSize - , assocPrimReps - , assocIdPrimReps - , assocIdExprs , mkArityTag - , toTypeList - -- * Stg Utils - , bindingRefs - , rhsRefs + -- * References and Ids , exprRefs - , altRefs - , argRefs , hasExport , collectTopIds , collectIds - , removeTick + -- * Live variables , LiveVars , liveStatic , liveVars - , stgTopBindLive - , stgBindLive - , stgBindRhsLive , stgRhsLive - , stgArgLive , stgExprLive - , stgAltLive - , stgLetNoEscapeLive - , bindees , isUpdatableRhs - , stgLneLive , stgLneLive' , stgLneLiveExpr , isInlineExpr - , inspectInlineBinding - , inspectInlineRhs - , isInlineForeignCall - , isInlineApp - ) where + ) +where import GHC.Prelude @@ -91,8 +59,6 @@ import GHC.Stg.Syntax import GHC.Tc.Utils.TcType -import GHC.Builtin.Types -import GHC.Builtin.Types.Prim import GHC.Builtin.Names import GHC.Builtin.PrimOps (PrimOp(SeqOp), primOpIsReallyInline) @@ -163,7 +129,7 @@ assignCoerce p1 p2 = assignTypedExprs [p1] [p2] isUnboxableCon :: DataCon -> Bool isUnboxableCon dc | [t] <- dataConRepArgTys dc - , [t1] <- typeVt (scaledThing t) + , [t1] <- typeJSRep (scaledThing t) = isUnboxable t1 && dataConTag dc == 1 && length (tyConDataCons $ dataConTyCon dc) == 1 @@ -171,7 +137,7 @@ isUnboxableCon dc -- | one-constructor types with one primitive field represented as a JS Number -- can be unboxed -isUnboxable :: VarType -> Bool +isUnboxable :: JSRep -> Bool isUnboxable DoubleV = True isUnboxable IntV = True -- includes Char# isUnboxable _ = False @@ -194,153 +160,56 @@ slotCount = \case TwoSlots -> 2 --- | Number of slots occupied by a value with the given VarType -varSize :: VarType -> Int -varSize = slotCount . varSlotCount +-- | Number of slots occupied by a value with the given JSRep +varSize :: JSRep -> Int +varSize = slotCount . jsRepSlots -varSlotCount :: VarType -> SlotCount -varSlotCount VoidV = NoSlot -varSlotCount LongV = TwoSlots -- hi, low -varSlotCount AddrV = TwoSlots -- obj/array, offset -varSlotCount _ = OneSlot +jsRepSlots :: JSRep -> SlotCount +jsRepSlots VoidV = NoSlot +jsRepSlots LongV = TwoSlots -- hi, low +jsRepSlots AddrV = TwoSlots -- obj/array, offset +jsRepSlots _ = OneSlot typeSize :: Type -> Int -typeSize t = sum . map varSize . typeVt $ t +typeSize t = sum . map varSize . typeJSRep $ t -isVoid :: VarType -> Bool +isVoid :: JSRep -> Bool isVoid VoidV = True isVoid _ = False -isPtr :: VarType -> Bool -isPtr PtrV = True -isPtr _ = False - -isSingleVar :: VarType -> Bool -isSingleVar v = varSlotCount v == OneSlot - -isMultiVar :: VarType -> Bool -isMultiVar v = case varSlotCount v of +isMultiVar :: JSRep -> Bool +isMultiVar v = case jsRepSlots v of NoSlot -> False OneSlot -> False TwoSlots -> True --- | can we pattern match on these values in a case? -isMatchable :: [VarType] -> Bool -isMatchable [DoubleV] = True -isMatchable [IntV] = True -isMatchable _ = False +idJSRep :: HasDebugCallStack => Id -> [JSRep] +idJSRep = typeJSRep . idType -tyConVt :: HasDebugCallStack => TyCon -> [VarType] -tyConVt = typeVt . mkTyConTy - -idVt :: HasDebugCallStack => Id -> [VarType] -idVt = typeVt . idType - -typeVt :: HasDebugCallStack => Type -> [VarType] -typeVt t | isRuntimeRepKindedTy t = [] -typeVt t = map primRepVt (typePrimRep t)-- map uTypeVt (repTypeArgs t) +typeJSRep :: HasDebugCallStack => Type -> [JSRep] +typeJSRep t = map primRepToJSRep (typePrimRep t) -- only use if you know it's not an unboxed tuple -uTypeVt :: HasDebugCallStack => UnaryType -> VarType -uTypeVt ut - | isRuntimeRepKindedTy ut = VoidV --- | isRuntimeRepTy ut = VoidV - -- GHC panics on this otherwise - | Just (tc, ty_args) <- splitTyConApp_maybe ut - , length ty_args /= tyConArity tc = PtrV - | isPrimitiveType ut = (primTypeVt ut) - | otherwise = - case typePrimRep' ut of - [] -> VoidV - [pt] -> primRepVt pt - _ -> pprPanic "uTypeVt: not unary" (ppr ut) - -primRepVt :: HasDebugCallStack => PrimRep -> VarType -primRepVt VoidRep = VoidV -primRepVt (BoxedRep _) = PtrV -- fixme does ByteArray# ever map to this? -primRepVt IntRep = IntV -primRepVt Int8Rep = IntV -primRepVt Int16Rep = IntV -primRepVt Int32Rep = IntV -primRepVt WordRep = IntV -primRepVt Word8Rep = IntV -primRepVt Word16Rep = IntV -primRepVt Word32Rep = IntV -primRepVt Int64Rep = LongV -primRepVt Word64Rep = LongV -primRepVt AddrRep = AddrV -primRepVt FloatRep = DoubleV -primRepVt DoubleRep = DoubleV -primRepVt (VecRep{}) = error "uTypeVt: vector types are unsupported" - -typePrimRep' :: HasDebugCallStack => UnaryType -> [PrimRep] -typePrimRep' ty = kindPrimRep' empty (typeKind ty) - --- | Find the primitive representation of a 'TyCon'. Defined here to --- avoid module loops. Call this only on unlifted tycons. -tyConPrimRep' :: HasDebugCallStack => TyCon -> [PrimRep] -tyConPrimRep' tc = kindPrimRep' empty res_kind - where - res_kind = tyConResKind tc - --- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's --- of values of types of this kind. -kindPrimRep' :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] -kindPrimRep' doc ki - | Just ki' <- coreView ki - = kindPrimRep' doc ki' -kindPrimRep' doc (TyConApp _typ [runtime_rep]) - = -- ASSERT( typ `hasKey` tYPETyConKey ) - runtimeRepPrimRep doc runtime_rep -kindPrimRep' doc ki - = pprPanic "kindPrimRep'" (ppr ki $$ doc) - -primTypeVt :: HasDebugCallStack => Type -> VarType -primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of - Nothing -> error "primTypeVt: not a TyCon" - Just tc - | tc == charPrimTyCon -> IntV - | tc == intPrimTyCon -> IntV - | tc == wordPrimTyCon -> IntV - | tc == floatPrimTyCon -> DoubleV - | tc == doublePrimTyCon -> DoubleV - | tc == int8PrimTyCon -> IntV - | tc == word8PrimTyCon -> IntV - | tc == int16PrimTyCon -> IntV - | tc == word16PrimTyCon -> IntV - | tc == int32PrimTyCon -> IntV - | tc == word32PrimTyCon -> IntV - | tc == int64PrimTyCon -> LongV - | tc == word64PrimTyCon -> LongV - | tc == addrPrimTyCon -> AddrV - | tc == stablePtrPrimTyCon -> AddrV - | tc == stableNamePrimTyCon -> PtrV - | tc == statePrimTyCon -> VoidV - | tc == proxyPrimTyCon -> VoidV - | tc == realWorldTyCon -> VoidV - | tc == threadIdPrimTyCon -> PtrV - | tc == weakPrimTyCon -> PtrV - | tc == arrayPrimTyCon -> ArrV - | tc == smallArrayPrimTyCon -> ArrV - | tc == byteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutableArrayPrimTyCon -> ArrV - | tc == smallMutableArrayPrimTyCon -> ArrV - | tc == mutableByteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutVarPrimTyCon -> PtrV - | tc == mVarPrimTyCon -> PtrV - | tc == tVarPrimTyCon -> PtrV - | tc == bcoPrimTyCon -> PtrV -- unsupported? - | tc == stackSnapshotPrimTyCon -> PtrV - | tc == ioPortPrimTyCon -> PtrV -- unsupported? - | tc == anyTyCon -> PtrV - | tc == compactPrimTyCon -> PtrV -- unsupported? - | tc == eqPrimTyCon -> VoidV -- coercion token? - | tc == eqReprPrimTyCon -> VoidV -- role - | tc == unboxedUnitTyCon -> VoidV -- Void# - | otherwise -> PtrV -- anything else must be some boxed thing - -argVt :: StgArg -> VarType -argVt a = uTypeVt . stgArgType $ a +unaryTypeJSRep :: HasDebugCallStack => UnaryType -> JSRep +unaryTypeJSRep ut = primRepToJSRep (typePrimRep1 ut) + +primRepToJSRep :: HasDebugCallStack => PrimRep -> JSRep +primRepToJSRep VoidRep = VoidV +primRepToJSRep (BoxedRep _) = PtrV +primRepToJSRep IntRep = IntV +primRepToJSRep Int8Rep = IntV +primRepToJSRep Int16Rep = IntV +primRepToJSRep Int32Rep = IntV +primRepToJSRep WordRep = IntV +primRepToJSRep Word8Rep = IntV +primRepToJSRep Word16Rep = IntV +primRepToJSRep Word32Rep = IntV +primRepToJSRep Int64Rep = LongV +primRepToJSRep Word64Rep = LongV +primRepToJSRep AddrRep = AddrV +primRepToJSRep FloatRep = DoubleV +primRepToJSRep DoubleRep = DoubleV +primRepToJSRep (VecRep{}) = error "primRepToJSRep: vector types are unsupported" dataConType :: DataCon -> Type dataConType dc = idType (dataConWrapId dc) @@ -350,16 +219,16 @@ isBoolDataCon dc = isBoolTy (dataConType dc) -- standard fixed layout: payload types -- payload starts at .d1 for heap objects, entry closest to Sp for stack frames -fixedLayout :: [VarType] -> CILayout +fixedLayout :: [JSRep] -> CILayout fixedLayout vts = CILayoutFixed (sum (map varSize vts)) vts -- 2-var values might have been moved around separately, use DoubleV as substitute -- ObjV is 1 var, so this is no problem for implicit metadata -stackSlotType :: Id -> VarType +stackSlotType :: Id -> JSRep stackSlotType i - | OneSlot <- varSlotCount otype = otype - | otherwise = DoubleV - where otype = uTypeVt (idType i) + | OneSlot <- jsRepSlots otype = otype + | otherwise = DoubleV + where otype = unaryTypeJSRep (idType i) idPrimReps :: Id -> [PrimRep] idPrimReps = typePrimReps . idType @@ -368,7 +237,7 @@ typePrimReps :: Type -> [PrimRep] typePrimReps = typePrimRep . unwrapType primRepSize :: PrimRep -> SlotCount -primRepSize p = varSlotCount (primRepVt p) +primRepSize p = jsRepSlots (primRepToJSRep p) -- | Associate the given values to each RrimRep in the given order, taking into -- account the number of slots per PrimRep @@ -393,9 +262,6 @@ assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) mkArityTag :: Int -> Int -> Int mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8) -toTypeList :: [VarType] -> [Int] -toTypeList = concatMap (\x -> replicate (varSize x) (fromEnum x)) - -------------------------------------------------------------------------------- -- Stg Utils -------------------------------------------------------------------------------- @@ -467,10 +333,6 @@ collectIds unfloated b = | Just m <- nameModule_maybe (getName i) = m == gHC_PRIM | otherwise = False -removeTick :: CgStgExpr -> CgStgExpr -removeTick (StgTick _ e) = e -removeTick e = e - ----------------------------------------------------- -- Live vars -- @@ -484,11 +346,6 @@ liveStatic = filterDVarSet isGlobalId liveVars :: LiveVars -> LiveVars liveVars = filterDVarSet (not . isGlobalId) -stgTopBindLive :: CgStgTopBinding -> [(Id, LiveVars)] -stgTopBindLive = \case - StgTopLifted b -> stgBindLive b - StgTopStringLit {} -> [] - stgBindLive :: CgStgBinding -> [(Id, LiveVars)] stgBindLive = \case StgNonRec b rhs -> [(b, stgRhsLive rhs)] @@ -529,9 +386,6 @@ stgAltLive :: CgStgAlt -> LiveVars stgAltLive alt = delDVarSetList (stgExprLive True (alt_rhs alt)) (alt_bndrs alt) -stgLetNoEscapeLive :: Bool -> StgBinding -> StgExpr -> LiveVars -stgLetNoEscapeLive _someBool _b _e = panic "stgLetNoEscapeLive" - bindees :: CgStgBinding -> [Id] bindees = \case StgNonRec b _e -> [b] ===================================== hadrian/stack.yaml ===================================== @@ -1,4 +1,6 @@ -resolver: lts-19.8 +# GHC's configure script reports that GHC versions 9.2 and greater are required +# to build GHC from source. +resolver: lts-20.26 # GHC 9.2.8 packages: - '.' ===================================== hadrian/stack.yaml.lock ===================================== @@ -6,7 +6,7 @@ packages: [] snapshots: - completed: - size: 618506 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/8.yaml - sha256: f1c4aca9b9b81afbb9db55571acb0690cdc01ac97a178234de281f9dc075e95e - original: lts-19.8 + size: 650475 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml + sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 + original: lts-20.26 ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--unexpected-output-dir", help="directory in which to place unexpected output") parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") @@ -128,6 +129,9 @@ if args.top: if args.test_package_db: config.test_package_db = args.test_package_db +if args.unexpected_output_dir: + config.unexpected_output_dir = Path(args.unexpected_output_dir) + if args.only: config.only = args.only config.run_only_some_tests = True ===================================== testsuite/driver/testglobals.py ===================================== @@ -203,7 +203,7 @@ class TestConfig: self.baseline_commit = None # type: Optional[GitRef] # Additional package dbs to inspect for test dependencies. - self.test_package_db = [] # type: [PathToPackageDb] + self.test_package_db = [] # type: List[PathToPackageDb] # Should we skip performance tests self.skip_perf_tests = False @@ -225,6 +225,10 @@ class TestConfig: # See Note [Haddock runtime stats files] at the bottom of this file. self.stats_files_dir = Path('/please_set_stats_files_dir') + # Where to place observed output files on when unexpected output + # is observed. + self.unexpected_output_dir = None # type: Optional[Path] + # Should we cleanup after test runs? self.cleanup = True ===================================== testsuite/driver/testlib.py ===================================== @@ -2262,11 +2262,15 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool: # new output. Returns true if output matched or was accepted, false # otherwise. See Note [Output comparison] for the meaning of the # normaliser and whitespace_normaliser parameters. -async def compare_outputs(way: WayName, - kind: str, - normaliser: OutputNormalizer, - expected_file, actual_file, diff_file=None, - whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: +async def compare_outputs( + way: WayName, + kind: str, + normaliser: OutputNormalizer, + expected_file: Path, + actual_file: Path, + diff_file: Optional[Path]=None, + whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options if kind == 'stderr' and getTestOpts().ignore_stderr: return True @@ -2343,6 +2347,12 @@ async def compare_outputs(way: WayName, expected_path.unlink() return True else: + if config.unexpected_output_dir is not None: + ghc_root = expected_path.relative_to(config.top.parent) + out = config.unexpected_output_dir / ghc_root + out.parent.mkdir(exist_ok=True, parents=True) + write_file(out, actual_raw) + return False # Checks that each line from pattern_file is present in actual_file as @@ -2397,6 +2407,15 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs # squash all whitespace, making the diff unreadable. Instead we rely # on the `diff` program to ignore whitespace changes as much as # possible (#10152). +# +# In addition, to aid CI users we will optionally collect all +# of the unexpected output that we encountered in the +# directory at config.unexpected_output_dir. The intent here is for this +# directory to be preserved as a CI artifact which can then +# be downloaded by the user and committed to their branch +# to address CI failures on platforms which they cannot +# test locally. + # Note [Null device handling] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== testsuite/tests/cmm/should_compile/Makefile ===================================== @@ -13,3 +13,6 @@ T16930: grep -rl "after setInfoTableStackMap" `ls T16930.*` grep -rl "Layout Stack" `ls T16930.*` grep -rl "Post switch plan" `ls T16930.*` + +T23610: + '$(TEST_HC)' $(TEST_HC_OPTS) T23610.cmm -S ===================================== testsuite/tests/cmm/should_compile/T23610.cmm ===================================== @@ -0,0 +1,3 @@ +test(bits64 x) { + return (x); +} ===================================== testsuite/tests/cmm/should_compile/all.T ===================================== @@ -8,3 +8,4 @@ test('cmm_sink_sp', [ only_ways(['optasm']), grep_errmsg(r'(\[Sp.*\]).*(=).*(\[. test('T16930', normal, makefile_test, ['T16930']) test('T17442', normal, compile, ['']) test('T20725', normal, compile, ['-package ghc']) +test('T23610', normal, makefile_test, ['T23610']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a26b115068432695452c1ab31f8a1ca906a21bb7...796a5c1f472360030660af59fadee42dc986c560 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a26b115068432695452c1ab31f8a1ca906a21bb7...796a5c1f472360030660af59fadee42dc986c560 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 07:23:02 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 07 Jul 2023 03:23:02 -0400 Subject: [Git][ghc/ghc][wip/T23576] Remove workarounds Message-ID: <64a7bd56b1e52_2c735eaed942060cb@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 007cb402 by Jaro Reinders at 2023-07-07T09:22:54+02:00 Remove workarounds - - - - - 3 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Utils/Unique.hs - testsuite/tests/cmm/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1993,7 +1993,8 @@ condIntCode' platform cond x y = do condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode -- Larger-than-native (64-bit ops on 32-bit platforms) -condFltCode cond x y = condFltCode_sse2 +condFltCode cond x y + = condFltCode_sse2 where ===================================== compiler/GHC/Utils/Unique.hs ===================================== @@ -2,12 +2,12 @@ {- Work around #23537 -On 32 bit systems, GHC's codegen around 64 bit numbers is not quite -complete. This led to panics mentioning missing cases in iselExpr64. -Now that GHC uses Word64 for its uniques, these panics have started -popping up whenever a unique is compared to many other uniques in one -function. As a workaround we use these two functions which are not -inlined on 32 bit systems, thus preventing the panics. +On 32 bit systems, GHC's codegen around 64 bit numbers used to be incomplete +before GHC 9.10. This led to panics mentioning missing cases in iselExpr64. +Now that GHC uses Word64 for its uniques, these panics have started popping up +whenever a unique is compared to many other uniques in one function. As a +workaround we use these two functions which are not inlined, on 32 bit systems +and if compiled with versions before GHC 9.9, thus preventing the panics. -} module GHC.Utils.Unique (sameUnique, anyOfUnique) where @@ -18,7 +18,7 @@ import GHC.Prelude.Basic (Bool, Eq((==)), Foldable(elem)) import GHC.Types.Unique (Unique, Uniquable (getUnique)) -#if WORD_SIZE_IN_BITS == 32 +#if WORD_SIZE_IN_BITS == 32 && !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) {-# NOINLINE sameUnique #-} #else {-# INLINE sameUnique #-} @@ -26,7 +26,7 @@ import GHC.Types.Unique (Unique, Uniquable (getUnique)) sameUnique :: Uniquable a => a -> a -> Bool sameUnique x y = getUnique x == getUnique y -#if WORD_SIZE_IN_BITS == 32 +#if WORD_SIZE_IN_BITS == 32 && !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) {-# NOINLINE anyOfUnique #-} #else {-# INLINE anyOfUnique #-} ===================================== testsuite/tests/cmm/should_run/all.T ===================================== @@ -27,7 +27,6 @@ test('ByteSwitch', test('T22871', [ extra_run_opts('"' + config.libdir + '"') , req_cmm - , when(arch('i386'), skip) # x86 NCG panics with "iselExpr64(i386)" ], multi_compile_and_run, ['T22871', [('T22871_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/007cb402b1ee14a6857977aa7b46890f6a3f6c25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/007cb402b1ee14a6857977aa7b46890f6a3f6c25 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 08:35:12 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 07 Jul 2023 04:35:12 -0400 Subject: [Git][ghc/ghc][wip/T23576] Remove stray comment Message-ID: <64a7ce40233c7_2c735eafde82221c@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 426cf21b by Jaro Reinders at 2023-07-07T10:35:04+02:00 Remove stray comment - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1992,7 +1992,6 @@ condIntCode' platform cond x y = do -------------------------------------------------------------------------------- condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode --- Larger-than-native (64-bit ops on 32-bit platforms) condFltCode cond x y = condFltCode_sse2 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/426cf21b9d1358d1f47a043cb3496fba02eca339 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/426cf21b9d1358d1f47a043cb3496fba02eca339 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 08:47:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 07 Jul 2023 04:47:35 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Make postInlineUnconditionally a bit more aggressive Message-ID: <64a7d127ac9d3_2c735eafdd42246fb@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 9cb540eb by Simon Peyton Jones at 2023-07-07T09:45:58+01:00 Make postInlineUnconditionally a bit more aggressive Try postInlineUnconditionally for one-branch things, even if under a lambda Reinstate the check in simplAuxBind - - - - - 2 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -417,11 +417,11 @@ simplAuxBind _str env bndr new_rhs = return (emptyFloats env, env) -- Here c is dead, and we avoid -- creating the binding c = (a,b) -{- Try not doing this -- The cases would be inlined unconditionally by completeBind: - -- but it seems not uncommon, and avoids faff to do it here - -- This is safe because it's only used for auxiliary bindings, which - -- have no NOLINE pragmas, nor RULEs + -- but it seems not uncommon, and it turns to be a little more + -- efficient (in compile time allocations) to do it here. + -- See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils + -- Note: auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings | exprIsTrivial new_rhs -- Short-cut for let x = y in ... || case (idOccInfo bndr) of OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> True @@ -430,7 +430,6 @@ simplAuxBind _str env bndr new_rhs , case new_rhs of Coercion co -> extendCvSubst env bndr co _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) --} | otherwise = do { -- ANF-ise the RHS ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1544,16 +1544,9 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs -> n_br < 100 -- See Note [Suppress exponential blowup] - && (smallEnoughToInline uf_opts unfolding || (in_lam == NotInsideLam && n_br == 1)) -- Small enough to dup - -- ToDo: consider discount on smallEnoughToInline if int_cxt is true - -- - -- NB: Do NOT inline arbitrarily big things, even if occ_n_br=1 - -- Reason: doing so risks exponential behaviour. We simplify a big - -- expression, inline it, and simplify it again. But if the - -- very same thing happens in the big expression, we get - -- exponential cost! - -- PRINCIPLE: when we've already simplified an expression once, - -- make sure that we only inline it if it's reasonably small. + && ( (n_br == 1) -- See Note [Post-inline for single-use things] + || smallEnoughToInline uf_opts unfolding) -- Small enough to dup + -- ToDo: consider discount on smallEnoughToInline if int_cxt is true && (in_lam == NotInsideLam || -- Outside a lambda, we want to be reasonably aggressive @@ -1576,18 +1569,6 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs _ -> False --- Here's an example that we don't handle well: --- let f = if b then Left (\x.BIG) else Right (\y.BIG) --- in \y. ....case f of {...} .... --- Here f is used just once, and duplicating the case work is fine (exprIsCheap). --- But --- - We can't preInlineUnconditionally because that would invalidate --- the occ info for b. --- - We can't postInlineUnconditionally because the RHS is big, and --- that risks exponential behaviour --- - We can't call-site inline, because the rhs is big --- Alas! - where occ_info = idOccInfo old_bndr unfolding = idUnfolding bndr @@ -1614,6 +1595,51 @@ in allocation if you miss this out. And bits of GHC itself start to allocate more. An egregious example is test perf/compiler/T14697, where GHC.Driver.CmdLine.$wprocessArgs allocated hugely more. + +Note [Post-inline for single-use things] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we have + + let x = rhs in ...x... + +and `x` is used exactly once, and not inside a lambda, then we will usually +preInlineUnconditinally. But we can still get this situation in +postInlineUnconditionally: + + case K rhs of K x -> ...x.... + +Here we'll use `simplAuxBind` to bind `x` to (the already-simplified) `rhs`; +and `x` is used exactly once. It's beneficial to inline right away; otherwise +we risk creating + + let x = rhs in ...x... + +which will take another iteration of the Simplifier to eliminate. We do this in +two places + +1. `simplAuxBind` does a kind of poor-man's `postInlineUnconditionally`. It + does not need to account for many of the cases (e.g. top level) that the + full `postInlineUnconditionally` does. Moreover, we don't have an + OutId, which `postInlineUnconditionally` needs. + +2. In the full `postInlineUnconditionally` we also look for the special case + of "one occurrence, not under a lambda". + + +-- Here's an example that we don't handle well: +-- let f = if b then Left (\x.BIG) else Right (\y.BIG) +-- in \y. ....case f of {...} .... +-- Here f is used just once, and duplicating the case work is fine (exprIsCheap). +-- But +-- - We can't preInlineUnconditionally because that would invalidate +-- the occ info for b. +-- - We can't postInlineUnconditionally because the RHS is big, and +-- that risks exponential behaviour +-- - We can't call-site inline, because the rhs is big +-- Alas! + + + Note [Suppress exponential blowup] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In #13253, and several related tickets, we got an exponential blowup View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cb540eb7a61621830fda2263fe1f744c5e80002 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cb540eb7a61621830fda2263fe1f744c5e80002 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 09:15:08 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 07 Jul 2023 05:15:08 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] 10 commits: Filter out nontrivial substituted expressions in substTickish Message-ID: <64a7d79c2920_2c735eafcbc229098@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - a67229cd by Matthew Pickering at 2023-07-07T10:14:30+01:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - docs/users_guide/debugging.rst - libraries/base/System/Posix/Internals.hs - libraries/base/jsbits/base.js - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/openFile003.stdout-javascript-unknown-ghcjs - libraries/base/tests/all.T - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/ghc-api/target-contents/all.T - testsuite/tests/ghci/linking/all.T - testsuite/tests/ghci/scripts/all.T - testsuite/tests/numeric/should_run/all.T - testsuite/tests/primops/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ae4127c8dd95928b47b1da184377f90dd6175a2...a67229cdfe78bf9e4b9e6c32c20c233bf1232bd3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ae4127c8dd95928b47b1da184377f90dd6175a2...a67229cdfe78bf9e4b9e6c32c20c233bf1232bd3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 09:20:20 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 07 Jul 2023 05:20:20 -0400 Subject: [Git][ghc/ghc][wip/T23576] Remove redundant code and move note Message-ID: <64a7d8d4a24aa_2c735eafdd4229543@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: d35b2520 by Jaro Reinders at 2023-07-07T11:20:12+02:00 Remove redundant code and move note - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -1853,6 +1853,27 @@ machOpToCond mo = case mo of MO_U_Le _ -> LEU _other -> pprPanic "machOpToCond" (pprMachOp mo) +{- Note [64-bit integer comparisons on 32-bit] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + When doing these comparisons there are 2 kinds of + comparisons. + + * Comparison for equality (or lack thereof) + + We use xor to check if high/low bits are + equal. Then combine the results using or. + + * Other comparisons: + + We first compare the low registers + and use a subtraction with borrow to compare the high registers. + + For signed numbers the condition is determined by + the sign and overflow flags agreeing or not + and for unsigned numbers the condition is the carry flag. + +-} -- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be -- passed back up the tree. @@ -2139,36 +2160,6 @@ I386: First, we have to ensure that the condition codes are set according to the supplied comparison operation. -} -{- Note [64-bit integer comparisons on 32-bit] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - When doing these comparisons there are 2 kinds of - comparisons. - - * Comparison for equality (or lack thereof) - - We use xor to check if high/low bits are - equal. Then combine the results using or and - perform a single conditional jump based on the - result. - - * Other comparisons: - - We map all other comparisons to the >= operation. - Why? Because it's easy to encode it with a single - conditional jump. - - We do this by first computing [r1_lo - r2_lo] - and use the carry flag to compute - [r1_high - r2_high - CF]. - - At which point if r1 >= r2 then the result will be - positive. Otherwise negative so we can branch on this - condition. - --} - - genCondBranch :: BlockId -- the source of the jump -> BlockId -- the true branch target @@ -2184,67 +2175,6 @@ genCondBranch bid id false expr = do genCondBranch' :: Bool -> BlockId -> BlockId -> BlockId -> CmmExpr -> NatM InstrBlock --- 64-bit integer comparisons on 32-bit --- See Note [64-bit integer comparisons on 32-bit] -genCondBranch' is32Bit _bid true false (CmmMachOp mop [e1,e2]) - | is32Bit, Just W64 <- maybeIntComparison mop = do - - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - let cond = machOpToCond mop :: Cond - - -- we mustn't clobber r1/r2 so we use temporaries - tmp1 <- getNewRegNat II32 - tmp2 <- getNewRegNat II32 - - let cmpCode = intComparison cond true false r1hi r1lo r2hi r2lo tmp1 tmp2 - return $ code1 `appOL` code2 `appOL` cmpCode - - where - intComparison cond true false r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 = - case cond of - -- Impossible results of machOpToCond - ALWAYS -> panic "impossible" - NEG -> panic "impossible" - POS -> panic "impossible" - CARRY -> panic "impossible" - OFLO -> panic "impossible" - PARITY -> panic "impossible" - NOTPARITY -> panic "impossible" - -- Special case #1 x == y and x != y - EQQ -> cmpExact - NE -> cmpExact - -- [x >= y] - GE -> cmpGE - GEU -> cmpGE - -- [x > y] <==> ![y >= x] - GTT -> intComparison GE false true r2_hi r2_lo r1_hi r1_lo tmp1 tmp2 - GU -> intComparison GEU false true r2_hi r2_lo r1_hi r1_lo tmp1 tmp2 - -- [x <= y] <==> [y >= x] - LE -> intComparison GE true false r2_hi r2_lo r1_hi r1_lo tmp1 tmp2 - LEU -> intComparison GEU true false r2_hi r2_lo r1_hi r1_lo tmp1 tmp2 - -- [x < y] <==> ![x >= x] - LTT -> intComparison GE false true r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 - LU -> intComparison GEU false true r1_hi r1_lo r2_hi r2_lo tmp1 tmp2 - where - cmpExact :: OrdList Instr - cmpExact = - toOL - [ MOV II32 (OpReg r1_hi) (OpReg tmp1) - , MOV II32 (OpReg r1_lo) (OpReg tmp2) - , XOR II32 (OpReg r2_hi) (OpReg tmp1) - , XOR II32 (OpReg r2_lo) (OpReg tmp2) - , OR II32 (OpReg tmp1) (OpReg tmp2) - , JXX cond true - , JXX ALWAYS false - ] - cmpGE = toOL - [ MOV II32 (OpReg r1_hi) (OpReg tmp1) - , CMP II32 (OpReg r2_lo) (OpReg r1_lo) - , SBB II32 (OpReg r2_hi) (OpReg tmp1) - , JXX cond true - , JXX ALWAYS false ] - genCondBranch' _ bid id false bool = do CondCode is_float cond cond_code <- getCondCode bool use_sse2 <- sse2Enabled View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d35b2520a3797307f683e0a249a2784154862024 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d35b2520a3797307f683e0a249a2784154862024 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 10:31:03 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 07 Jul 2023 06:31:03 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] 16 commits: Improve the situation with the stimes cycle Message-ID: <64a7e96746bae_2c735eafca82520ca@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - ba2542b8 by David Knothe at 2023-07-07T12:30:46+02:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d51b023a7def9ff32528c3681e9646f675347633...ba2542b876feb8b318f59f10b692eeaacc30e592 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d51b023a7def9ff32528c3681e9646f675347633...ba2542b876feb8b318f59f10b692eeaacc30e592 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 11:15:48 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 07 Jul 2023 07:15:48 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] Use deb10 for i386 bindists Message-ID: <64a7f3e4a04a6_2c735eafca82643d6@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: 1c1b7d3c by Matthew Pickering at 2023-07-07T12:15:39+01:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: 6def896dafef7f622a25aa848ad8f440fb7c4d67 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false - - job: nightly-i386-linux-deb9-validate + - job: nightly-i386-linux-deb10-validate artifacts: false - job: nightly-x86_64-linux-deb10-validate artifacts: false ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -923,7 +923,8 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) +-- , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -120,7 +120,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -130,7 +130,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -139,14 +139,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -172,10 +172,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -359,7 +359,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -369,7 +369,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -378,14 +378,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -411,10 +411,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2417,7 +2417,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2427,7 +2427,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml" ], "reports": { @@ -2436,14 +2436,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2469,12 +2469,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -191,7 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): deb10 = mk(debian("x86_64", 10)) deb11 = mk(debian("x86_64", 11)) deb10_arm64 = mk(debian("aarch64", 10)) - deb9_i386 = mk(debian("i386", 9)) + deb10_i386 = mk(debian("i386", 10)) source = mk_one_metadata(release_mode, version, job_map, source_artifact) test = mk_one_metadata(release_mode, version, job_map, test_artifact) @@ -221,10 +221,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): } - a32 = { "Linux_Debian": { "<10": deb9_i386, "unknown_versioning": deb9_i386 } - , "Linux_Ubuntu": { "unknown_versioning": deb9_i386 } - , "Linux_Mint" : { "unknown_versioning": deb9_i386 } - , "Linux_UnknownLinux" : { "unknown_versioning": deb9_i386 } + a32 = { "Linux_Debian": { "unknown_versioning": deb10_i386 } + , "Linux_Ubuntu": { "unknown_versioning": deb10_i386 } + , "Linux_Mint" : { "unknown_versioning": deb10_i386 } + , "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 } } arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c1b7d3cf08da47f205044b1b9c96031c6431813 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c1b7d3cf08da47f205044b1b9c96031c6431813 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 13:06:37 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 09:06:37 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 59 commits: Define FFI_GO_CLOSURES Message-ID: <64a80ddd18069_31499caeec084892@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 5b55b0ad by Ben Gamari at 2023-07-06T14:29:43-04:00 Drop circle-ci-job.sh - - - - - 00f4a13e by Ben Gamari at 2023-07-06T14:29:43-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - b47106bf by Ben Gamari at 2023-07-06T15:32:27-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - d9e755db by Ben Gamari at 2023-07-06T15:49:02-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 0a0009fa by Ben Gamari at 2023-07-06T15:49:02-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ab287b6d by Ben Gamari at 2023-07-06T15:49:12-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - e7c2575d by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Introduce Data.Enum - - - - - b3d38941 by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Add export list to GHC.Num.Integer - - - - - febe1dad by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Add export list to GHC.Num - - - - - 3843b6be by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Add export list to GHC.Num.Natural - - - - - a2283fbf by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Introduce Data.Show - - - - - 72608729 by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Add export list to GHC.Float - - - - - 7920d385 by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Add export list to GHC.Real - - - - - f9f527e1 by Ben Gamari at 2023-07-06T15:49:12-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2c9923bc8e2d7a56f47d62dd97446b20d72e6b0...f9f527e13e152b92584ffdc90c69be4deafb62a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2c9923bc8e2d7a56f47d62dd97446b20d72e6b0...f9f527e13e152b92584ffdc90c69be4deafb62a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 13:37:47 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 09:37:47 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 4 commits: rts: Don't rely on initializers for sigaction_t Message-ID: <64a8152b89141_31499caee848579a@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 1c310adb by Ben Gamari at 2023-07-07T09:37:04-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. (cherry picked from commit 46c9bcd6a47bdaa70869ed64da315315974b8b1d) - - - - - a973a02c by Ben Gamari at 2023-07-07T09:37:05-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. (cherry picked from commit ec55035f8fe901b5d369221975fb1a741c677acb) - - - - - f1678282 by Ben Gamari at 2023-07-07T09:37:07-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. (cherry picked from commit 3a09b789102dc0ea20a9af0912bc817ac5cb8c59) - - - - - 02b96edd by Bryan Richter at 2023-07-07T09:37:23-04:00 Add missing void prototypes to rts functions See #23561. (cherry picked from commit 82ac6bf113526f61913943b911089534705984fb) - - - - - 30 changed files: - hadrian/src/Flavour.hs - hadrian/src/Settings/Warnings.hs - rts/CheckUnload.c - rts/ExecPage.c - rts/ForeignExports.c - rts/IPE.c - rts/Libdw.c - rts/Linker.c - rts/OldARMAtomic.c - rts/Printer.c - rts/ReportMemoryMap.c - rts/RtsAPI.c - rts/RtsMessages.c - rts/Schedule.c - rts/StaticPtrTable.c - rts/Stats.c - rts/Ticky.c - rts/Trace.c - rts/adjustor/LibffiAdjustor.c - rts/adjustor/NativeAmd64.c - rts/adjustor/NativeAmd64Mingw.c - rts/adjustor/NativeIA64.c - rts/adjustor/NativePowerPC.c - rts/adjustor/Nativei386.c - rts/eventlog/EventLog.c - rts/linker/PEi386.c - rts/posix/GetTime.c - rts/posix/Signals.c - rts/sm/BlockAlloc.c - rts/sm/GC.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/865b08e13daba291b8d1f12aa6a39f83a0baad02...02b96edd178865610b933f6441cd6985be039eea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/865b08e13daba291b8d1f12aa6a39f83a0baad02...02b96edd178865610b933f6441cd6985be039eea You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 13:50:12 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 07 Jul 2023 09:50:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/arm_immediates Message-ID: <64a81814329b4_31499caee0c87878@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/arm_immediates You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 13:53:50 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 07 Jul 2023 09:53:50 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] 334 commits: Turn "ambiguous import" error into a panic Message-ID: <64a818ee48492_31499caee5c880fd@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - c9ce5b44 by Andreas Klebinger at 2023-07-07T15:55:13+02:00 WIP: Better arm immediate handling - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/789466ae5dfc36ee109d3d4a46249c0721f02d86...c9ce5b44469f62b6f09e392719b460395d80621c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/789466ae5dfc36ee109d3d4a46249c0721f02d86...c9ce5b44469f62b6f09e392719b460395d80621c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 14:10:11 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 07 Jul 2023 10:10:11 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add comments and abstract over common case. Message-ID: <64a81cc3edf11_31499caee70940da@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 322969f4 by Jaro Reinders at 2023-07-07T16:09:59+02:00 Add comments and abstract over common case. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -524,6 +524,7 @@ assignReg_I64Code (CmmLocal dst) valueTree = do assignReg_I64Code _ _ = panic "assignReg_I64Code(i386): invalid lvalue" +-- TODO: add special cases for more efficiency. iselExpr64 :: HasDebugCallStack => CmmExpr -> NatM (RegCode64 InstrBlock) iselExpr64 (CmmLit (CmmInt i _)) = do @@ -551,7 +552,6 @@ iselExpr64 (CmmReg (CmmLocal local_reg)) = do let Reg64 hi lo = localReg64 local_reg return (RegCode64 nilOL hi lo) --- we handle addition, but rather badly iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 Reg64 rhi rlo <- getNewReg64 @@ -595,7 +595,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W32 W64) [expr]) = do code <- getAnyReg expr Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code r_dst_lo `snocOL` - MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi)) + XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi)) r_dst_hi r_dst_lo @@ -604,7 +604,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W16 W64) [expr]) = do Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code `appOL` toOL [ MOVZxL II16 (OpReg rsrc) (OpReg r_dst_lo), - MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi) + XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi) ]) r_dst_hi r_dst_lo @@ -614,7 +614,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv W8 W64) [expr]) = do Reg64 r_dst_hi r_dst_lo <- getNewReg64 return $ RegCode64 (code `appOL` toOL [ MOVZxL II8 (OpReg rsrc) (OpReg r_dst_lo), - MOV II32 (OpImm (ImmInt 0)) (OpReg r_dst_hi) + XOR II32 (OpReg r_dst_hi) (OpReg r_dst_hi) ]) r_dst_hi r_dst_lo @@ -663,6 +663,15 @@ iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do SBB II32 (OpReg rhi) (OpReg rohi) ] return (RegCode64 ocode rohi rolo) +-- To multiply two 64-bit numbers we use the following decomposition (in C notation): +-- +-- ((r1hi << 32) + r1lo) * ((r2hi << 32) + r2lo) +-- = ((r2lo * r1hi) << 32) +-- + ((r1lo * r2hi) << 32) +-- + r1lo * r2lo +-- +-- Note that @(r1hi * r2hi) << 64@ can be dropped because it overflows completely. + iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 RegCode64 code2 r2hi r2lo <- iselExpr64 e2 @@ -684,18 +693,25 @@ iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) +-- To shift a 64-bit number to the left we use the SHLD and SAL instructions. +-- We use SHLD to shift the bits in @rhi@ to the left while copying +-- high bits from @rlo@ to fill the new space in the low bits of @rhi at . +-- That leaves @rlo@ unchanged, so we use SAL to shift the bits of @rlo@ left. +-- However, both these instructions only use the lowest 5 bits from %cl to do +-- their shifting. So if the sixth bit (0x32) is set then we additionally move +-- the contents of @rlo@ to @rhi@ and clear @rlo at . + iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - (r2, code2) <- getSomeReg e2 + code2 <- getAnyReg e2 Reg64 rhi rlo <- getNewReg64 lbl1 <- newBlockId lbl2 <- newBlockId let code = code1 `appOL` - code2 `appOL` + code2 ecx `appOL` toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), MOV II32 (OpReg r1hi) (OpReg rhi), - MOV II32 (OpReg r2) (OpReg ecx), SHLD II32 (OpReg ecx) (OpReg rlo) (OpReg rhi), SAL II32 (OpReg ecx) (OpReg rlo), TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), @@ -709,6 +725,12 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) +-- Similar to above, however now we're shifting to the right +-- and we're doing a signed shift which means that @rhi@ needs +-- to be set to either 0 if @rhi@ is positive or 0xffffffff otherwise, +-- and if the sixth bit of %cl is set (so the shift amount is more than 32). +-- To accomplish that we shift @rhi@ by 31. + iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 (r2, code2) <- getSomeReg e2 @@ -734,6 +756,8 @@ iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) +-- Similar to the above. + iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 (r2, code2) <- getSomeReg e2 @@ -759,47 +783,9 @@ iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) -iselExpr64 (CmmMachOp (MO_And _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - Reg64 rhi rlo <- getNewReg64 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - AND II32 (OpReg r2lo) (OpReg rlo), - AND II32 (OpReg r2hi) (OpReg rhi) - ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmMachOp (MO_Or _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - Reg64 rhi rlo <- getNewReg64 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - OR II32 (OpReg r2lo) (OpReg rlo), - OR II32 (OpReg r2hi) (OpReg rhi) - ] - return (RegCode64 code rhi rlo) - -iselExpr64 (CmmMachOp (MO_Xor _) [e1,e2]) = do - RegCode64 code1 r1hi r1lo <- iselExpr64 e1 - RegCode64 code2 r2hi r2lo <- iselExpr64 e2 - Reg64 rhi rlo <- getNewReg64 - let - code = code1 `appOL` - code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), - MOV II32 (OpReg r1hi) (OpReg rhi), - XOR II32 (OpReg r2lo) (OpReg rlo), - XOR II32 (OpReg r2hi) (OpReg rhi) - ] - return (RegCode64 code rhi rlo) +iselExpr64 (CmmMachOp (MO_And _) [e1,e2]) = iselExpr64ParallelBin AND e1 e2 +iselExpr64 (CmmMachOp (MO_Or _) [e1,e2]) = iselExpr64ParallelBin OR e1 e2 +iselExpr64 (CmmMachOp (MO_Xor _) [e1,e2]) = iselExpr64ParallelBin XOR e1 e2 iselExpr64 (CmmMachOp (MO_Not _) [e1]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 @@ -820,6 +806,21 @@ iselExpr64 expr platform <- getPlatform pprPanic "iselExpr64(i386)" (pdoc platform expr $+$ text (show expr)) +iselExpr64ParallelBin :: (Format -> Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM (RegCode64 (OrdList Instr)) +iselExpr64ParallelBin op e1 e2 = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + op II32 (OpReg r2lo) (OpReg rlo), + op II32 (OpReg r2hi) (OpReg rhi) + ] + return (RegCode64 code rhi rlo) -------------------------------------------------------------------------------- getRegister :: CmmExpr -> NatM Register View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/322969f420962a528a05f60be29c02237009bd23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/322969f420962a528a05f60be29c02237009bd23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 14:14:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 10:14:01 -0400 Subject: [Git][ghc/ghc][wip/ipe-section] 45 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64a81da9818d5_31499caee0c9435d@gitlab.mail> Ben Gamari pushed to branch wip/ipe-section at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - 4eb41f62 by Ben Gamari at 2023-07-07T09:56:33-04:00 compiler: Place IPE information in separate section Previously IPE information would end up in the `.data` section. Not only does this make it difficult to measure the size of the IPE metadata, but by placing it in its own section we reduce the probability of the (generally rather large) IPE metadata inducing large displacements at link-time. Moreover, we can now in principle allow the data to be stripped post-build; we would merely need to sort out how to make the could - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/973bc9aac04d39f0472d9c12570c9b5dd2e3c8f0...4eb41f6216e6c2366d99e14eca88d916c40c0523 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/973bc9aac04d39f0472d9c12570c9b5dd2e3c8f0...4eb41f6216e6c2366d99e14eca88d916c40c0523 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 14:17:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 10:17:18 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] compiler: Record original thunk info tables on stack Message-ID: <64a81e6e10065_31499caee48961a4@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: b68b9814 by Ben Gamari at 2023-07-07T10:16:58-04:00 compiler: Record original thunk info tables on stack - - - - - 13 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - docs/users_guide/debugging.rst - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - + testsuite/tests/codeGen/should_run/OrigThunkInfo.hs - + testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout - testsuite/tests/codeGen/should_run/all.T - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -41,6 +41,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -338,6 +338,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -576,6 +577,7 @@ codeGenFlags = EnumSet.fromList -- Flags that affect debugging information , Opt_DistinctConstructorTables , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2355,6 +2355,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -50,6 +50,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== docs/users_guide/debugging.rst ===================================== @@ -1115,6 +1115,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.hs ===================================== @@ -0,0 +1,4 @@ +module Main where +xs = iterate (+1) 0 +ten = xs !! 10 +main = print ten ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout ===================================== @@ -0,0 +1,2 @@ +10 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,4 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) +test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b68b981494d140bab48b523146a892217bc94c3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b68b981494d140bab48b523146a892217bc94c3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 14:33:25 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 07 Jul 2023 10:33:25 -0400 Subject: [Git][ghc/ghc][wip/T23576] Remove SAL and use the equivalent SHL instead Message-ID: <64a82235a6b22_31499caee5c103369@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 69cdcfe5 by Jaro Reinders at 2023-07-07T16:33:17+02:00 Remove SAL and use the equivalent SHL instead - - - - - 3 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -693,10 +693,10 @@ iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) --- To shift a 64-bit number to the left we use the SHLD and SAL instructions. +-- To shift a 64-bit number to the left we use the SHLD and SHL instructions. -- We use SHLD to shift the bits in @rhi@ to the left while copying -- high bits from @rlo@ to fill the new space in the low bits of @rhi at . --- That leaves @rlo@ unchanged, so we use SAL to shift the bits of @rlo@ left. +-- That leaves @rlo@ unchanged, so we use SHL to shift the bits of @rlo@ left. -- However, both these instructions only use the lowest 5 bits from %cl to do -- their shifting. So if the sixth bit (0x32) is set then we additionally move -- the contents of @rlo@ to @rhi@ and clear @rlo at . @@ -713,7 +713,7 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), MOV II32 (OpReg r1hi) (OpReg rhi), SHLD II32 (OpReg ecx) (OpReg rlo) (OpReg rhi), - SAL II32 (OpReg ecx) (OpReg rlo), + SHL II32 (OpReg ecx) (OpReg rlo), TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), JXX EQQ lbl2, JXX ALWAYS lbl1, ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -248,7 +248,6 @@ data Instr -- Shifts (amount may be immediate or %cl only) | SHL Format Operand{-amount-} Operand | SAR Format Operand{-amount-} Operand - | SAL Format Operand{-amount-} Operand | SHR Format Operand{-amount-} Operand | SHRD Format Operand{-amount-} Operand Operand | SHLD Format Operand{-amount-} Operand Operand @@ -400,7 +399,6 @@ regUsageOfInstr platform instr BSWAP _ reg -> mkRU [reg] [reg] NEGI _ op -> usageM op SHL _ imm dst -> usageRM imm dst - SAL _ imm dst -> usageRM imm dst SAR _ imm dst -> usageRM imm dst SHR _ imm dst -> usageRM imm dst SHLD _ imm dst1 dst2 -> usageRMM imm dst1 dst2 @@ -572,7 +570,6 @@ patchRegsOfInstr instr env BSWAP fmt reg -> BSWAP fmt (env reg) NEGI fmt op -> patch1 (NEGI fmt) op SHL fmt imm dst -> patch1 (SHL fmt imm) dst - SAL fmt imm dst -> patch1 (SAL fmt imm) dst SAR fmt imm dst -> patch1 (SAR fmt imm) dst SHR fmt imm dst -> patch1 (SHR fmt imm) dst SHLD fmt imm dst1 dst2 -> patch2 (SHLD fmt imm) dst1 dst2 ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -726,9 +726,6 @@ pprInstr platform i = case i of SHL format src dst -> pprShift (text "shl") format src dst - SAL format src dst - -> pprShift (text "sal") format src dst - SAR format src dst -> pprShift (text "sar") format src dst View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69cdcfe58588832e041fbb4f1967180fd82c36cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69cdcfe58588832e041fbb4f1967180fd82c36cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:00:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 11:00:44 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] 52 commits: Define FFI_GO_CLOSURES Message-ID: <64a8289c2c67d_31499caee5c109094@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - dc130d1d by Ben Gamari at 2023-07-07T10:32:01-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30643a1b5c606232cec50af9aa784a27c745913e...dc130d1db3c922d29cd444dec16160a8be0d43b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30643a1b5c606232cec50af9aa784a27c745913e...dc130d1db3c922d29cd444dec16160a8be0d43b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:08:18 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 07 Jul 2023 11:08:18 -0400 Subject: [Git][ghc/ghc][wip/or-pats] 16 commits: Improve the situation with the stimes cycle Message-ID: <64a82a623c94e_31499caee841163dd@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - 87553e33 by David Knothe at 2023-07-07T17:08:08+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. stuff Implement empty one of Prohibit TyApps Remove unused update submodule haddock Update tests Parser.y - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/314ae17cb431d7bf26a34fab388ff8db5908ec8e...87553e331df7bc889ad0890f28e623dac443e14e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/314ae17cb431d7bf26a34fab388ff8db5908ec8e...87553e331df7bc889ad0890f28e623dac443e14e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:20:27 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 07 Jul 2023 11:20:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23578 Message-ID: <64a82d3b7af64_31499caee8412077d@gitlab.mail> Jaro Reinders pushed new branch wip/T23578 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23578 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:27:14 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 07 Jul 2023 11:27:14 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 2 commits: Comments only Message-ID: <64a82ed211648_31499caee5c120918@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 13033d34 by Simon Peyton Jones at 2023-07-07T13:52:23+01:00 Comments only - - - - - 4197f388 by Simon Peyton Jones at 2023-07-07T16:26:29+01:00 Fixes for T15630 What a struggle. Finally understood exponential behaviour - - - - - 6 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/SimpleOpt.hs - testsuite/tests/perf/compiler/T15630a.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1155,6 +1155,7 @@ mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2) mkTransCo co1 co2 = TransCo co1 co2 +-------------------- mkSelCo :: HasDebugCallStack => CoSel -> Coercion @@ -1243,6 +1244,24 @@ getNthFun SelMult mult _ _ = mult getNthFun SelArg _ arg _ = arg getNthFun SelRes _ _ res = res +getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type +getNthFromType (SelFun fs) ty + | Just (_af, mult, arg, res) <- splitFunTy_maybe ty + = getNthFun fs mult arg res + +getNthFromType (SelTyCon n _) ty + | Just args <- tyConAppArgs_maybe ty + = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $ + args `getNth` n + +getNthFromType SelForAll ty -- Works for both tyvar and covar + | Just (tv,_) <- splitForAllTyCoVar_maybe ty + = tyVarKind tv + +getNthFromType cs ty + = pprPanic "getNthFromType" (ppr cs $$ ppr ty) + +-------------------- mkLRCo :: LeftOrRight -> Coercion -> Coercion mkLRCo lr co | Just (ty, eq) <- isReflCo_maybe co @@ -2457,23 +2476,6 @@ coercionLKind co go_app (InstCo co arg) args = go_app co (go arg:args) go_app co args = piResultTys (go co) args -getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type -getNthFromType (SelFun fs) ty - | Just (_af, mult, arg, res) <- splitFunTy_maybe ty - = getNthFun fs mult arg res - -getNthFromType (SelTyCon n _) ty - | Just args <- tyConAppArgs_maybe ty - = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $ - args `getNth` n - -getNthFromType SelForAll ty -- Works for both tyvar and covar - | Just (tv,_) <- splitForAllTyCoVar_maybe ty - = tyVarKind tv - -getNthFromType cs ty - = pprPanic "getNthFromType" (ppr cs $$ ppr ty) - coercionRKind :: Coercion -> Type coercionRKind co = go co ===================================== compiler/GHC/Core/Opt/Simplify/Inline.hs ===================================== @@ -89,14 +89,14 @@ StrictAnal.addStrictnessInfoToTopId callSiteInline :: Logger -> UnfoldingOpts - -> Int -- Case depth + -> Int -> Int -- Case depth -> Id -- The Id -> Bool -- True <=> unfolding is active -> Bool -- True if there are no arguments at all (incl type args) -> [ArgSummary] -- One for each value arg; True if it is interesting -> CallCtxt -- True <=> continuation is interesting -> Maybe CoreExpr -- Unfolding, if any -callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_infos cont_info +callSiteInline logger opts !case_depth !inline_depth id active_unfolding lone_variable arg_infos cont_info = case idUnfolding id of -- idUnfolding checks for loop-breakers, returning NoUnfolding -- Things with an INLINE pragma may have an unfolding *and* @@ -104,7 +104,7 @@ callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_inf CoreUnfolding { uf_tmpl = unf_template , uf_cache = unf_cache , uf_guidance = guidance } - | active_unfolding -> tryUnfolding logger opts case_depth id lone_variable + | active_unfolding -> tryUnfolding logger opts case_depth inline_depth id lone_variable arg_infos cont_info unf_template unf_cache guidance | otherwise -> traceInline logger opts id "Inactive unfolding:" (ppr id) Nothing @@ -227,10 +227,10 @@ needed on a per-module basis. -} -tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt +tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt -> CoreExpr -> UnfoldingCache -> UnfoldingGuidance -> Maybe CoreExpr -tryUnfolding logger opts !case_depth id lone_variable arg_infos +tryUnfolding logger opts !case_depth !inline_depth id lone_variable arg_infos cont_info unf_template unf_cache guidance = case guidance of UnfNever -> traceInline logger opts id str (text "UnfNever") Nothing @@ -264,6 +264,7 @@ tryUnfolding logger opts !case_depth id lone_variable arg_infos discount = computeDiscount arg_discounts res_discount arg_infos cont_info extra_doc = vcat [ text "case depth =" <+> int case_depth + , text "inline depth =" <+> int inline_depth , text "depth based penalty =" <+> int depth_penalty , text "discounted size =" <+> int adjusted_size ] where ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -420,11 +420,13 @@ simplAuxBind _str env bndr new_rhs -- The cases would be inlined unconditionally by completeBind: -- but it seems not uncommon, and it turns to be a little more -- efficient (in compile time allocations) to do it here. + -- Effectively this is just a poor man's postInlineUnconditionally -- See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils -- Note: auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings | exprIsTrivial new_rhs -- Short-cut for let x = y in ... || case (idOccInfo bndr) of - OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> True + OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> -- pprTrace ("simplAuxBind:"++_str) (ppr bndr $$ ppr new_rhs) + True _ -> False = return ( emptyFloats env , case new_rhs of @@ -1563,7 +1565,7 @@ completeBindX env from_what bndr rhs body cont bndr2 (emptyFloats env) rhs -- NB: it makes a surprisingly big difference (5% in compiler allocation -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. + -- because this is completeBindX, so bndr is not in scope in the RHS. ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) (BC_Let NotTopLevel NonRecursive) @@ -1672,8 +1674,7 @@ simplCast env body co0 cont0 ; case m_co1 of { MRefl -> return (cont { sc_cont = tail' , sc_hole_ty = coercionLKind co }) ; - -- Avoid simplifying if possible; - -- See Note [Avoiding exponential behaviour] + -- See Note [Avoiding simplifying repeatedly] MCo co1 -> do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg @@ -1754,7 +1755,7 @@ simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se ; let arg_ty = funArgTy fun_ty ; if | isSimplified dup -- Don't re-simplify if we've simplified it once -- Including don't preInlineUnconditionally - -- See Note [Avoiding exponential behaviour] + -- See Note [Avoiding simplifying repeatedly] -> completeBindX env (FromBeta arg_ty) bndr arg body cont | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se @@ -1888,27 +1889,35 @@ Simplifier without first calling SimpleOpt, so anything involving GHCi or TH and operator sections will fall over if we don't take care here. -Note [Avoiding exponential behaviour] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Avoiding simplifying repeatedly] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression (#13379). That is why simplNonRecX does not try -preInlineUnconditionally (unlike simplNonRecE). +an expression (#13379). Example: f BIG, where f has a RULE Then * We simplify BIG before trying the rule; but the rule does not fire - * We inline f = \x. x True - * So if we did preInlineUnconditionally we'd re-simplify (BIG True) + (forcing this simplification is why we have the RULE in this example) + * We inline f = \x. g x, in `simpl_lam` + * So if `simpl_lam` did preInlineUnconditionally we get (g BIG) + * Now if g has a RULE we'll simplify BIG again, and this whole thing can + iterate. + * However, if `f` did not have a RULE, so that BIG has /not/ already been + simplified, we /want/ to do preInlineUnconditionally in simpl_lam. + +So we go to some effort to avoid repeatedly simplifying the same thing: -However, if BIG has /not/ already been simplified, we'd /like/ to -simplify BIG True; maybe good things happen. That is why +* ApplyToVal has a (sc_dup :: DupFlag) field which records if the argument + has been evaluated. -* simplLam has - - a case for (isSimplified dup), which goes via simplNonRecX, and - - a case for the un-simplified case, which goes via simplNonRecE +* simplArg checks this flag to avoid re-simplifying. + +* simpl_lam has: + - a case for (isSimplified dup), which goes via completeBindX, and + - a case for an un-simplified argument, which tries preInlineUnconditionally * We go to some efforts to avoid unnecessarily simplifying ApplyToVal, in at least two places @@ -1916,6 +1925,11 @@ simplify BIG True; maybe good things happen. That is why - In rebuildCall we avoid simplifying arguments before we have to (see Note [Trying rewrite rules]) +All that said /postInlineUnconditionally/ (called in `completeBind`) does +fire in the above (f BIG) situation. See Note [Post-inline for single-use +things] in Simplify.Utils. This certainly risks repeated simplification, but +in practice seems to be a small win. + ************************************************************************ * * @@ -2321,7 +2335,7 @@ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont ----------------------------------- tryInlining :: SimplEnv -> Logger -> OutId -> SimplCont -> SimplM (Maybe OutExpr) tryInlining env logger var cont - | Just expr <- callSiteInline logger uf_opts case_depth var active_unf + | Just expr <- callSiteInline logger uf_opts case_depth inline_depth var active_unf lone_variable arg_infos interesting_cont = do { dump_inline expr cont ; return (Just expr) } @@ -2332,6 +2346,7 @@ tryInlining env logger var cont where uf_opts = seUnfoldingOpts env case_depth = seCaseDepth env + inline_depth = seInlineDepth env (lone_variable, arg_infos, call_cont) = contArgs cont interesting_cont = interestingCallContext env call_cont active_unf = activeUnfolding (seMode env) var @@ -3845,7 +3860,7 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty mkDupableAlt :: SimplEnv -> OutId -> JoinFloats -> OutAlt -> SimplM (JoinFloats, OutAlt) -mkDupableAlt env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) +mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) | ok_to_dup_alt case_bndr alt_bndrs alt_rhs_in -- See point (2) of Note [Duplicating join points] = return (jfloats, Alt con alt_bndrs alt_rhs_in) @@ -3895,12 +3910,14 @@ mkDupableAlt env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) join_rhs = mkLams (map zapIdUnfolding final_bndrs) rhs_with_seqs ; join_bndr <- newJoinId filtered_binders rhs_ty' - ; let join_bndr_w_unf = join_bndr `setIdUnfolding` - mkUnfolding uf_opts VanillaSrc False False join_rhs Nothing - uf_opts = seUnfoldingOpts env + ; let -- join_bndr_w_unf = join_bndr `setIdUnfolding` + -- mkUnfolding uf_opts VanillaSrc False False join_rhs Nothing + -- uf_opts = seUnfoldingOpts env + join_bndr_w_unf = join_bndr join_call = mkApps (Var join_bndr) final_args alt' = Alt con alt_bndrs join_call +-- ; pprTrace "Creating join point" (ppr join_bndr <+> equals <+> ppr join_rhs) $ return () ; return ( jfloats `addJoinFlts` unitJoinFloat (NonRec join_bndr_w_unf join_rhs) , alt') } -- See Note [Duplicated env] @@ -4312,6 +4329,7 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf let !opts = seUnfoldingOpts env in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs where + -- See Note [Exponential join point inlining] too_many_occs (ManyOccs {}) = True too_many_occs (OneOcc { occ_n_br = n }) = n > 10 too_many_occs IAmDead = False ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -287,9 +287,9 @@ instance Outputable SimplCont where = (text "StrictBind" <+> ppr b) $$ ppr cont ppr (StrictArg { sc_fun = ai, sc_cont = cont }) = (text "StrictArg" <+> ppr (ai_fun ai)) $$ ppr cont - ppr (Select { sc_dup = dup, sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont }) + ppr (Select { sc_dup = dup, sc_bndr = bndr, sc_alts = alts, sc_cont = cont }) = (text "Select" <+> ppr dup <+> ppr bndr) $$ - whenPprDebug (nest 2 $ vcat [ppr (seTvSubst se), ppr alts]) $$ ppr cont + whenPprDebug (nest 2 $ ppr alts) $$ ppr cont {- Note [The hole type in ApplyToTy] @@ -1542,13 +1542,14 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt, occ_n_br = n_br } -- See Note [Inline small things to avoid creating a thunk] + | let not_inside_lam = in_lam == NotInsideLam -> n_br < 100 -- See Note [Suppress exponential blowup] - && ( (n_br == 1) -- See Note [Post-inline for single-use things] + && ( (n_br == 1 && not_inside_lam) -- See Note [Post-inline for single-use things] || smallEnoughToInline uf_opts unfolding) -- Small enough to dup -- ToDo: consider discount on smallEnoughToInline if int_cxt is true - && (in_lam == NotInsideLam || + && (not_inside_lam || -- Outside a lambda, we want to be reasonably aggressive -- about inlining into multiple branches of case -- e.g. let x = @@ -1595,7 +1596,6 @@ in allocation if you miss this out. And bits of GHC itself start to allocate more. An egregious example is test perf/compiler/T14697, where GHC.Driver.CmdLine.$wprocessArgs allocated hugely more. - Note [Post-inline for single-use things] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If we have @@ -1617,27 +1617,29 @@ we risk creating which will take another iteration of the Simplifier to eliminate. We do this in two places -1. `simplAuxBind` does a kind of poor-man's `postInlineUnconditionally`. It - does not need to account for many of the cases (e.g. top level) that the - full `postInlineUnconditionally` does. Moreover, we don't have an - OutId, which `postInlineUnconditionally` needs. - -2. In the full `postInlineUnconditionally` we also look for the special case - of "one occurrence, not under a lambda". - +1. In the full `postInlineUnconditionally` look for the special case + of "one occurrence, not under a lambda", and inline unconditionally then. --- Here's an example that we don't handle well: --- let f = if b then Left (\x.BIG) else Right (\y.BIG) --- in \y. ....case f of {...} .... --- Here f is used just once, and duplicating the case work is fine (exprIsCheap). --- But --- - We can't preInlineUnconditionally because that would invalidate --- the occ info for b. --- - We can't postInlineUnconditionally because the RHS is big, and --- that risks exponential behaviour --- - We can't call-site inline, because the rhs is big --- Alas! + This is a bit risky: see Note [Avoiding simplifying repeatedly] in + Simplify.Iteration. But in practice it seems to be a small win. +2. `simplAuxBind` does a kind of poor-man's `postInlineUnconditionally`. It + does not need to account for many of the cases (e.g. top level) that the + full `postInlineUnconditionally` does. Moreover, we don't have an + OutId, which `postInlineUnconditionally` needs. I got a slight improvement + in compiler performance when I added this test. + +Here's an example that we don't currently handle well: + let f = if b then Left (\x.BIG) else Right (\y.BIG) + in \y. ....case f of {...} .... +Here f is used just once, and duplicating the case work is fine (exprIsCheap). +But + - We can't preInlineUnconditionally because that would invalidate + the occ info for b. + - We can't postInlineUnconditionally because the RHS is big, and + that risks exponential behaviour + - We can't call-site inline, because the rhs is big +Alas! Note [Suppress exponential blowup] @@ -1658,6 +1660,16 @@ to j9a and two to j9b. In pass 2, postInlineUnconditionally inlines all four of these calls, leaving four calls to j8a and j8b. Etc. Yikes! This is exponential! +A similar case + let j1 x = ... + j2 x = ...jump j1 (x-1).....jump j1 (x-2) + ... + in case f (y+10) of { True -> jump j10 10; False -> j10 10 } + +In the RHS of j1..j10, no inlining happens because the calls don't look +exciting enough. But in the "in" part, the call-site inliner may inline +j10 (since it is applied to 10). That exposts +In each A possible plan: stop doing postInlineUnconditionally for some fixed, smallish number of branches, say 4. But that turned out to be bad: see Note [Inline small things to avoid creating a thunk]. ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -1296,7 +1296,7 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr in go subst' (float:floats) expr cont go subst floats (Case scrut b _ [Alt con vars expr]) cont - | do_case_elim scrut' b vars + | do_case_elim scrut' b vars -- See Note [Case elim in exprIsConApp_maybe] = go (extend subst b scrut') floats expr cont | otherwise = let @@ -1427,6 +1427,27 @@ dealWithStringLiteral fun str co = in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co {- +Note [Case elim in exprIsConApp_maybe] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + data K a = MkK !a + + $WMkK x = case x of y -> K y -- Wrapper for MkK + + ...case $WMkK v of K w -> + +We call `exprIsConApp_maybe` on ($WMkK v); we inline the wrapper +and beta-reduce, so we get to + exprIsConApp_maybe (case v of y -> K y) + +So we may float the case, and end up with + case v of y -> [y/w] + +But if `v` is already evaluated, the next run of the Simplifier will +eliminate the case, and we may then make more progress with . +Better to do it in one iteration. Hence the `do_case_elim` +check in `exprIsConApp_maybe`. + Note [Unfolding DFuns] ~~~~~~~~~~~~~~~~~~~~~~ DFuns look like ===================================== testsuite/tests/perf/compiler/T15630a.hs ===================================== @@ -1,4 +1,4 @@ -module T15630 where +module T15630a where data IValue = IDefault | IInt Int View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9cb540eb7a61621830fda2263fe1f744c5e80002...4197f38879c95b907c800171460dce4b59b10a2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9cb540eb7a61621830fda2263fe1f744c5e80002...4197f38879c95b907c800171460dce4b59b10a2b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:27:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 11:27:22 -0400 Subject: [Git][ghc/ghc][wip/T23554] 52 commits: Define FFI_GO_CLOSURES Message-ID: <64a82eda33514_31499caeec012173c@gitlab.mail> Ben Gamari pushed to branch wip/T23554 at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - 7136ec6b by Ben Gamari at 2023-07-07T11:27:00-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f18ee56d544b0e8c0aca6d416f7f95da992ef2b6...7136ec6b08c745460da3a04db03476792d5f8d54 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f18ee56d544b0e8c0aca6d416f7f95da992ef2b6...7136ec6b08c745460da3a04db03476792d5f8d54 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:33:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 07 Jul 2023 11:33:10 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Drop circle-ci-job.sh Message-ID: <64a83036300d1_31499caeeac128122@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 7 changed files: - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== .gitlab/ci.sh ===================================== @@ -43,12 +43,13 @@ $0 - GHC continuous integration driver Common Modes: - usage Show this usage message. - setup Prepare environment for a build. - configure Run ./configure. - clean Clean the tree - shell Run an interactive shell with a configured build environment. - save_cache Preserve the cabal cache + usage Show this usage message. + setup Prepare environment for a build. + configure Run ./configure. + clean Clean the tree + shell Run an interactive shell with a configured build environment. + save_test_output Generate unexpected-test-output.tar.gz + save_cache Preserve the cabal cache Hadrian build system build_hadrian Build GHC via the Hadrian build system @@ -614,12 +615,16 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --docs=none \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "cross-compiled hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "cross-compiled hadrian main testsuite" elif [[ -n "${CROSS_TARGET:-}" ]] && [[ "${CROSS_TARGET:-}" == *"wasm"* ]]; then run_hadrian \ test \ --summary-junit=./junit.xml \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite targetting $CROSS_TARGET" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite targetting $CROSS_TARGET" elif [ -n "${CROSS_TARGET:-}" ]; then local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -635,7 +640,9 @@ function test_hadrian() { --test-compiler=stage-cabal \ --test-root-dirs=testsuite/tests/perf \ --test-root-dirs=testsuite/tests/typecheck \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian cabal-install test" else local instdir="$TOP/_build/install" local test_compiler="$instdir/bin/${cross_prefix}ghc$exe" @@ -673,12 +680,13 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { @@ -770,6 +778,10 @@ function run_abi_test() { check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes" } +function save_test_output() { + tar -czf unexpected-test-output.tar.gz unexpected-test-output +} + function save_cache () { info "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..." rm -Rf "$CABAL_CACHE" @@ -935,6 +947,7 @@ case ${1:-help} in lint_author) shift; lint_author "$@" ;; compare_interfaces_of) shift; compare_interfaces_of "$@" ;; clean) clean ;; + save_test_output) save_test_output ;; save_cache) save_cache ;; shell) shift; shell "$@" ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/circle-ci-job.sh deleted ===================================== @@ -1,110 +0,0 @@ -# Circle CI "backend" for Gitlab CI -# ================================= -# -# Usage example: -# .gitlab/circle-ci-job.sh validate-x86_64-linux -# -# There are two things to configure to get artifacts to be -# uploaded to gitlab properly: -# -# - At https:///admin/application_settings, expand the -# Continuous Integration and Deployment section and set the -# "Maximum artifacts size (MB)" field to something large enough -# to contain the bindists (the test reports are tiny in comparison). -# 500MB seems to work fine, but 200MB might be sufficient. -# -# - If gitlab is exposed behind some form of proxy (e.g nginx), make sure -# the maximum client request body size is large enough to contain all the -# artifacts of a build. For nginx, this would be the following configuration -# option: https://nginx.org/en/docs/http/ngx_http_core_module.html#client_max_body_size -# (which can be set with services.nginx.clientMaxBodySize on nixos). - -#!/usr/bin/env sh - -set -e - -GHCCI_URL="localhost:8888" - -[ $# -gt 0 ] || (echo You need to pass the Circle CI job type as argument to this script; exit 1) -[ ${CI_RUNNER_ID:-} ] || (echo "CI_RUNNER_ID is not set"; exit 1) -[ ${CI_JOB_ID:-} ] || (echo "CI_JOB_ID is not set"; exit 1) -[ ${CI_COMMIT_SHA:-} ] || (echo "CI_COMMIT_SHA is not set"; exit 1) -[ ${CI_REPOSITORY_URL:-} ] || (echo "CI_REPOSITORY_URL is not set"; exit 1) -[ ${CI_PIPELINE_ID:-} ] || (echo "CI_PIPELINE_ID is not set"; exit 1) -# the first argument to this script is the Circle CI job type: -# validate-x86_64-linux, validate-i386-linux, ... -CIRCLE_JOB="circleci-$1" - -gitlab_user=$(echo $CI_REPOSITORY_URL | cut -d/ -f4) -gitlab_repo=$(echo $CI_REPOSITORY_URL | cut -d/ -f5 | cut -d. -f1) - -BODY="{ \"jobType\": \"$CIRCLE_JOB\", \"source\": { \"user\": \"$gitlab_user\", \"project\":\"$gitlab_repo\", \"commit\":\"$CI_COMMIT_SHA\" }, \"pipelineID\": $CI_PIPELINE_ID, \"runnerID\": $CI_RUNNER_ID, \"jobID\": $CI_JOB_ID }" - - -RESP=$(curl -s -XPOST -H "Content-Type: application/json" -d "$BODY" \ - http://${GHCCI_URL}/job) - -if [ $? -eq 0 ]; then - build_num=$(echo $RESP | jq '.build_num') - circle_url=$(echo $RESP | jq '.url') -else - echo "Couldn't submit job" - echo $RESP - exit 1 -fi - -echo Circle CI build number: $build_num -echo Circle CI build page: $circle_url - -outcome="null" -STATUS_URL="http://${GHCCI_URL}/job/${build_num}" -STATUS_RESP="" - -while [ "$outcome" == "null" ]; do - sleep 30s - STATUS_RESP=$(curl -s $STATUS_URL) - if [ $? -eq 0 ]; then - new_outcome=$(echo $STATUS_RESP | jq '.outcome') - jq_exitcode=$? - if [ "$new_outcome" == "null" ] && [ $jq_exitcode -ne 0 ]; then - echo "Couldn't read 'outcome' field in JSON:" - echo $STATUS_RESP - echo "Skipping" - else - outcome="$new_outcome" - fi - else - echo "curl failed:" - echo $STATUS_RESP - echo "Skipping" - fi -done - -if [ "$outcome" == "\"success\"" ]; then - echo The build passed - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - exit 0 -else - echo The build failed - - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - - failing_step=$(echo $STATUS_RESP | jq '.steps | .[] | .actions | .[] | select(.status != "success")') - failing_step_name=$(echo $failing_step | jq '.name' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing step: $failing_step_name" - - failing_cmds=$(echo $failing_step | jq '.bash_command' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing command(s):" - echo $failing_cmds - - log_url=$(echo $failing_step | jq '.output_url' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Log url: $log_url" - - last_log_lines=$(curl -s $log_url | gunzip | jq '.[] | select(.type == "out") | .message' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/' | tail -50) - echo End of the build log: - echo $last_log_lines - - exit 1 -fi ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -680,10 +680,12 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAfterScript | Windows <- opsys = [ "bash .gitlab/ci.sh save_cache" + , "bash .gitlab/ci.sh save_test_output" , "bash .gitlab/ci.sh clean" ] | otherwise = [ ".gitlab/ci.sh save_cache" + , ".gitlab/ci.sh save_test_output" , ".gitlab/ci.sh clean" , "cat ci_timings" ] @@ -706,16 +708,19 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } Emulator s -> "CROSS_EMULATOR" =: s NoEmulatorNeeded -> mempty , if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty - , if validateNonmovingGc buildConfig - then "RUNTEST_ARGS" =: "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" - else mempty + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -3,6 +3,7 @@ "aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -11,7 +12,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,12 +61,14 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, "aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -73,7 +77,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,12 +122,14 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, "i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -131,7 +138,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,12 +183,14 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, "nightly-aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -189,7 +199,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +248,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -244,6 +256,7 @@ "nightly-aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -252,7 +265,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +310,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -303,6 +318,7 @@ "nightly-aarch64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -311,7 +327,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +372,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -362,6 +380,7 @@ "nightly-i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -370,7 +389,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +434,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -421,6 +442,7 @@ "nightly-x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -429,7 +451,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +500,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -487,6 +511,7 @@ "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -495,7 +520,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +567,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -548,6 +575,7 @@ "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -556,7 +584,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +632,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -610,6 +640,7 @@ "nightly-x86_64-linux-alpine3_12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -618,7 +649,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +697,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -672,6 +705,7 @@ "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -680,7 +714,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +762,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -734,6 +770,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -742,7 +779,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +826,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -795,6 +834,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -803,7 +843,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +890,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -856,6 +898,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -864,7 +907,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +954,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -917,6 +962,7 @@ "nightly-x86_64-linux-centos7-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -925,7 +971,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1017,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -977,6 +1025,7 @@ "nightly-x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -985,7 +1034,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1079,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1036,6 +1087,7 @@ "nightly-x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1044,7 +1096,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1141,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1095,6 +1149,7 @@ "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1103,7 +1158,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1204,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1155,6 +1212,7 @@ "nightly-x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1163,7 +1221,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1266,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1214,6 +1274,7 @@ "nightly-x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1222,7 +1283,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1328,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1273,6 +1336,7 @@ "nightly-x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1281,7 +1345,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1390,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1332,6 +1398,7 @@ "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1340,7 +1407,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1391,6 +1460,7 @@ "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1399,7 +1469,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1515,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1452,6 +1524,7 @@ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1460,7 +1533,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1580,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1513,6 +1588,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1521,7 +1597,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1645,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", "XZ_OPT": "-9" } @@ -1575,6 +1653,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1583,7 +1662,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1630,6 +1710,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1637,6 +1718,7 @@ "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1645,7 +1727,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1689,6 +1772,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1696,6 +1780,7 @@ "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1704,7 +1789,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1756,6 +1842,7 @@ "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1764,7 +1851,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1808,6 +1896,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1815,6 +1904,7 @@ "nightly-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1823,7 +1913,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1960,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1876,6 +1968,7 @@ "nightly-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1884,7 +1977,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1931,6 +2025,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1938,6 +2033,7 @@ "nightly-x86_64-linux-fedora33-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1946,7 +2042,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1992,6 +2089,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1999,6 +2097,7 @@ "nightly-x86_64-linux-rocky8-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2007,7 +2106,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2052,6 +2152,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2059,6 +2160,7 @@ "nightly-x86_64-linux-ubuntu18_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2067,7 +2169,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2111,6 +2214,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2118,6 +2222,7 @@ "nightly-x86_64-linux-ubuntu20_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2126,7 +2231,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2170,6 +2276,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2177,6 +2284,7 @@ "nightly-x86_64-windows-int_native-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2184,7 +2292,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2229,6 +2338,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2236,6 +2346,7 @@ "nightly-x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2243,7 +2354,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2288,6 +2400,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2295,6 +2408,7 @@ "release-aarch64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2303,7 +2417,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2352,6 +2467,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2359,6 +2475,7 @@ "release-aarch64-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2367,7 +2484,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2413,6 +2531,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2420,6 +2539,7 @@ "release-i386-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2428,7 +2548,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2474,6 +2595,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2481,6 +2603,7 @@ "release-x86_64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2489,7 +2612,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2538,6 +2662,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2548,6 +2673,7 @@ "release-x86_64-linux-alpine3_12-int_native-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2556,7 +2682,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2604,6 +2731,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2611,6 +2739,7 @@ "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2619,7 +2748,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2667,6 +2797,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2674,6 +2805,7 @@ "release-x86_64-linux-alpine3_12-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2682,7 +2814,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2730,6 +2863,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2737,6 +2871,7 @@ "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2745,7 +2880,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2791,6 +2927,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2798,6 +2935,7 @@ "release-x86_64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2806,7 +2944,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2852,6 +2991,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2859,6 +2999,7 @@ "release-x86_64-linux-deb10-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2867,7 +3008,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2913,6 +3055,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2920,6 +3063,7 @@ "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2928,7 +3072,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2977,6 +3122,7 @@ "CROSS_TARGET": "javascript-unknown-ghcjs", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", "XZ_OPT": "-9" } @@ -2984,6 +3130,7 @@ "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2992,7 +3139,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3038,6 +3186,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -3045,6 +3194,7 @@ "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3053,7 +3203,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3107,6 +3258,7 @@ "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3115,7 +3267,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3314,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3168,6 +3322,7 @@ "release-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3176,7 +3331,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3380,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3231,6 +3388,7 @@ "release-x86_64-linux-fedora33-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3239,7 +3397,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3287,6 +3446,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3294,6 +3454,7 @@ "release-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3302,7 +3463,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3350,6 +3512,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3357,6 +3520,7 @@ "release-x86_64-linux-rocky8-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3365,7 +3529,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3411,6 +3576,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3418,6 +3584,7 @@ "release-x86_64-linux-ubuntu18_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3426,7 +3593,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3472,6 +3640,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3479,6 +3648,7 @@ "release-x86_64-linux-ubuntu20_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3487,7 +3657,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3533,6 +3704,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3540,6 +3712,7 @@ "release-x86_64-windows-int_native-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3547,7 +3720,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3593,6 +3767,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3600,6 +3775,7 @@ "release-x86_64-windows-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3607,7 +3783,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3830,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3660,6 +3838,7 @@ "x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3668,7 +3847,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3716,6 +3896,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3725,6 +3906,7 @@ "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3733,7 +3915,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3779,12 +3962,14 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3793,7 +3978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3840,12 +4026,14 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3854,7 +4042,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3900,12 +4089,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3914,7 +4105,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3961,12 +4153,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3975,7 +4169,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4022,12 +4217,14 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4036,7 +4233,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4080,12 +4278,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, "x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4094,7 +4294,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4139,12 +4340,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4153,7 +4356,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4198,12 +4402,14 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4212,7 +4418,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4256,12 +4463,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4270,7 +4479,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4314,12 +4524,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4328,7 +4540,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4372,12 +4585,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4386,7 +4601,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4430,12 +4646,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4444,7 +4662,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4490,6 +4709,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4497,6 +4717,7 @@ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4505,7 +4726,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4551,12 +4773,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4565,7 +4789,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4612,12 +4837,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4626,7 +4853,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4673,12 +4901,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, "x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4687,7 +4917,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4738,6 +4969,7 @@ "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4746,7 +4978,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4792,12 +5025,14 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, "x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -4805,7 +5040,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4850,6 +5086,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--unexpected-output-dir", help="directory in which to place unexpected output") parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") @@ -128,6 +129,9 @@ if args.top: if args.test_package_db: config.test_package_db = args.test_package_db +if args.unexpected_output_dir: + config.unexpected_output_dir = Path(args.unexpected_output_dir) + if args.only: config.only = args.only config.run_only_some_tests = True ===================================== testsuite/driver/testglobals.py ===================================== @@ -203,7 +203,7 @@ class TestConfig: self.baseline_commit = None # type: Optional[GitRef] # Additional package dbs to inspect for test dependencies. - self.test_package_db = [] # type: [PathToPackageDb] + self.test_package_db = [] # type: List[PathToPackageDb] # Should we skip performance tests self.skip_perf_tests = False @@ -225,6 +225,10 @@ class TestConfig: # See Note [Haddock runtime stats files] at the bottom of this file. self.stats_files_dir = Path('/please_set_stats_files_dir') + # Where to place observed output files on when unexpected output + # is observed. + self.unexpected_output_dir = None # type: Optional[Path] + # Should we cleanup after test runs? self.cleanup = True ===================================== testsuite/driver/testlib.py ===================================== @@ -2262,11 +2262,15 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool: # new output. Returns true if output matched or was accepted, false # otherwise. See Note [Output comparison] for the meaning of the # normaliser and whitespace_normaliser parameters. -async def compare_outputs(way: WayName, - kind: str, - normaliser: OutputNormalizer, - expected_file, actual_file, diff_file=None, - whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: +async def compare_outputs( + way: WayName, + kind: str, + normaliser: OutputNormalizer, + expected_file: Path, + actual_file: Path, + diff_file: Optional[Path]=None, + whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options if kind == 'stderr' and getTestOpts().ignore_stderr: return True @@ -2343,6 +2347,12 @@ async def compare_outputs(way: WayName, expected_path.unlink() return True else: + if config.unexpected_output_dir is not None: + ghc_root = expected_path.relative_to(config.top.parent) + out = config.unexpected_output_dir / ghc_root + out.parent.mkdir(exist_ok=True, parents=True) + write_file(out, actual_raw) + return False # Checks that each line from pattern_file is present in actual_file as @@ -2397,6 +2407,15 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs # squash all whitespace, making the diff unreadable. Instead we rely # on the `diff` program to ignore whitespace changes as much as # possible (#10152). +# +# In addition, to aid CI users we will optionally collect all +# of the unexpected output that we encountered in the +# directory at config.unexpected_output_dir. The intent here is for this +# directory to be preserved as a CI artifact which can then +# be downloaded by the user and committed to their branch +# to address CI failures on platforms which they cannot +# test locally. + # Note [Null device handling] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e524fa7f67259a093aeb21aada139137626c581c...48f80968473b6cddbe829d24eab2adcf739bc115 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e524fa7f67259a093aeb21aada139137626c581c...48f80968473b6cddbe829d24eab2adcf739bc115 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:34:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 07 Jul 2023 11:34:08 -0400 Subject: [Git][ghc/ghc][master] driver: Fix -S with .cmm files Message-ID: <64a830703590b_31499caee201353c0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 4 changed files: - compiler/GHC/Driver/Pipeline.hs - testsuite/tests/cmm/should_compile/Makefile - + testsuite/tests/cmm/should_compile/T23610.cmm - testsuite/tests/cmm/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -850,18 +850,18 @@ llvmManglePipeline pipe_env hsc_env location llc_fn = do else use (T_LlvmMangle pipe_env hsc_env llc_fn) asPipeline False pipe_env hsc_env location mangled_fn -cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath +cmmCppPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) cmmCppPipeline pipe_env hsc_env input_fn = do output_fn <- use (T_CmmCpp pipe_env hsc_env input_fn) cmmPipeline pipe_env hsc_env output_fn -cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m FilePath +cmmPipeline :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath) cmmPipeline pipe_env hsc_env input_fn = do (fos, output_fn) <- use (T_Cmm pipe_env hsc_env input_fn) mo_fn <- hscPostBackendPipeline pipe_env hsc_env HsSrcFile (backend (hsc_dflags hsc_env)) Nothing output_fn case mo_fn of - Nothing -> panic "CMM pipeline - produced no .o file" - Just mo_fn -> use (T_MergeForeign pipe_env hsc_env mo_fn fos) + Nothing -> return Nothing + Just mo_fn -> Just <$> use (T_MergeForeign pipe_env hsc_env mo_fn fos) jsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath jsPipeline pipe_env hsc_env location input_fn = do @@ -938,8 +938,8 @@ pipelineStart pipe_env hsc_env input_fn mb_phase = fromPhase LlvmLlc = llvmLlcPipeline pipe_env hsc_env Nothing input_fn fromPhase LlvmMangle = llvmManglePipeline pipe_env hsc_env Nothing input_fn fromPhase StopLn = return (Just input_fn) - fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn - fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn + fromPhase CmmCpp = cmmCppPipeline pipe_env hsc_env input_fn + fromPhase Cmm = cmmPipeline pipe_env hsc_env input_fn fromPhase Js = Just <$> foreignJsPipeline pipe_env hsc_env Nothing input_fn fromPhase MergeForeign = panic "fromPhase: MergeForeign" ===================================== testsuite/tests/cmm/should_compile/Makefile ===================================== @@ -13,3 +13,6 @@ T16930: grep -rl "after setInfoTableStackMap" `ls T16930.*` grep -rl "Layout Stack" `ls T16930.*` grep -rl "Post switch plan" `ls T16930.*` + +T23610: + '$(TEST_HC)' $(TEST_HC_OPTS) T23610.cmm -S ===================================== testsuite/tests/cmm/should_compile/T23610.cmm ===================================== @@ -0,0 +1,3 @@ +test(bits64 x) { + return (x); +} ===================================== testsuite/tests/cmm/should_compile/all.T ===================================== @@ -8,3 +8,4 @@ test('cmm_sink_sp', [ only_ways(['optasm']), grep_errmsg(r'(\[Sp.*\]).*(=).*(\[. test('T16930', normal, makefile_test, ['T16930']) test('T17442', normal, compile, ['']) test('T20725', normal, compile, ['-package ghc']) +test('T23610', normal, makefile_test, ['T23610']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76983a0dca64dfb7e94aea0c4f494921f8513b41 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/76983a0dca64dfb7e94aea0c4f494921f8513b41 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:34:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 07 Jul 2023 11:34:29 -0400 Subject: [Git][ghc/ghc][master] Update Hadrian's stack.yaml Message-ID: <64a83085dfd46_31499caee481372af@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 2 changed files: - hadrian/stack.yaml - hadrian/stack.yaml.lock Changes: ===================================== hadrian/stack.yaml ===================================== @@ -1,4 +1,6 @@ -resolver: lts-19.8 +# GHC's configure script reports that GHC versions 9.2 and greater are required +# to build GHC from source. +resolver: lts-20.26 # GHC 9.2.8 packages: - '.' ===================================== hadrian/stack.yaml.lock ===================================== @@ -6,7 +6,7 @@ packages: [] snapshots: - completed: - size: 618506 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/8.yaml - sha256: f1c4aca9b9b81afbb9db55571acb0690cdc01ac97a178234de281f9dc075e95e - original: lts-19.8 + size: 650475 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml + sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 + original: lts-20.26 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6df15e93171cf6ee9aeee642ede2d816a084efda -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6df15e93171cf6ee9aeee642ede2d816a084efda You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:40:13 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 07 Jul 2023 11:40:13 -0400 Subject: [Git][ghc/ghc][wip/T23578] Refactor more Message-ID: <64a831dd61c8d_31499caeeac137441@gitlab.mail> Jaro Reinders pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC Commits: 810f17c1 by Jaro Reinders at 2023-07-07T17:40:05+02:00 Refactor more - - - - - 1 changed file: - libraries/base/GHC/Word.hs Changes: ===================================== libraries/base/GHC/Word.hs ===================================== @@ -732,18 +732,18 @@ instance Enum Word64 where | otherwise = fromEnumError "Word64" x {-# INLINE enumFrom #-} - enumFrom (W# x#) = eftWord x# maxWord# - where !(W# maxWord#) = maxBound + enumFrom (W64# x#) = eftWord64 x# maxWord# + where !(W64# maxWord#) = maxBound -- Blarg: technically I guess enumFrom isn't strict! {-# INLINE enumFromTo #-} - enumFromTo (W# x) (W# y) = eftWord x y + enumFromTo (W64# x) (W64# y) = eftWord64 x y {-# INLINE enumFromThen #-} - enumFromThen (W# x1) (W# x2) = efdWord x1 x2 + enumFromThen (W64# x1) (W64# x2) = efdWord64 x1 x2 {-# INLINE enumFromThenTo #-} - enumFromThenTo (W# x1) (W# x2) (W# y) = efdtWord x1 x2 y + enumFromThenTo (W64# x1) (W64# x2) (W64# y) = efdtWord64 x1 x2 y ----------------------------------------------------- @@ -765,18 +765,18 @@ eftWord64 :: Word64# -> Word64# -> [Word64] eftWord64 x0 y | isTrue# (x0 `gtWord64#` y) = [] | otherwise = go x0 where - go x = W# x : if isTrue# (x `eqWord64#` y) + go x = W64# x : if isTrue# (x `eqWord64#` y) then [] - else go (x `plusWord64#` 1##) + else go (x `plusWord64#` (wordToWord64# 1##)) {-# INLINE [0] eftWord64FB #-} -- See Note [Inline FB functions] in GHC.List eftWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> r eftWord64FB c n x0 y | isTrue# (x0 `gtWord64#` y) = n | otherwise = go x0 where - go x = W# x `c` if isTrue# (x `eqWord64#` y) + go x = W64# x `c` if isTrue# (x `eqWord64#` y) then n - else go (x `plusWord64#` 1##) + else go (x `plusWord64#` (wordToWord64# 1##)) -- Watch out for y=maxBound; hence ==, not > -- Be very careful not to have more than one "c" -- so that when eftInfFB is inlined we can inline @@ -797,8 +797,8 @@ eftWord64FB c n x0 y | isTrue# (x0 `gtWord64#` y) = n efdWord64 :: Word64# -> Word64# -> [Word64] -- [x1,x2..maxWord64] efdWord64 x1 x2 - | isTrue# (x2 `geWord64#` x1) = case maxBound of W# y -> efdtWord64Up x1 x2 y - | otherwise = case minBound of W# y -> efdtWord64Dn x1 x2 y + | isTrue# (x2 `geWord64#` x1) = case maxBound of W64# y -> efdtWord64Up x1 x2 y + | otherwise = case minBound of W64# y -> efdtWord64Dn x1 x2 y {-# NOINLINE [1] efdtWord64 #-} efdtWord64 :: Word64# -> Word64# -> Word64# -> [Word64] @@ -816,64 +816,64 @@ efdtWord64FB c n x1 x2 y -- Requires x2 >= x1 efdtWord64Up :: Word64# -> Word64# -> Word64# -> [Word64] efdtWord64Up x1 x2 y -- Be careful about overflow! - | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then [] else [W# x1] + | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then [] else [W64# x1] | otherwise = -- Common case: x1 <= x2 <= y - let !delta = x2 `minusWord64#` x1 -- >= 0 - !y' = y `minusWord64#` delta -- x1 <= y' <= y; hence y' is representable + let !delta = x2 `subWord64#` x1 -- >= 0 + !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable -- Invariant: x <= y -- Note that: z <= y' => z + delta won't overflow -- so we are guaranteed not to overflow if/when we recurse - go_up x | isTrue# (x `gtWord64#` y') = [W# x] - | otherwise = W# x : go_up (x `plusWord64#` delta) - in W# x1 : go_up x2 + go_up x | isTrue# (x `gtWord64#` y') = [W64# x] + | otherwise = W64# x : go_up (x `plusWord64#` delta) + in W64# x1 : go_up x2 -- Requires x2 >= x1 {-# INLINE [0] efdtWord64UpFB #-} -- See Note [Inline FB functions] in GHC.List efdtWord64UpFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r efdtWord64UpFB c n x1 x2 y -- Be careful about overflow! - | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then n else W# x1 `c` n + | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then n else W64# x1 `c` n | otherwise = -- Common case: x1 <= x2 <= y - let !delta = x2 `minusWord64#` x1 -- >= 0 - !y' = y `minusWord64#` delta -- x1 <= y' <= y; hence y' is representable + let !delta = x2 `subWord64#` x1 -- >= 0 + !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable -- Invariant: x <= y -- Note that: z <= y' => z + delta won't overflow -- so we are guaranteed not to overflow if/when we recurse - go_up x | isTrue# (x `gtWord64#` y') = W# x `c` n - | otherwise = W# x `c` go_up (x `plusWord64#` delta) - in W# x1 `c` go_up x2 + go_up x | isTrue# (x `gtWord64#` y') = W64# x `c` n + | otherwise = W64# x `c` go_up (x `plusWord64#` delta) + in W64# x1 `c` go_up x2 -- Requires x2 <= x1 efdtWord64Dn :: Word64# -> Word64# -> Word64# -> [Word64] efdtWord64Dn x1 x2 y -- Be careful about underflow! - | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then [] else [W# x1] + | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then [] else [W64# x1] | otherwise = -- Common case: x1 >= x2 >= y - let !delta = x2 `minusWord64#` x1 -- <= 0 - !y' = y `minusWord64#` delta -- y <= y' <= x1; hence y' is representable + let !delta = x2 `subWord64#` x1 -- <= 0 + !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable -- Invariant: x >= y -- Note that: z >= y' => z + delta won't underflow -- so we are guaranteed not to underflow if/when we recurse - go_dn x | isTrue# (x `ltWord64#` y') = [W# x] - | otherwise = W# x : go_dn (x `plusWord64#` delta) - in W# x1 : go_dn x2 + go_dn x | isTrue# (x `ltWord64#` y') = [W64# x] + | otherwise = W64# x : go_dn (x `plusWord64#` delta) + in W64# x1 : go_dn x2 -- Requires x2 <= x1 {-# INLINE [0] efdtWord64DnFB #-} -- See Note [Inline FB functions] in GHC.List efdtWord64DnFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r efdtWord64DnFB c n x1 x2 y -- Be careful about underflow! - | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then n else W# x1 `c` n + | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then n else W64# x1 `c` n | otherwise = -- Common case: x1 >= x2 >= y - let !delta = x2 `minusWord64#` x1 -- <= 0 - !y' = y `minusWord64#` delta -- y <= y' <= x1; hence y' is representable + let !delta = x2 `subWord64#` x1 -- <= 0 + !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable -- Invariant: x >= y -- Note that: z >= y' => z + delta won't underflow -- so we are guaranteed not to underflow if/when we recurse - go_dn x | isTrue# (x `ltWord64#` y') = W# x `c` n - | otherwise = W# x `c` go_dn (x `plusWord64#` delta) - in W# x1 `c` go_dn x2 + go_dn x | isTrue# (x `ltWord64#` y') = W64# x `c` n + | otherwise = W64# x `c` go_dn (x `plusWord64#` delta) + in W64# x1 `c` go_dn x2 -- | @since 2.01 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/810f17c13760c903a2d15e98059756840040ffed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/810f17c13760c903a2d15e98059756840040ffed You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:45:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 11:45:09 -0400 Subject: [Git][ghc/ghc][wip/T22012] rts/RtsSymbols: Add AArch64 outline atomic operations Message-ID: <64a83305dc2ed_31499caee8413962f@gitlab.mail> Ben Gamari pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: f71188cc by Ben Gamari at 2023-07-07T11:44:56-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python ops = [] ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.append(f'__aarch64_{op}{n}_{order}') for m in [1,2,4,8,16]: ops.append(f'__aarch64_cas{n}_{order}') print('\n'.join(f' SymE_NeedsProto({op}),' for op in sorted(ops))) ``` - - - - - 2 changed files: - + rts/AArch64Symbols.h - rts/RtsSymbols.c Changes: ===================================== rts/AArch64Symbols.h ===================================== @@ -0,0 +1,101 @@ +#define RTS_AARCH64_SYMBOLS \ + SymE_NeedsProto(__aarch64_cas8_acq) \ + SymE_NeedsProto(__aarch64_cas8_acq) \ + SymE_NeedsProto(__aarch64_cas8_acq) \ + SymE_NeedsProto(__aarch64_cas8_acq) \ + SymE_NeedsProto(__aarch64_cas8_acq) \ + SymE_NeedsProto(__aarch64_cas8_acq_rel) \ + SymE_NeedsProto(__aarch64_cas8_acq_rel) \ + SymE_NeedsProto(__aarch64_cas8_acq_rel) \ + SymE_NeedsProto(__aarch64_cas8_acq_rel) \ + SymE_NeedsProto(__aarch64_cas8_acq_rel) \ + SymE_NeedsProto(__aarch64_cas8_rel) \ + SymE_NeedsProto(__aarch64_cas8_rel) \ + SymE_NeedsProto(__aarch64_cas8_rel) \ + SymE_NeedsProto(__aarch64_cas8_rel) \ + SymE_NeedsProto(__aarch64_cas8_rel) \ + SymE_NeedsProto(__aarch64_cas8_relax) \ + SymE_NeedsProto(__aarch64_cas8_relax) \ + SymE_NeedsProto(__aarch64_cas8_relax) \ + SymE_NeedsProto(__aarch64_cas8_relax) \ + SymE_NeedsProto(__aarch64_cas8_relax) \ + SymE_NeedsProto(__aarch64_ldadd1_acq) \ + SymE_NeedsProto(__aarch64_ldadd1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd1_rel) \ + SymE_NeedsProto(__aarch64_ldadd1_relax) \ + SymE_NeedsProto(__aarch64_ldadd2_acq) \ + SymE_NeedsProto(__aarch64_ldadd2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd2_rel) \ + SymE_NeedsProto(__aarch64_ldadd2_relax) \ + SymE_NeedsProto(__aarch64_ldadd4_acq) \ + SymE_NeedsProto(__aarch64_ldadd4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd4_rel) \ + SymE_NeedsProto(__aarch64_ldadd4_relax) \ + SymE_NeedsProto(__aarch64_ldadd8_acq) \ + SymE_NeedsProto(__aarch64_ldadd8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd8_rel) \ + SymE_NeedsProto(__aarch64_ldadd8_relax) \ + SymE_NeedsProto(__aarch64_ldclr1_acq) \ + SymE_NeedsProto(__aarch64_ldclr1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr1_rel) \ + SymE_NeedsProto(__aarch64_ldclr1_relax) \ + SymE_NeedsProto(__aarch64_ldclr2_acq) \ + SymE_NeedsProto(__aarch64_ldclr2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr2_rel) \ + SymE_NeedsProto(__aarch64_ldclr2_relax) \ + SymE_NeedsProto(__aarch64_ldclr4_acq) \ + SymE_NeedsProto(__aarch64_ldclr4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr4_rel) \ + SymE_NeedsProto(__aarch64_ldclr4_relax) \ + SymE_NeedsProto(__aarch64_ldclr8_acq) \ + SymE_NeedsProto(__aarch64_ldclr8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr8_rel) \ + SymE_NeedsProto(__aarch64_ldclr8_relax) \ + SymE_NeedsProto(__aarch64_ldeor1_acq) \ + SymE_NeedsProto(__aarch64_ldeor1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor1_rel) \ + SymE_NeedsProto(__aarch64_ldeor1_relax) \ + SymE_NeedsProto(__aarch64_ldeor2_acq) \ + SymE_NeedsProto(__aarch64_ldeor2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor2_rel) \ + SymE_NeedsProto(__aarch64_ldeor2_relax) \ + SymE_NeedsProto(__aarch64_ldeor4_acq) \ + SymE_NeedsProto(__aarch64_ldeor4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor4_rel) \ + SymE_NeedsProto(__aarch64_ldeor4_relax) \ + SymE_NeedsProto(__aarch64_ldeor8_acq) \ + SymE_NeedsProto(__aarch64_ldeor8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor8_rel) \ + SymE_NeedsProto(__aarch64_ldeor8_relax) \ + SymE_NeedsProto(__aarch64_ldset1_acq) \ + SymE_NeedsProto(__aarch64_ldset1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset1_rel) \ + SymE_NeedsProto(__aarch64_ldset1_relax) \ + SymE_NeedsProto(__aarch64_ldset2_acq) \ + SymE_NeedsProto(__aarch64_ldset2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset2_rel) \ + SymE_NeedsProto(__aarch64_ldset2_relax) \ + SymE_NeedsProto(__aarch64_ldset4_acq) \ + SymE_NeedsProto(__aarch64_ldset4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset4_rel) \ + SymE_NeedsProto(__aarch64_ldset4_relax) \ + SymE_NeedsProto(__aarch64_ldset8_acq) \ + SymE_NeedsProto(__aarch64_ldset8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset8_rel) \ + SymE_NeedsProto(__aarch64_ldset8_relax) \ + SymE_NeedsProto(__aarch64_swp1_acq) \ + SymE_NeedsProto(__aarch64_swp1_acq_rel) \ + SymE_NeedsProto(__aarch64_swp1_rel) \ + SymE_NeedsProto(__aarch64_swp1_relax) \ + SymE_NeedsProto(__aarch64_swp2_acq) \ + SymE_NeedsProto(__aarch64_swp2_acq_rel) \ + SymE_NeedsProto(__aarch64_swp2_rel) \ + SymE_NeedsProto(__aarch64_swp2_relax) \ + SymE_NeedsProto(__aarch64_swp4_acq) \ + SymE_NeedsProto(__aarch64_swp4_acq_rel) \ + SymE_NeedsProto(__aarch64_swp4_rel) \ + SymE_NeedsProto(__aarch64_swp4_relax) \ + SymE_NeedsProto(__aarch64_swp8_acq) \ + SymE_NeedsProto(__aarch64_swp8_acq_rel) \ + SymE_NeedsProto(__aarch64_swp8_rel) \ + SymE_NeedsProto(__aarch64_swp8_relax) ===================================== rts/RtsSymbols.c ===================================== @@ -967,6 +967,13 @@ extern char **environ; #define RTS_LIBGCC_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt for AArch64's outline atomics. +#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) +#include "AArch64Symbols.h" +#else +#define RTS_AARCH64_SYMBOLS +#endif + // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -1014,6 +1021,7 @@ RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +RTS_AARCH64_SYMBOLS #undef SymI_NeedsProto #undef SymI_NeedsDataProto @@ -1055,6 +1063,7 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS + RTS_AARCH64_SYMBOLS SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f71188cc67eb95cd12f6d5a2dbe46aaa2193fe87 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f71188cc67eb95cd12f6d5a2dbe46aaa2193fe87 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:46:07 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 07 Jul 2023 11:46:07 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_UU_Conv Message-ID: <64a8333f6bc95_31499caee981401df@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: d71ea641 by Sven Tennie at 2023-07-06T20:06:42+02:00 Implement MO_UU_Conv Expect zero extended (!) register. If the source Width is smaller or equal to the target Width just move (copy) the value. Otherwise (target Width is smaller), truncate it. We don't need to care about sign-extension, as this mach op is unsigned. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -611,15 +611,16 @@ getRegister' config plat expr = signExtendAdjustPrecission W32 to dst dst) -- (float convert (-> zero) signed) MO_FS_Conv from to -> pure $ Any (intFormat to) (\dst -> code `snocOL` annExpr expr (FCVTZS (OpReg to dst) (OpReg from reg))) -- (float convert (-> zero) signed) - -- TODO this is very slow. We effectively use store + load (byte, half, word, double) - -- for this in memory. - MO_UU_Conv from to -> return $ Any (intFormat to) (\dst -> - code `appOL` toOL [ SUB sp sp (OpImm (ImmInt 8)) - , STR (intFormat from) (OpReg from reg) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , LDR (intFormat to) (OpReg to dst) (OpAddr (AddrRegImm sp_reg (ImmInt 0))) - , ADD sp sp (OpImm (ImmInt 8)) - ]) - -- MO_UU_Conv from to -> return $ Any (intFormat to) (\dst -> code `snocOL` UBFM (OpReg (max from to) dst) (OpReg (max from to) reg) (OpImm (ImmInt 0)) (toImm (min from to))) + MO_UU_Conv from to | from <= to -> pure $ Any (intFormat to) (\dst -> + code `snocOL` + annExpr e (MOV (OpReg to dst) (OpReg from reg)) + ) + + MO_UU_Conv from to -> pure $ Any (intFormat to) (\dst -> + code `snocOL` + annExpr e (MOV (OpReg from dst) (OpReg from reg)) `appOL` + truncateReg from to dst + ) MO_SS_Conv from to -> ss_conv from to reg code MO_FF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` FCVT (OpReg to dst) (OpReg from reg)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d71ea641f81c980dc3be0e7a458bdbab5c7c4108 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d71ea641f81c980dc3be0e7a458bdbab5c7c4108 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:48:51 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 07 Jul 2023 11:48:51 -0400 Subject: [Git][ghc/ghc][wip/supersven/imulMayOflo_x86] Add test(s) for %mulmayoflo primop Message-ID: <64a833e32e8ed_31499caee70142556@gitlab.mail> Sven Tennie pushed to branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC Commits: 5ae09143 by Sven Tennie at 2023-07-07T17:45:10+02:00 Add test(s) for %mulmayoflo primop One test checks the minimal contract (see MulMayOflo.hs), the other checks a perfect implementation. - - - - - 5 changed files: - compiler/GHC/Cmm/MachOp.hs - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - + testsuite/tests/codeGen/should_run/MulMayOflo_minimal.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -56,6 +56,25 @@ Note that there are variety of places in the native code generator where we assume that the code produced for a MachOp does not introduce new blocks. -} +-- Note [MO_S_MulMayOflo significant width] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- There are two interpretations in the code about what a multiplication +-- overflow exactly means: +-- +-- 1. The result does not fit into the specified width (of type Width.) +-- 2. The result does not fit into a register. +-- +-- (2) has some flaws: A following MO_Mul has a width, too. So MO_S_MulMayOflo +-- may signal no overflow, while MO_Mul truncates the result. There are +-- architectures with several register widths and it might be hard to decide +-- what's an overflow and what not. Both attributes can easily lead to subtle +-- bugs. +-- +-- (1) has the benefit that its interpretation is completely independent of the +-- architecture. So, the mid-term plan is to migrate to this +-- interpretation/sematics. + data MachOp -- Integer operations (insensitive to signed/unsigned) = MO_Add Width @@ -65,7 +84,8 @@ data MachOp | MO_Mul Width -- low word of multiply -- Signed multiply/divide - | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows + | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows. See + -- Note [MO_S_MulMayOflo significant width] | MO_S_Quot Width -- signed / (same semantics as IntQuotOp) | MO_S_Rem Width -- signed % (same semantics as IntRemOp) | MO_S_Neg Width -- unary - ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +{- + N.B. the contract of '%mulmayoflo' is a bit weak: "Return non-zero if there is + any possibility that the signed multiply of a and b might overflow. Return zero + only if you are absolutely sure that it won't overflow. If in doubt, return + non-zero." (Stg.h) + + So, this test is split into two parts: + - the minimal contract + - for architectures which have a perfect implementation, also assert that + The decission which variant to run is made in `all.T`. +-} + +module Main where + +import GHC.Exts + +-- The argument and return types are unimportant: They're only used to force +-- evaluation, but carry no information. +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm ===================================== @@ -0,0 +1,98 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_minimal.cmm ===================================== @@ -0,0 +1,30 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + +// Why aren't I8 and I16 tested here? Because many code generation backends only +// check for register overflows, not overflows regarding a smaller width. +// See Note [MO_S_MulMayOflo significant width] + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,18 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) + +test('MulMayOflo_minimal', + [extra_files(['MulMayOflo.hs']),ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_minimal.cmm', '')], '']) +test('MulMayOflo_full', + [ extra_files(['MulMayOflo.hs']), + when(unregisterised(), skip), + unless(arch('x86_64') or arch('i386') + or arch('aarch64') + or arch('powerpc') or arch('powerpc64'), + skip), + ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ae09143dcabf5125949ee4e2c6ee2ca8a5a42d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ae09143dcabf5125949ee4e2c6ee2ca8a5a42d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 15:55:00 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 07 Jul 2023 11:55:00 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Wibble Message-ID: <64a8355424199_31499caee341460d2@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: b3e1e33a by Simon Peyton Jones at 2023-07-07T16:54:46+01:00 Wibble - - - - - 2 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -1931,6 +1931,49 @@ things] in Simplify.Utils. This certainly risks repeated simplification, but in practice seems to be a small win. +Note [Avoiding exponential inlining] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #13253, and several related tickets, we got an exponential blowup +in code size from a program that looks like this. NB: see also +Note [Do not add unfoldings to join points at birth] + + let j1a x = case f y of { True -> p; False -> q } + j1b x = case f y of { True -> q; False -> p } + j2a x = case f (y+1) of { True -> j1a x; False -> j1b x} + j2b x = case f (y+1) of { True -> j1b x; False -> j1a x} + ... + in case f (y+10) of { True -> j10a 7; False -> j10b 8 } + +The first danger is this: in Simplifier iteration 1 postInlineUnconditionally +inlines the last functions, j10a and j10b (they are both small). Now we have +two calls to j9a and two to j9b. In the next Simplifer iteration, +postInlineUnconditionally inlines all four of these calls, leaving four calls +to j8a and j8b. Etc. Yikes! This is exponential! + +This probably /won't/ happen because the Simplifier works top down, so it'll +inline j1a/j1b into j2a/j2b, which will make the latter bigger; so the process +will stop. + +A related problem. Suppose the RHSs are too big for postInlineUnconditionally, +and the calls in the RHSs are not interesting enough to promote inlining. But +the calls in the body (j10a 7) etc, might be interesting enough. So j10a inlines +and that might make j9a inline, and so on in an upward cascade. + +A possible plan: stop doing postInlineUnconditionally +for some fixed, smallish number of branches, say 4. But that turned +out to be bad: see Note [Inline small things to avoid creating a thunk]. +And, as it happened, the problem with #13253 was solved in a +different way (Note [Duplicating StrictArg] in Simplify). + +So I just set an arbitrary, high limit of 100, to stop any +totally exponential behaviour. + +This still leaves the nasty possibility that /ordinary/ inlining (not +postInlineUnconditionally) might inline these join points, each of +which is individually quiet small. I'm still not sure what to do +about this (e.g. see #15488). + + ************************************************************************ * * Join points @@ -2384,7 +2427,7 @@ Then given (f Int e1) we rewrite to (\x. x True) e1 without simplifying e1. Now we can inline x into its unique call site, and absorb the True into it all in the same pass. If we simplified -e1 first, we couldn't do that; see Note [Avoiding exponential behaviour]. +e1 first, we couldn't do that; see Note [Avoiding simplifying repeatedly]. So we try to apply rules if either (a) no_more_args: we've run out of argument that the rules can "see" @@ -3914,6 +3957,7 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) -- mkUnfolding uf_opts VanillaSrc False False join_rhs Nothing -- uf_opts = seUnfoldingOpts env join_bndr_w_unf = join_bndr + -- See Note [Do not add unfoldings to join points at birth] join_call = mkApps (Var join_bndr) final_args alt' = Alt con alt_bndrs join_call @@ -3936,6 +3980,37 @@ ok_to_dup_alt case_bndr alt_bndrs alt_rhs bndr_set = mkVarSet (case_bndr : alt_bndrs) {- +Note [Do not add unfoldings to join points at birth] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (#15360) + + case (case (case (case ...))) of + Left x -> e1 + Right y -> e2 + +We will make a join point for e1, e2, thus + $j1a x = e1 + $j1b y = e2 + +Now those join points count as "duplicable" , so we feel free to duplicate +them into the loop nest. And each of those calls are then subject to +callSiteInline, which might inline them, if e1, e2 are reasonably small. Now, +if this applies recursive to the next `case` inwards, and so on, the net +effect is that we can get an exponential number of calls to $j1a and $j1b, and +an exponential number of inlinings (since each is done independently). + +This hit #15360 (not a complicated program) badly. Out brutal solution is this: +when a join point is born, we don't give it an unfolding. So we end up with + $j1a x = e1 + $j1b y = e2 + $j2a x = ...$j1a ... $j1b... + $j2b x = ...$j1a ... $j1b... + ... and so on... + +Now we are into Note [Avoiding exponential inlining], which is still +a challenge. But at least we have a chance. If we add inlinings at birth +we never get that chance. + Note [Duplicating alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When should we duplicate an alternative, and when should we make a join point? @@ -4329,7 +4404,7 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf let !opts = seUnfoldingOpts env in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs where - -- See Note [Exponential join point inlining] + -- ToDo: document this too_many_occs (ManyOccs {}) = True too_many_occs (OneOcc { occ_n_br = n }) = n > 10 too_many_occs IAmDead = False ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1543,7 +1543,7 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs -- See Note [Inline small things to avoid creating a thunk] | let not_inside_lam = in_lam == NotInsideLam - -> n_br < 100 -- See Note [Suppress exponential blowup] + -> n_br < 100 -- See Note [Avoiding exponential inlining] in Simplify.Iteration && ( (n_br == 1 && not_inside_lam) -- See Note [Post-inline for single-use things] || smallEnoughToInline uf_opts unfolding) -- Small enough to dup @@ -1642,48 +1642,6 @@ But Alas! -Note [Suppress exponential blowup] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #13253, and several related tickets, we got an exponential blowup -in code size from postInlineUnconditionally. The trouble comes when -we have - let j1a = case f y of { True -> p; False -> q } - j1b = case f y of { True -> q; False -> p } - j2a = case f (y+1) of { True -> j1a; False -> j1b } - j2b = case f (y+1) of { True -> j1b; False -> j1a } - ... - in case f (y+10) of { True -> j10a; False -> j10b } - -when there are many branches. In pass 1, postInlineUnconditionally -inlines j10a and j10b (they are both small). Now we have two calls -to j9a and two to j9b. In pass 2, postInlineUnconditionally inlines -all four of these calls, leaving four calls to j8a and j8b. Etc. -Yikes! This is exponential! - -A similar case - let j1 x = ... - j2 x = ...jump j1 (x-1).....jump j1 (x-2) - ... - in case f (y+10) of { True -> jump j10 10; False -> j10 10 } - -In the RHS of j1..j10, no inlining happens because the calls don't look -exciting enough. But in the "in" part, the call-site inliner may inline -j10 (since it is applied to 10). That exposts -In each -A possible plan: stop doing postInlineUnconditionally -for some fixed, smallish number of branches, say 4. But that turned -out to be bad: see Note [Inline small things to avoid creating a thunk]. -And, as it happened, the problem with #13253 was solved in a -different way (Note [Duplicating StrictArg] in Simplify). - -So I just set an arbitrary, high limit of 100, to stop any -totally exponential behaviour. - -This still leaves the nasty possibility that /ordinary/ inlining (not -postInlineUnconditionally) might inline these join points, each of -which is individually quiet small. I'm still not sure what to do -about this (e.g. see #15488). - Note [Top level and postInlineUnconditionally] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We don't do postInlineUnconditionally for top-level things (even for View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3e1e33a38f0b88f701e5c7be5398acbe4b57a25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3e1e33a38f0b88f701e5c7be5398acbe4b57a25 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 16:05:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 07 Jul 2023 12:05:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Drop circle-ci-job.sh Message-ID: <64a837bddb153_31499caee98148658@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 8040e2b2 by Ben Gamari at 2023-07-07T12:05:05-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - ffd9f714 by Ben Gamari at 2023-07-07T12:05:05-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 58d94ba3 by Melanie Phoenix at 2023-07-07T12:05:05-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 8a092546 by Ben Gamari at 2023-07-07T12:05:11-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - 814b2735 by Oleg Grenrus at 2023-07-07T12:05:12-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - 49986276 by Ben Gamari at 2023-07-07T12:05:13-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 30 changed files: - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/Types/TyThing/Ppr.hs - docs/users_guide/phases.rst - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - hadrian/stack.yaml - hadrian/stack.yaml.lock - libraries/base/Control/Monad/Zip.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md - m4/find_ld.m4 - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/mk/boilerplate.mk - testsuite/tests/cmm/should_compile/Makefile The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/796a5c1f472360030660af59fadee42dc986c560...499862761bb07e8fa70126ebe65c746533ef094e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/796a5c1f472360030660af59fadee42dc986c560...499862761bb07e8fa70126ebe65c746533ef094e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 16:08:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 12:08:17 -0400 Subject: [Git][ghc/ghc][wip/T22012] rts/RtsSymbols: Add AArch64 outline atomic operations Message-ID: <64a838717334d_31499caeec016091b@gitlab.mail> Ben Gamari pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: 18c30684 by Ben Gamari at 2023-07-07T12:07:56-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python def main() -> None: ops = set() ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel', 'sync' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.add(f'__aarch64_{op}{n}_{order}') for m in [1,2,4,8,16]: ops.add(f'__aarch64_cas{n}_{order}') lines = [ "#define RTS_AARCH64_SYMBOLS" ] lines += [ f' SymE_NeedsProto({op})' for op in sorted(ops) ] print(' \\\n'.join(lines)) main() ``` - - - - - 2 changed files: - + rts/AArch64Symbols.h - rts/RtsSymbols.c Changes: ===================================== rts/AArch64Symbols.h ===================================== @@ -0,0 +1,106 @@ +#define RTS_AARCH64_SYMBOLS \ + SymE_NeedsProto(__aarch64_cas8_acq) \ + SymE_NeedsProto(__aarch64_cas8_acq_rel) \ + SymE_NeedsProto(__aarch64_cas8_rel) \ + SymE_NeedsProto(__aarch64_cas8_relax) \ + SymE_NeedsProto(__aarch64_cas8_sync) \ + SymE_NeedsProto(__aarch64_ldadd1_acq) \ + SymE_NeedsProto(__aarch64_ldadd1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd1_rel) \ + SymE_NeedsProto(__aarch64_ldadd1_relax) \ + SymE_NeedsProto(__aarch64_ldadd1_sync) \ + SymE_NeedsProto(__aarch64_ldadd2_acq) \ + SymE_NeedsProto(__aarch64_ldadd2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd2_rel) \ + SymE_NeedsProto(__aarch64_ldadd2_relax) \ + SymE_NeedsProto(__aarch64_ldadd2_sync) \ + SymE_NeedsProto(__aarch64_ldadd4_acq) \ + SymE_NeedsProto(__aarch64_ldadd4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd4_rel) \ + SymE_NeedsProto(__aarch64_ldadd4_relax) \ + SymE_NeedsProto(__aarch64_ldadd4_sync) \ + SymE_NeedsProto(__aarch64_ldadd8_acq) \ + SymE_NeedsProto(__aarch64_ldadd8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd8_rel) \ + SymE_NeedsProto(__aarch64_ldadd8_relax) \ + SymE_NeedsProto(__aarch64_ldadd8_sync) \ + SymE_NeedsProto(__aarch64_ldclr1_acq) \ + SymE_NeedsProto(__aarch64_ldclr1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr1_rel) \ + SymE_NeedsProto(__aarch64_ldclr1_relax) \ + SymE_NeedsProto(__aarch64_ldclr1_sync) \ + SymE_NeedsProto(__aarch64_ldclr2_acq) \ + SymE_NeedsProto(__aarch64_ldclr2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr2_rel) \ + SymE_NeedsProto(__aarch64_ldclr2_relax) \ + SymE_NeedsProto(__aarch64_ldclr2_sync) \ + SymE_NeedsProto(__aarch64_ldclr4_acq) \ + SymE_NeedsProto(__aarch64_ldclr4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr4_rel) \ + SymE_NeedsProto(__aarch64_ldclr4_relax) \ + SymE_NeedsProto(__aarch64_ldclr4_sync) \ + SymE_NeedsProto(__aarch64_ldclr8_acq) \ + SymE_NeedsProto(__aarch64_ldclr8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr8_rel) \ + SymE_NeedsProto(__aarch64_ldclr8_relax) \ + SymE_NeedsProto(__aarch64_ldclr8_sync) \ + SymE_NeedsProto(__aarch64_ldeor1_acq) \ + SymE_NeedsProto(__aarch64_ldeor1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor1_rel) \ + SymE_NeedsProto(__aarch64_ldeor1_relax) \ + SymE_NeedsProto(__aarch64_ldeor1_sync) \ + SymE_NeedsProto(__aarch64_ldeor2_acq) \ + SymE_NeedsProto(__aarch64_ldeor2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor2_rel) \ + SymE_NeedsProto(__aarch64_ldeor2_relax) \ + SymE_NeedsProto(__aarch64_ldeor2_sync) \ + SymE_NeedsProto(__aarch64_ldeor4_acq) \ + SymE_NeedsProto(__aarch64_ldeor4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor4_rel) \ + SymE_NeedsProto(__aarch64_ldeor4_relax) \ + SymE_NeedsProto(__aarch64_ldeor4_sync) \ + SymE_NeedsProto(__aarch64_ldeor8_acq) \ + SymE_NeedsProto(__aarch64_ldeor8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor8_rel) \ + SymE_NeedsProto(__aarch64_ldeor8_relax) \ + SymE_NeedsProto(__aarch64_ldeor8_sync) \ + SymE_NeedsProto(__aarch64_ldset1_acq) \ + SymE_NeedsProto(__aarch64_ldset1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset1_rel) \ + SymE_NeedsProto(__aarch64_ldset1_relax) \ + SymE_NeedsProto(__aarch64_ldset1_sync) \ + SymE_NeedsProto(__aarch64_ldset2_acq) \ + SymE_NeedsProto(__aarch64_ldset2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset2_rel) \ + SymE_NeedsProto(__aarch64_ldset2_relax) \ + SymE_NeedsProto(__aarch64_ldset2_sync) \ + SymE_NeedsProto(__aarch64_ldset4_acq) \ + SymE_NeedsProto(__aarch64_ldset4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset4_rel) \ + SymE_NeedsProto(__aarch64_ldset4_relax) \ + SymE_NeedsProto(__aarch64_ldset4_sync) \ + SymE_NeedsProto(__aarch64_ldset8_acq) \ + SymE_NeedsProto(__aarch64_ldset8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset8_rel) \ + SymE_NeedsProto(__aarch64_ldset8_relax) \ + SymE_NeedsProto(__aarch64_ldset8_sync) \ + SymE_NeedsProto(__aarch64_swp1_acq) \ + SymE_NeedsProto(__aarch64_swp1_acq_rel) \ + SymE_NeedsProto(__aarch64_swp1_rel) \ + SymE_NeedsProto(__aarch64_swp1_relax) \ + SymE_NeedsProto(__aarch64_swp1_sync) \ + SymE_NeedsProto(__aarch64_swp2_acq) \ + SymE_NeedsProto(__aarch64_swp2_acq_rel) \ + SymE_NeedsProto(__aarch64_swp2_rel) \ + SymE_NeedsProto(__aarch64_swp2_relax) \ + SymE_NeedsProto(__aarch64_swp2_sync) \ + SymE_NeedsProto(__aarch64_swp4_acq) \ + SymE_NeedsProto(__aarch64_swp4_acq_rel) \ + SymE_NeedsProto(__aarch64_swp4_rel) \ + SymE_NeedsProto(__aarch64_swp4_relax) \ + SymE_NeedsProto(__aarch64_swp4_sync) \ + SymE_NeedsProto(__aarch64_swp8_acq) \ + SymE_NeedsProto(__aarch64_swp8_acq_rel) \ + SymE_NeedsProto(__aarch64_swp8_rel) \ + SymE_NeedsProto(__aarch64_swp8_relax) \ + SymE_NeedsProto(__aarch64_swp8_sync) ===================================== rts/RtsSymbols.c ===================================== @@ -967,6 +967,13 @@ extern char **environ; #define RTS_LIBGCC_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt for AArch64's outline atomics. +#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) +#include "AArch64Symbols.h" +#else +#define RTS_AARCH64_SYMBOLS +#endif + // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -1014,6 +1021,7 @@ RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +RTS_AARCH64_SYMBOLS #undef SymI_NeedsProto #undef SymI_NeedsDataProto @@ -1055,6 +1063,7 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS + RTS_AARCH64_SYMBOLS SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18c30684943acc17269a891e31225c930694296f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18c30684943acc17269a891e31225c930694296f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 16:13:53 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 12:13:53 -0400 Subject: [Git][ghc/ghc][wip/T22012] rts/RtsSymbols: Add AArch64 outline atomic operations Message-ID: <64a839c198c1_31499caee2016141c@gitlab.mail> Ben Gamari pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: 1e26170a by Ben Gamari at 2023-07-07T12:13:38-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python def main() -> None: ops = set() ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel', 'sync' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.add(f'__aarch64_{op}{n}_{order}') for n in [1,2,4,8,16]: ops.add(f'__aarch64_cas{n}_{order}') lines = [ "#define RTS_AARCH64_SYMBOLS" ] lines += [ f' SymE_NeedsProto({op})' for op in sorted(ops) ] print(' \\\n'.join(lines)) main() ``` - - - - - 2 changed files: - + rts/AArch64Symbols.h - rts/RtsSymbols.c Changes: ===================================== rts/AArch64Symbols.h ===================================== @@ -0,0 +1,126 @@ +#define RTS_AARCH64_SYMBOLS \ + SymE_NeedsProto(__aarch64_cas16_acq) \ + SymE_NeedsProto(__aarch64_cas16_acq_rel) \ + SymE_NeedsProto(__aarch64_cas16_rel) \ + SymE_NeedsProto(__aarch64_cas16_relax) \ + SymE_NeedsProto(__aarch64_cas16_sync) \ + SymE_NeedsProto(__aarch64_cas1_acq) \ + SymE_NeedsProto(__aarch64_cas1_acq_rel) \ + SymE_NeedsProto(__aarch64_cas1_rel) \ + SymE_NeedsProto(__aarch64_cas1_relax) \ + SymE_NeedsProto(__aarch64_cas1_sync) \ + SymE_NeedsProto(__aarch64_cas2_acq) \ + SymE_NeedsProto(__aarch64_cas2_acq_rel) \ + SymE_NeedsProto(__aarch64_cas2_rel) \ + SymE_NeedsProto(__aarch64_cas2_relax) \ + SymE_NeedsProto(__aarch64_cas2_sync) \ + SymE_NeedsProto(__aarch64_cas4_acq) \ + SymE_NeedsProto(__aarch64_cas4_acq_rel) \ + SymE_NeedsProto(__aarch64_cas4_rel) \ + SymE_NeedsProto(__aarch64_cas4_relax) \ + SymE_NeedsProto(__aarch64_cas4_sync) \ + SymE_NeedsProto(__aarch64_cas8_acq) \ + SymE_NeedsProto(__aarch64_cas8_acq_rel) \ + SymE_NeedsProto(__aarch64_cas8_rel) \ + SymE_NeedsProto(__aarch64_cas8_relax) \ + SymE_NeedsProto(__aarch64_cas8_sync) \ + SymE_NeedsProto(__aarch64_ldadd1_acq) \ + SymE_NeedsProto(__aarch64_ldadd1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd1_rel) \ + SymE_NeedsProto(__aarch64_ldadd1_relax) \ + SymE_NeedsProto(__aarch64_ldadd1_sync) \ + SymE_NeedsProto(__aarch64_ldadd2_acq) \ + SymE_NeedsProto(__aarch64_ldadd2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd2_rel) \ + SymE_NeedsProto(__aarch64_ldadd2_relax) \ + SymE_NeedsProto(__aarch64_ldadd2_sync) \ + SymE_NeedsProto(__aarch64_ldadd4_acq) \ + SymE_NeedsProto(__aarch64_ldadd4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd4_rel) \ + SymE_NeedsProto(__aarch64_ldadd4_relax) \ + SymE_NeedsProto(__aarch64_ldadd4_sync) \ + SymE_NeedsProto(__aarch64_ldadd8_acq) \ + SymE_NeedsProto(__aarch64_ldadd8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldadd8_rel) \ + SymE_NeedsProto(__aarch64_ldadd8_relax) \ + SymE_NeedsProto(__aarch64_ldadd8_sync) \ + SymE_NeedsProto(__aarch64_ldclr1_acq) \ + SymE_NeedsProto(__aarch64_ldclr1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr1_rel) \ + SymE_NeedsProto(__aarch64_ldclr1_relax) \ + SymE_NeedsProto(__aarch64_ldclr1_sync) \ + SymE_NeedsProto(__aarch64_ldclr2_acq) \ + SymE_NeedsProto(__aarch64_ldclr2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr2_rel) \ + SymE_NeedsProto(__aarch64_ldclr2_relax) \ + SymE_NeedsProto(__aarch64_ldclr2_sync) \ + SymE_NeedsProto(__aarch64_ldclr4_acq) \ + SymE_NeedsProto(__aarch64_ldclr4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr4_rel) \ + SymE_NeedsProto(__aarch64_ldclr4_relax) \ + SymE_NeedsProto(__aarch64_ldclr4_sync) \ + SymE_NeedsProto(__aarch64_ldclr8_acq) \ + SymE_NeedsProto(__aarch64_ldclr8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldclr8_rel) \ + SymE_NeedsProto(__aarch64_ldclr8_relax) \ + SymE_NeedsProto(__aarch64_ldclr8_sync) \ + SymE_NeedsProto(__aarch64_ldeor1_acq) \ + SymE_NeedsProto(__aarch64_ldeor1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor1_rel) \ + SymE_NeedsProto(__aarch64_ldeor1_relax) \ + SymE_NeedsProto(__aarch64_ldeor1_sync) \ + SymE_NeedsProto(__aarch64_ldeor2_acq) \ + SymE_NeedsProto(__aarch64_ldeor2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor2_rel) \ + SymE_NeedsProto(__aarch64_ldeor2_relax) \ + SymE_NeedsProto(__aarch64_ldeor2_sync) \ + SymE_NeedsProto(__aarch64_ldeor4_acq) \ + SymE_NeedsProto(__aarch64_ldeor4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor4_rel) \ + SymE_NeedsProto(__aarch64_ldeor4_relax) \ + SymE_NeedsProto(__aarch64_ldeor4_sync) \ + SymE_NeedsProto(__aarch64_ldeor8_acq) \ + SymE_NeedsProto(__aarch64_ldeor8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldeor8_rel) \ + SymE_NeedsProto(__aarch64_ldeor8_relax) \ + SymE_NeedsProto(__aarch64_ldeor8_sync) \ + SymE_NeedsProto(__aarch64_ldset1_acq) \ + SymE_NeedsProto(__aarch64_ldset1_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset1_rel) \ + SymE_NeedsProto(__aarch64_ldset1_relax) \ + SymE_NeedsProto(__aarch64_ldset1_sync) \ + SymE_NeedsProto(__aarch64_ldset2_acq) \ + SymE_NeedsProto(__aarch64_ldset2_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset2_rel) \ + SymE_NeedsProto(__aarch64_ldset2_relax) \ + SymE_NeedsProto(__aarch64_ldset2_sync) \ + SymE_NeedsProto(__aarch64_ldset4_acq) \ + SymE_NeedsProto(__aarch64_ldset4_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset4_rel) \ + SymE_NeedsProto(__aarch64_ldset4_relax) \ + SymE_NeedsProto(__aarch64_ldset4_sync) \ + SymE_NeedsProto(__aarch64_ldset8_acq) \ + SymE_NeedsProto(__aarch64_ldset8_acq_rel) \ + SymE_NeedsProto(__aarch64_ldset8_rel) \ + SymE_NeedsProto(__aarch64_ldset8_relax) \ + SymE_NeedsProto(__aarch64_ldset8_sync) \ + SymE_NeedsProto(__aarch64_swp1_acq) \ + SymE_NeedsProto(__aarch64_swp1_acq_rel) \ + SymE_NeedsProto(__aarch64_swp1_rel) \ + SymE_NeedsProto(__aarch64_swp1_relax) \ + SymE_NeedsProto(__aarch64_swp1_sync) \ + SymE_NeedsProto(__aarch64_swp2_acq) \ + SymE_NeedsProto(__aarch64_swp2_acq_rel) \ + SymE_NeedsProto(__aarch64_swp2_rel) \ + SymE_NeedsProto(__aarch64_swp2_relax) \ + SymE_NeedsProto(__aarch64_swp2_sync) \ + SymE_NeedsProto(__aarch64_swp4_acq) \ + SymE_NeedsProto(__aarch64_swp4_acq_rel) \ + SymE_NeedsProto(__aarch64_swp4_rel) \ + SymE_NeedsProto(__aarch64_swp4_relax) \ + SymE_NeedsProto(__aarch64_swp4_sync) \ + SymE_NeedsProto(__aarch64_swp8_acq) \ + SymE_NeedsProto(__aarch64_swp8_acq_rel) \ + SymE_NeedsProto(__aarch64_swp8_rel) \ + SymE_NeedsProto(__aarch64_swp8_relax) \ + SymE_NeedsProto(__aarch64_swp8_sync) ===================================== rts/RtsSymbols.c ===================================== @@ -967,6 +967,13 @@ extern char **environ; #define RTS_LIBGCC_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt for AArch64's outline atomics. +#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) +#include "AArch64Symbols.h" +#else +#define RTS_AARCH64_SYMBOLS +#endif + // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -1014,6 +1021,7 @@ RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +RTS_AARCH64_SYMBOLS #undef SymI_NeedsProto #undef SymI_NeedsDataProto @@ -1055,6 +1063,7 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS + RTS_AARCH64_SYMBOLS SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e26170a2847fd521f1340cd234d259bd10d7bbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e26170a2847fd521f1340cd234d259bd10d7bbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 16:58:13 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 07 Jul 2023 12:58:13 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] wip Message-ID: <64a84424f3778_31499caeeac16797a@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: 7d1ebddc by Andreas Klebinger at 2023-07-07T19:00:20+02:00 wip - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -418,7 +418,7 @@ getArithImm n -- 12 bits shifted by 12 places. | trailing_zeros >= 12 && sized_n < 2^(24::Int) - = Just $ OpImmShift (ImmInteger n) SLSL 12 + = Just $ OpImmShift (ImmInteger n `shiftR` 12) SLSL 12 | otherwise = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d1ebddcd12887d5e03dbe9442578160693927e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d1ebddcd12887d5e03dbe9442578160693927e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 16:59:34 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 07 Jul 2023 12:59:34 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] wip Message-ID: <64a84476e6532_31499caee8416810@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: bacd8c7f by Andreas Klebinger at 2023-07-07T19:01:43+02:00 wip - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -386,15 +386,15 @@ getMovWideImm n -- 0x0000 0000 xxxx 0000 | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) - = Just $ OpImmShift (ImmInteger n) SLSL 16 + = Just $ OpImmShift (ImmInteger n `shiftR` 16) SLSL 16 -- 0x 0000 xxxx 0000 0000 | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) - = Just $ OpImmShift (ImmInteger n) SLSL 32 + = Just $ OpImmShift (ImmInteger n `shiftR` 32) SLSL 32 -- 0x xxxx 0000 0000 0000 | trailing_zeros >= 48 - = Just $ OpImmShift (ImmInteger n) SLSL 48 + = Just $ OpImmShift (ImmInteger n `shiftR` 48) SLSL 48 | otherwise = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bacd8c7f31e333dac81a8660d33806ead893f86c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bacd8c7f31e333dac81a8660d33806ead893f86c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 17:01:38 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 07 Jul 2023 13:01:38 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] wip Message-ID: <64a844f2ea1e6_31499caee20170285@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: 5757ec93 by Andreas Klebinger at 2023-07-07T19:03:46+02:00 wip - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -386,15 +386,15 @@ getMovWideImm n -- 0x0000 0000 xxxx 0000 | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) - = Just $ OpImmShift (ImmInteger n `shiftR` 16) SLSL 16 + = Just $ OpImmShift (ImmInteger $ n `shiftR` 16) SLSL 16 -- 0x 0000 xxxx 0000 0000 | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) - = Just $ OpImmShift (ImmInteger n `shiftR` 32) SLSL 32 + = Just $ OpImmShift (ImmInteger $ n `shiftR` 32) SLSL 32 -- 0x xxxx 0000 0000 0000 | trailing_zeros >= 48 - = Just $ OpImmShift (ImmInteger n `shiftR` 48) SLSL 48 + = Just $ OpImmShift (ImmInteger $ n `shiftR` 48) SLSL 48 | otherwise = Nothing @@ -418,7 +418,7 @@ getArithImm n -- 12 bits shifted by 12 places. | trailing_zeros >= 12 && sized_n < 2^(24::Int) - = Just $ OpImmShift (ImmInteger n `shiftR` 12) SLSL 12 + = Just $ OpImmShift (ImmInteger $ n `shiftR` 12) SLSL 12 | otherwise = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5757ec93d07a11827ac0938ae0a59f7140632f0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5757ec93d07a11827ac0938ae0a59f7140632f0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 17:07:39 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Fri, 07 Jul 2023 13:07:39 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] WIP: Better arm immediate handling Message-ID: <64a8465bbe5fa_31499caee98173675@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: b32102e3 by Andreas Klebinger at 2023-07-07T19:09:35+02:00 WIP: Better arm immediate handling wip wip wip w - - - - - 3 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/X86/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -372,6 +372,70 @@ getSomeReg expr = do Fixed rep reg code -> return (reg, rep, code) +-- | Move (wide immediate) +-- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. +-- Covers MOVZ,MOVN, MOVK +getMovWideImm :: Integer -> Maybe Operand +getMovWideImm n + -- TODO: Handle sign extension + | n <= 0 + = Nothing + -- Fits in 16 bits + | sized_n < 2^(16 :: Int) + = Just $ OpImm (ImmInteger n) + + -- 0x0000 0000 xxxx 0000 + | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) + = Just $ OpImmShift (ImmInteger $ n `shiftR` 16) SLSL 16 + + -- 0x 0000 xxxx 0000 0000 + | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) + = Just $ OpImmShift (ImmInteger $ n `shiftR` 32) SLSL 32 + + -- 0x xxxx 0000 0000 0000 + | trailing_zeros >= 48 + = Just $ OpImmShift (ImmInteger $ n `shiftR` 48) SLSL 48 + + | otherwise + = Nothing + where + sized_n = fromIntegral n :: Word64 + trailing_zeros = countTrailingZeros sized_n +-- getMovWideImm _ = Nothing + +-- | Arithmetic(immediate) +-- Allows for 12bit immediates which can be shifted by 0 or 12 bits. +-- Covers ADD, ADDS, SUB, SUBS, CMP, CMN +getArithImm :: Integer -> Maybe Operand +getArithImm n + -- TODO: Handle sign extension + | n <= 0 + = Nothing + -- Fits in 16 bits + -- Fits in 12 bits + | sized_n < 2^(12::Int) + = Just $ OpImm (ImmInteger n) + + -- 12 bits shifted by 12 places. + | trailing_zeros >= 12 && sized_n < 2^(24::Int) + = Just $ OpImmShift (ImmInteger $ n `shiftR` 12) SLSL 12 + + | otherwise + = Nothing + where + sized_n = fromIntegral n :: Word64 + trailing_zeros = countTrailingZeros sized_n + +-- | Logical (immediate) +-- Allows for Note [Logical immediate instruction variant] +-- Covers AND, ANDS, EOR, ORR, TST +-- and their aliases which includes at least MOV (bitmask immediate) +getBitmaskImm :: Integer -> Maybe Operand +getBitmaskImm n + | isAArch64Bitmask n = Just $ OpImm (ImmInteger n) + | otherwise = Nothing + + -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) @@ -494,8 +558,13 @@ getRegister' config plat expr CmmLit lit -> case lit of - -- TODO handle CmmInt 0 specially, use wzr or xzr. - + -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move. + CmmInt 0 W32 -> do + let format = intFormat W32 + return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) + CmmInt 0 W64 -> do + let format = intFormat W64 + return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) CmmInt i W16 | i >= 0 -> do @@ -791,17 +860,51 @@ getRegister' config plat expr -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op -- A "plain" operation. - bitOp w op = do + bitOpImm w op encode_imm = do -- compute x <- x -- compute x <- y -- x, x, x (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, format_y, code_y) <- getSomeReg y - massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOp: incompatible" + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOpImm: incompatible" return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` - op (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) + op (OpReg w dst) (OpReg w reg_x) op_y) + + -- A (potentially signed) integer operation. + -- In the case of 8- and 16-bit signed arithmetic we must first + -- sign-extend both arguments to 32-bits. + -- See Note [Signed arithmetic on AArch64]. + intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Maybe Operand) -> NatM (Register) + intOpImm {- is signed -} True w op _encode_imm = intOp True w op + intOpImm False w op encode_imm = do + -- compute x <- x + -- compute x <- y + -- x, x, x + (reg_x, format_x, code_x) <- getSomeReg x + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" + -- This is the width of the registers on which the operation + -- should be performed. + let w' = opRegWidth w + return $ Any (intFormat w) $ \dst -> + code_x `appOL` + code_y `appOL` + op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL` + truncateReg w' w dst -- truncate back to the operand's original width -- A (potentially signed) integer operation. -- In the case of 8- and 16-bit signed arithmetic we must first @@ -847,9 +950,9 @@ getRegister' config plat expr case op of -- Integer operations -- Add/Sub should only be Integer Options. - MO_Add w -> intOp False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) + MO_Add w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) getArithImm -- TODO: Handle sub-word case - MO_Sub w -> intOp False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) + MO_Sub w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) getArithImm -- Note [CSET] -- ~~~~~~~~~~~ @@ -891,8 +994,8 @@ getRegister' config plat expr -- N.B. We needn't sign-extend sub-word size (in)equality comparisons -- since we don't care about ordering. - MO_Eq w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d EQ ]) - MO_Ne w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d NE ]) + MO_Eq w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d EQ ]) getArithImm + MO_Ne w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d NE ]) getArithImm -- Signed multiply/divide MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) @@ -921,10 +1024,10 @@ getRegister' config plat expr MO_S_Lt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLT ]) -- Unsigned comparisons - MO_U_Ge w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) - MO_U_Le w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) - MO_U_Gt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) - MO_U_Lt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) + MO_U_Ge w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm + MO_U_Le w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm + MO_U_Gt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm + MO_U_Lt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm -- Floating point arithmetic MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) @@ -947,9 +1050,9 @@ getRegister' config plat expr MO_F_Lt w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OLT ]) -- x < y <=> y >= x -- Bitwise operations - MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) + MO_And w -> bitOpImm w (\d x y -> unitOL $ AND d x y) getBitmaskImm + MO_Or w -> bitOpImm w (\d x y -> unitOL $ ORR d x y) getBitmaskImm + MO_Xor w -> bitOpImm w (\d x y -> unitOL $ EOR d x y) getBitmaskImm MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) @@ -999,7 +1102,7 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool - isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) + isNbitEncodeable n_bits i = let shift = n_bits - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -782,6 +782,9 @@ wzr = OpReg W32 (RegReal (RealRegSingle (-1))) sp = OpReg W64 (RegReal (RealRegSingle 31)) ip0 = OpReg W64 (RegReal (RealRegSingle 16)) +reg_zero :: Reg +reg_zero = RegReal (RealRegSingle (-1)) + _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) x0, x1, x2, x3, x4, x5, x6, x7 :: Operand ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -275,6 +275,11 @@ The fp registers are all Double registers; we don't have any RcFloat class regs. @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should never generate them. +esp, esi, edi and ebp are reserved for specific purporses o *generally* free to use because they are +reserved for reserved for + +eax ebx ecx edx + TODO: cleanup modelling float vs double registers and how they are the same class. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b32102e3f502c78a66f84e1c4041c1511183b384 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b32102e3f502c78a66f84e1c4041c1511183b384 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 18:04:09 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 07 Jul 2023 14:04:09 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] CmmLoad: Load sub-words unsigned (no sign-extension) Message-ID: <64a853995a779_31499caee98176745@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: b21e0985 by Sven Tennie at 2023-07-07T20:01:41+02:00 CmmLoad: Load sub-words unsigned (no sign-extension) The contract is that each operation should leave sub-words zero-extended. This fixes the test (test-primops): // Failed: // 0::W64 - (~(zext[W32→W64](load[W32](0x8c::W64)))) // ((0 :: bits64) - (~%zx64(bits32[buffer + (140 :: bits64)]))) // 0x8f8e8d8d /= 0xffffffff8f8e8d8d test(bits64 buffer) { bits64 ret; ret = ((0 :: bits64) - (~%zx64(bits32[buffer + (140 :: bits64)]))); return (ret); } - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -559,9 +559,16 @@ getRegister' config plat expr = CmmBlock _ -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr) CmmHighStackMark -> pprPanic "getRegister' (CmmLit:CmmLabelOff): " (pdoc plat expr) CmmLoad mem rep _ -> do - Amode addr addr_code <- getAmode plat (typeWidth rep) mem let format = cmmTypeFormat rep - return (Any format (\dst -> addr_code `snocOL` LDR format (OpReg (formatToWidth format) dst) (OpAddr addr))) + width = typeWidth rep + Amode addr addr_code <- getAmode plat width mem + case width of + w | w <= W64 -> + -- Load without sign-extension. See Note [Signed arithmetic on RISCV64] + pure (Any format (\dst -> addr_code `snocOL` LDRU format (OpReg width dst) (OpAddr addr))) + _ -> + pprPanic ("Width too big! Cannot load: " ++ show width) (pdoc plat expr) + CmmStackSlot _ _ -> pprPanic "getRegister' (CmmStackSlot): " (pdoc plat expr) CmmReg reg ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -126,6 +126,7 @@ regUsageOfInstr platform instr = case instr of STR _ src dst -> usage (regOp src ++ regOp dst, []) -- STLR _ src dst L -> usage (regOp src ++ regOp dst, []) LDR _ dst src -> usage (regOp src, regOp dst) + LDRU _ dst src -> usage (regOp src, regOp dst) -- LDAR _ dst src -> usage (regOp src, regOp dst) -- TODO is this right? see STR, which I'm only partial about being right? -- STP _ src1 src2 dst -> usage (regOp src1 ++ regOp src2 ++ regOp dst, []) @@ -263,6 +264,7 @@ patchRegsOfInstr instr env = case instr of STR f o1 o2 -> STR f (patchOp o1) (patchOp o2) -- STLR f o1 o2 -> STLR f (patchOp o1) (patchOp o2) LDR f o1 o2 -> LDR f (patchOp o1) (patchOp o2) + LDRU f o1 o2 -> LDRU f (patchOp o1) (patchOp o2) -- LDAR f o1 o2 -> LDAR f (patchOp o1) (patchOp o2) -- STP f o1 o2 o3 -> STP f (patchOp o1) (patchOp o2) (patchOp o3) -- LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3) @@ -577,7 +579,8 @@ data Instr -- We do however have {L,S}{B,H,W,D}[U] instructions for Load/Store, Byte, Half, Word, Double, (Unsigned). -- Reusing the arm logic with the _format_ specifier will hopefully work. | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr - | LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr + | LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr (sign-extended) + | LDRU Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr (unsigned) -- 3. Control Flow --------------------------------------------------------- -- B{EQ,GE,GEU,LT,LTU}, these are effectively BCOND from AArch64; @@ -710,6 +713,7 @@ instrCon i = STR{} -> "STR" -- STLR{} -> "STLR" LDR{} -> "LDR" + LDRU{} -> "LDRU" -- LDAR{} -> "LDAR" -- STP{} -> "STP" -- LDP{} -> "LDP" ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -638,6 +638,7 @@ pprInstr platform instr = case instr of -- op_add o1 (text "%pcrel_lo(" <> pprAsmLabel platform lbl <> text ")") line $ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl + -- TODO: Are these two special cases really needed? LDR _f o1@(OpReg W8 reg) o2 | isIntRealReg reg -> op2 (text "\tlb") o1 o2 LDR _f o1@(OpReg W16 reg) o2 | isIntRealReg reg -> @@ -649,6 +650,13 @@ pprInstr platform instr = case instr of LDR II64 o1 o2 -> op2 (text "\tld") o1 o2 LDR FF32 o1 o2 -> op2 (text "\tflw") o1 o2 LDR FF64 o1 o2 -> op2 (text "\tfld") o1 o2 + + LDRU II8 o1 o2 -> op2 (text "\tlbu") o1 o2 + LDRU II16 o1 o2 -> op2 (text "\tlhu") o1 o2 + LDRU II32 o1 o2 -> op2 (text "\tlwu") o1 o2 + -- double words (64bit) cannot be sign extended by definition + LDRU II64 o1 o2 -> op2 (text "\tld") o1 o2 + LDRU f o1 o2 -> pprPanic "Unsupported unsigned load" ((text.show) f <+> pprOp platform o1 <+> pprOp platform o2) -- LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2 -- STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b21e0985ea6c354ee6e147d2239dccdf7102241a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b21e0985ea6c354ee6e147d2239dccdf7102241a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 7 20:26:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 07 Jul 2023 16:26:00 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 21 commits: JS: cleanup utils (#23314) Message-ID: <64a874d84bfe3_31499caeec0199316@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - a6e1321b by Ben Gamari at 2023-07-07T16:25:40-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 53b655dc by Ben Gamari at 2023-07-07T16:25:40-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - cae55a40 by Ben Gamari at 2023-07-07T16:25:41-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 524872c4 by Ben Gamari at 2023-07-07T16:25:41-04:00 base: Introduce Data.Enum - - - - - 405978f1 by Ben Gamari at 2023-07-07T16:25:41-04:00 base: Add export list to GHC.Num.Integer - - - - - 4b1cf66f by Ben Gamari at 2023-07-07T16:25:41-04:00 base: Add export list to GHC.Num - - - - - f24122d6 by Ben Gamari at 2023-07-07T16:25:41-04:00 base: Add export list to GHC.Num.Natural - - - - - d2f321be by Ben Gamari at 2023-07-07T16:25:41-04:00 base: Add export list to GHC.Float - - - - - 87a1da65 by Ben Gamari at 2023-07-07T16:25:41-04:00 base: Add export list to GHC.Real - - - - - 294c5825 by Ben Gamari at 2023-07-07T16:25:41-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - hadrian/stack.yaml - hadrian/stack.yaml.lock - + libraries/base/Data/Enum.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9f527e13e152b92584ffdc90c69be4deafb62a0...294c582596379b9d63871526c9ef118657d58398 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9f527e13e152b92584ffdc90c69be4deafb62a0...294c582596379b9d63871526c9ef118657d58398 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 09:06:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 05:06:03 -0400 Subject: [Git][ghc/ghc][master] 2 commits: compiler: Rework ShowSome Message-ID: <64a926fb92f0a_46db6af8e842168@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - 17 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - testsuite/tests/ghci/scripts/ghci008.stdout - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - + testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -834,10 +834,13 @@ When printing an interface file (--show-iface), we want to print everything unqualified, so we can just print the OccName directly. -} +-- | Show a declaration but not its RHS. showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing , ss_forall = ShowForAllWhen } +-- | Show declaration and its RHS, including GHc-internal information (e.g. +-- for @--show-iface@). showToIface :: ShowSub showToIface = ShowSub { ss_how_much = ShowIface , ss_forall = ShowForAllWhen } @@ -848,18 +851,20 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome Nothing _ }) doc + = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome (Just f) _ }) thing + = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1361,21 +1361,18 @@ data ShowSub newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch - = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + = ShowHeader AltPpr -- ^ Header information only, not rhs + | ShowSome (Maybe (OccName -> Bool)) AltPpr + -- ^ Show the declaration and its RHS. The @Maybe@ predicate + -- allows filtering of the sub-components which should be printing; + -- any sub-components filtered out will be elided with @... at . | ShowIface - -- ^Everything including GHC-internal information (used in --show-iface) + -- ^ Everything including GHC-internal information (used in --show-iface) instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc pprIfaceSigmaType show_forall ty ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,16 +145,24 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = case parents thing of + -- If there are no parents print everything. + [] -> print_it Nothing thing + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let subs = map getOccName (thing:rest) + filt = (`elem` subs) + in print_it (Just filt) thing' where - go ss thing - = case tyThingParent_maybe thing of - Just parent -> - go (getOccName thing : ss) parent - Nothing -> - pprTyThing - (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) - thing + parents = go + where + go thing = + case tyThingParent_maybe thing of + Just parent -> parent : go parent + Nothing -> [] + + print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc + print_it mb_filt thing = + pprTyThing (show_sub { ss_how_much = ShowSome mb_filt (AltPpr Nothing) }) thing -- | Like 'pprTyThingInContext', but adds the defining location. pprTyThingInContextLoc :: TyThing -> SDoc @@ -171,8 +179,8 @@ pprTyThing ss ty_thing pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing) where ss' = case ss_how_much ss of - ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } - ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' } + ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } + ShowSome filt (AltPpr Nothing) -> ss { ss_how_much = ShowSome filt ppr' } _ -> ss ppr' = AltPpr $ ppr_bndr $ getName ty_thing ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/ghci/scripts/ghci008.stdout ===================================== @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ -base-4.16.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘base-4.16.0.0:Data.OldList’ +base-4.18.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.18.0.0:Data.OldList’ ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,243 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc, mkVarOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons ++ + map mkVarOcc integerConversionIds + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + + -- Conversion functions in GHC.Integer which are only exposed on 32-bit + -- platforms + integerConversionIds = + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> nest 2 (text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}") + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6df15e93171cf6ee9aeee642ede2d816a084efda...8165404bb7ab37bada9c2ccf99c9711817ff8f13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6df15e93171cf6ee9aeee642ede2d816a084efda...8165404bb7ab37bada9c2ccf99c9711817ff8f13 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 09:06:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 05:06:35 -0400 Subject: [Git][ghc/ghc][master] Deprecate Data.List.NonEmpty.unzip Message-ID: <64a9271bb2c9b_46db6af8fc46730@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 6 changed files: - compiler/GHC/Data/Bag.hs - compiler/GHC/HsToCore/Match/Constructor.hs - hadrian/src/Rules/Dependencies.hs - libraries/base/Control/Monad/Zip.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md Changes: ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -7,6 +7,7 @@ Bag: an unordered collection with duplicates -} {-# LANGUAGE ScopedTypeVariables, DeriveTraversable, TypeFamilies #-} +{-# OPTIONS_GHC -Wno-deprecations #-} module GHC.Data.Bag ( Bag, -- abstract type ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-deprecations #-} {- (c) The University of Glasgow 2006 ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} + module Rules.Dependencies (buildPackageDependencies) where import Data.Bifunctor ===================================== libraries/base/Control/Monad/Zip.hs ===================================== @@ -20,6 +20,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) import Data.Functor.Identity +import qualified Data.Functor import Data.Monoid import Data.Ord ( Down(..) ) import Data.Proxy @@ -65,7 +66,7 @@ instance MonadZip [] where instance MonadZip NE.NonEmpty where mzip = NE.zip mzipWith = NE.zipWith - munzip = NE.unzip + munzip = Data.Functor.unzip -- | @since 4.8.0.0 instance MonadZip Identity where ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,6 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -34,6 +34,7 @@ * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) * Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec1c32e23f47add28ceaca33aba02c277b02496b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec1c32e23f47add28ceaca33aba02c277b02496b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 09:07:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 05:07:21 -0400 Subject: [Git][ghc/ghc][master] Drop latent mentions of -split-objs Message-ID: <64a92749a3299_46db6afbf451749@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - 6 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/StgToCmm.hs - docs/users_guide/phases.rst - docs/users_guide/using.rst - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1120,9 +1120,6 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_opt_windres = f : toolSettings_opt_windres s } - , make_ord_flag defGhcFlag "split-objs" - (NoArg $ addWarn "ignoring -split-objs") - -- N.B. We may someday deprecate this in favor of -fsplit-sections, -- which has the benefit of also having a negating -fno-split-sections. , make_ord_flag defGhcFlag "split-sections" ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -1080,11 +1080,9 @@ tidyTopName mod name_cache maybe_ref occ_env id -- See #19619 let new_local_name = occ' `seq` mkInternalName uniq occ' loc return (occ_env', new_local_name) - -- Even local, internal names must get a unique occurrence, because - -- if we do -split-objs we externalise the name later, in the code generator - -- - -- Similarly, we must make sure it has a system-wide Unique, because - -- the byte-code generator builds a system-wide Name->BCO symbol table + -- Even local, internal names must get a unique occurrence. + -- This is necessary because the byte-code generator the byte-code + -- generator builds a system-wide Name->BCO symbol table. | local && external = do new_external_name <- allocateGlobalBinder name_cache mod occ' loc return (occ_env', new_external_name) ===================================== compiler/GHC/StgToCmm.hs ===================================== @@ -103,10 +103,6 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons yield cmm return a - -- Note [codegen-split-init] the cmm_init block must come - -- FIRST. This is because when -split-objs is on we need to - -- combine this block with its initialisation routines; see - -- Note [pipeline-split-init]. ; cg (mkModuleInit cost_centre_info (stgToCmmThisModule cfg) hpc_info) ; mapM_ (cg . cgTopBinding logger tmpfs cfg) stg_binds ===================================== docs/users_guide/phases.rst ===================================== @@ -746,19 +746,6 @@ Options affecting code generation ``-dynamic-too`` is ignored if :ghc-flag:`-dynamic` is also specified. -.. ghc-flag:: -split-objs - :shortdesc: Split generated object files into smaller files - :type: dynamic - :category: codegen - - When using this option, the object file is split into many smaller objects. - This feature is used when building libraries, so that a program statically - linked against the library will pull in less of the library. - - Since this uses platform specific techniques, it may not be available on - all target platforms. See the :ghc-flag:`--print-object-splitting-supported` - flag to check whether your GHC supports object splitting. - .. ghc-flag:: -fexpose-internal-symbols :shortdesc: Produce symbols for all functions, including internal functions. :type: dynamic ===================================== docs/users_guide/using.rst ===================================== @@ -576,11 +576,8 @@ The available mode flags are: :type: mode :category: modes - Print ``YES`` if GHC was compiled with support for splitting generated - object files into smaller objects, ``NO`` otherwise. - This feature uses platform specific techniques and may not be available on - all platforms. - See :ghc-flag:`-split-objs` for details. + Prints ``NO`` as object splitting is no longer supported. See + :ghc-flag:`-split-sections` for a more portable and reliable alternative. .. ghc-flag:: --print-project-git-commit-id :shortdesc: display Git commit id GHC is built from ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -16,8 +16,6 @@ ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] -ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] -ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] ref compiler/GHC/StgToCmm/Expr.hs:585:4: Note [case on bool] ref compiler/GHC/StgToCmm/Expr.hs:853:3: Note [alg-alt heap check] ref compiler/GHC/Tc/Gen/HsType.hs:556:56: Note [Skolem escape prevention] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d2442b806c0bfe7de5afcb98460691a7baef33e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d2442b806c0bfe7de5afcb98460691a7baef33e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 09:08:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 05:08:30 -0400 Subject: [Git][ghc/ghc][master] Add warn_and_run test kind Message-ID: <64a9278ee855e_46db6afbcc55340@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - 5 changed files: - testsuite/driver/testlib.py - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_compile/rn039.stderr → testsuite/tests/rename/should_compile/rn039.ghc.stderr - testsuite/tests/rename/should_compile/rn039.hs - + testsuite/tests/rename/should_compile/rn039.stdout Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1653,7 +1653,8 @@ async def compile_and_run__(name: TestName, top_mod: Path, extra_mods: List[str], extra_hc_opts: str, - backpack: bool=False + backpack: bool=False, + compile_stderr: bool=False ) -> PassFail: # print 'Compile and run, extra args = ', extra_hc_opts @@ -1670,6 +1671,23 @@ async def compile_and_run__(name: TestName, if badResult(result): return result + if compile_stderr: + expected_stderr_file = find_expected_file(name, 'ghc.stderr') + actual_stderr_file = add_suffix(name, 'comp.stderr') + diff_file_name = in_testdir(add_suffix(name, 'comp.diff')) + + if not await compare_outputs(way, 'stderr', + join_normalisers(getTestOpts().extra_errmsg_normaliser, + normalise_errmsg), + expected_stderr_file, actual_stderr_file, + diff_file=diff_file_name, + whitespace_normaliser=getattr(getTestOpts(), + "whitespace_normaliser", + normalise_whitespace)): + stderr = diff_file_name.read_text() + diff_file_name.unlink() + return failBecause('ghc.stderr mismatch', stderr=stderr) +# cmd = './' + name + exe_extension() # we don't check the compiler's stderr for a compile-and-run test @@ -1684,6 +1702,9 @@ async def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ): async def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ): return await compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts) +async def warn_and_run( name, way, extra_hc_opts ): + return await compile_and_run__( name, way, None, [], extra_hc_opts, compile_stderr = True) + def stats( name, way, stats_file ): opts = getTestOpts() return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields) ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -31,7 +31,7 @@ test('rn037', normal, compile, ['']) # Missing: # test('rn038', normal, compile, ['']) -test('rn039', normal, compile, ['']) +test('rn039', normal, warn_and_run, ['']) test('rn040', normal, compile, ['-fwarn-unused-binds -fwarn-unused-matches']) test('rn041', normal, compile, ['']) test('rn042', [extra_files(['Rn042_A.hs'])], multimod_compile, ['rn042', '-v0']) ===================================== testsuite/tests/rename/should_compile/rn039.stderr → testsuite/tests/rename/should_compile/rn039.ghc.stderr ===================================== @@ -1,5 +1,7 @@ +[1 of 2] Compiling Main ( rn039.hs, rn039.o ) -rn039.hs:6:16: warning: [GHC-63397] [-Wname-shadowing (in -Wall)] +rn039.hs:6:20: warning: [GHC-63397] [-Wname-shadowing (in -Wall)] This binding for ‘-’ shadows the existing binding - imported from ‘Prelude’ at rn039.hs:2:8-20 + imported from ‘Prelude’ at rn039.hs:2:8-11 (and originally defined in ‘GHC.Num’) +[2 of 2] Linking rn039 ===================================== testsuite/tests/rename/should_compile/rn039.hs ===================================== @@ -1,6 +1,9 @@ {-# OPTIONS -fwarn-name-shadowing #-} -module ShouldCompile where +module Main (main) where -- !!! test shadowing of a global name -g = 42 where f -1 = -1 -- shadows (-), probably by accident! +g = 42 - 1 where f -1 = -1 -- shadows (-), probably by accident! + +main :: IO () +main = print g ===================================== testsuite/tests/rename/should_compile/rn039.stdout ===================================== @@ -0,0 +1 @@ +-1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9bc20cb3d772671317caf0a642d574f34493d23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9bc20cb3d772671317caf0a642d574f34493d23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 09:09:14 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 05:09:14 -0400 Subject: [Git][ghc/ghc][master] configure: Don't use ld.gold on i386 Message-ID: <64a927b9f3d6e_46db6afc1c58694@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 1 changed file: - m4/find_ld.m4 Changes: ===================================== m4/find_ld.m4 ===================================== @@ -21,10 +21,19 @@ AC_DEFUN([FIND_LD],[ return fi + case $CPU in + i386) + # We refuse to use ld.gold on i386 due to #23579, which we don't + # have a good autoconf check for. + linkers="ld.lld ld" ;; + *) + linkers="ld.lld ld.gold ld" ;; + esac + # Manually iterate over possible names since we want to ensure that, e.g., # if ld.lld is installed but gcc doesn't support -fuse-ld=lld, that we # then still try ld.gold and -fuse-ld=gold. - for possible_ld in ld.lld ld.gold ld; do + for possible_ld in $linkers; do TmpLd="" # In case the user set LD AC_CHECK_TARGET_TOOL([TmpLd], [$possible_ld]) if test "x$TmpLd" = "x"; then continue; fi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c702696258f771d149d5fe5f8ea8b143d45d80e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c702696258f771d149d5fe5f8ea8b143d45d80e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 09:39:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 05:39:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: compiler: Rework ShowSome Message-ID: <64a92eee70147_46db6afc1c6938e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 35575466 by Ben Gamari at 2023-07-08T05:39:30-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 25bf44b4 by Bodigrim at 2023-07-08T05:39:42-04:00 Add since annotations for Data.Foldable1 - - - - - 9863cbdb by Sylvain Henry at 2023-07-08T05:39:53-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Types/TyThing/Ppr.hs - docs/users_guide/phases.rst - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - libraries/base/Control/Monad/Zip.hs - libraries/base/Data/Foldable1.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md - libraries/ghc-prim/changelog.md - m4/find_ld.m4 - testsuite/driver/testlib.py - testsuite/mk/boilerplate.mk - + testsuite/tests/driver/T23613.hs - testsuite/tests/driver/all.T - testsuite/tests/driver/multipleHomeUnits/all.T - testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/499862761bb07e8fa70126ebe65c746533ef094e...9863cbdb553aa6384930145a24a690cb1698bd1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/499862761bb07e8fa70126ebe65c746533ef094e...9863cbdb553aa6384930145a24a690cb1698bd1c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 10:56:44 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 08 Jul 2023 06:56:44 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 2 commits: Move T18730 to perf/compiler where it belongs Message-ID: <64a940ecf0ea0_46db6afbf486910@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: d277c9f8 by Simon Peyton Jones at 2023-07-08T11:55:11+01:00 Move T18730 to perf/compiler where it belongs - - - - - a4a1b31a by Simon Peyton Jones at 2023-07-08T11:55:54+01:00 Try removing the too_many_occs idea Maybe other things now cover this adequately; if not we should know exactly why we need it. - - - - - 6 changed files: - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - testsuite/tests/perf/compiler/all.T - − testsuite/tests/simplCore/should_compile/T18730.hs - − testsuite/tests/simplCore/should_compile/T18730_A.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Inline.hs ===================================== @@ -263,9 +263,7 @@ tryUnfolding logger opts !case_depth !inline_depth id lone_variable arg_infos small_enough = adjusted_size <= unfoldingUseThreshold opts discount = computeDiscount arg_discounts res_discount arg_infos cont_info - extra_doc = vcat [ text "case depth =" <+> int case_depth - , text "inline depth =" <+> int inline_depth - , text "depth based penalty =" <+> int depth_penalty + extra_doc = vcat [ text "depth based penalty =" <+> int depth_penalty , text "discounted size =" <+> int adjusted_size ] where -- Unpack the UnfoldingCache lazily because it may not be needed, and all @@ -282,6 +280,8 @@ tryUnfolding logger opts !case_depth !inline_depth id lone_variable arg_infos , text "is exp:" <+> ppr is_exp , text "is work-free:" <+> ppr is_wf , text "guidance" <+> ppr guidance + , text "case depth =" <+> int case_depth + , text "inline depth =" <+> int inline_depth , extra_doc , text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"] ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3999,7 +3999,7 @@ if this applies recursive to the next `case` inwards, and so on, the net effect is that we can get an exponential number of calls to $j1a and $j1b, and an exponential number of inlinings (since each is done independently). -This hit #15360 (not a complicated program) badly. Out brutal solution is this: +This hit #15360 (not a complicated program!) badly. Our simple solution is this: when a join point is born, we don't give it an unfolding. So we end up with $j1a x = e1 $j1b y = e2 @@ -4007,9 +4007,9 @@ when a join point is born, we don't give it an unfolding. So we end up with $j2b x = ...$j1a ... $j1b... ... and so on... -Now we are into Note [Avoiding exponential inlining], which is still -a challenge. But at least we have a chance. If we add inlinings at birth -we never get that chance. +Now we are into Note [Avoiding exponential inlining], which is still a +challenge. But at least we have a chance. If we add inlinings at birth we +never get that chance. Note [Duplicating alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -4396,19 +4396,21 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf = simplStableUnfolding env bind_cxt id rhs_ty arity unf | isExitJoinId id = return noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify - | isJoinId id - , too_many_occs (idOccInfo id) - = return noUnfolding +-- | isJoinId id +-- , too_many_occs (idOccInfo id) +-- = return noUnfolding | otherwise = -- Otherwise, we end up retaining all the SimpleEnv let !opts = seUnfoldingOpts env in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs +{- where -- ToDo: document this too_many_occs (ManyOccs {}) = True too_many_occs (OneOcc { occ_n_br = n }) = n > 10 too_many_occs IAmDead = False too_many_occs (IAmALoopBreaker {}) = False +-} ------------------- mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -202,6 +202,14 @@ test('CoOpt_Singletons', ######### +# Moved from simplCore/should_compile +test('T18730', normal, + [ only_ways(['optasm']), + collect_compiler_stats('bytes allocated',1) + , extra_files(['T8730_aux.hs']) + ], + ['T18730_A', '-v0 -O']) + test ('LargeRecord', [ only_ways(['normal']), collect_compiler_stats('bytes allocated',1) ===================================== testsuite/tests/simplCore/should_compile/T18730.hs deleted ===================================== @@ -1,26 +0,0 @@ -{-# LANGUAGE TupleSections #-} -{-# OPTIONS_GHC -funfolding-case-scaling=5 #-} - -module T18730 where - -import T18730_A (Gen) - -genFields :: Gen [(String, Int)] -genFields = - mapM - (\(f, g) -> (f,) <$> g) - [ ("field", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - , ("field_10", genIntField) - ] - -genIntField :: Gen Int -genIntField = pure 0 ===================================== testsuite/tests/simplCore/should_compile/T18730_A.hs deleted ===================================== @@ -1,50 +0,0 @@ -module T18730_A where - -import Control.Monad (ap) -import Data.Word -import Data.Bits - -newtype Gen a = MkGen - { -- | Run the generator on a particular seed. - -- If you just want to get a random value out, consider using 'generate'. - unGen :: QCGen -> Int -> a - } - -instance Functor Gen where - fmap f (MkGen h) = - MkGen (\r n -> f (h r n)) - -instance Applicative Gen where - pure x = - MkGen (\_ _ -> x) - (<*>) = ap - -instance Monad Gen where - return = pure - - MkGen m >>= k = - MkGen - ( \r n -> - case split r of - (r1, r2) -> - let MkGen m' = k (m r1 n) - in m' r2 n - ) - - (>>) = (*>) - -data QCGen = QCGen !Word64 !Word64 - -split :: QCGen -> (QCGen, QCGen) -split (QCGen seed gamma) = - (QCGen seed'' gamma, QCGen seed' (mixGamma seed'')) - where - seed' = seed + gamma - seed'' = seed' + gamma - --- This piece appears to be critical -mixGamma :: Word64 -> Word64 -mixGamma z0 = - if z0 >= 24 - then z0 - else z0 `xor` 0xaaaaaaaaaaaaaaaa ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -341,7 +341,6 @@ test('T18603', normal, compile, ['-dcore-lint -O']) # T18649 should /not/ generate a specialisation rule test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) -test('T18730', normal, multimod_compile, ['T18730_A', '-dcore-lint -O']) test('T18747A', normal, compile, ['']) test('T18747B', normal, compile, ['']) test('T18815', only_ways(['optasm']), makefile_test, ['T18815']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3e1e33a38f0b88f701e5c7be5398acbe4b57a25...a4a1b31a7f7a6e39f211a43ff5f8298a27fcd895 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3e1e33a38f0b88f701e5c7be5398acbe4b57a25...a4a1b31a7f7a6e39f211a43ff5f8298a27fcd895 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 14:00:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 10:00:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64a96c173caca_46db6afb90102798@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0377fc0a by Ben Gamari at 2023-07-08T10:00:32-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 73a57829 by Bodigrim at 2023-07-08T10:00:40-04:00 Add since annotations for Data.Foldable1 - - - - - 830e010f by Sylvain Henry at 2023-07-08T10:00:43-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - 53044bd6 by Bodigrim at 2023-07-08T10:00:45-04:00 Bump text submodule - - - - - 16 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/Foldable1.hs - libraries/ghc-prim/changelog.md - libraries/text - + testsuite/tests/driver/T23613.hs - testsuite/tests/driver/all.T - testsuite/tests/driver/multipleHomeUnits/all.T - testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T - testsuite/tests/driver/multipleHomeUnits/o-files/all.T - testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T - + testsuite/tests/primops/should_run/T22710.hs - + testsuite/tests/primops/should_run/T22710.stdout - testsuite/tests/primops/should_run/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1922,6 +1922,14 @@ primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp with has_side_effects = True +primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp + ByteArray# -> State# s -> (# State# s, MutableByteArray# s #) + {Make an immutable byte array mutable, without copying. + + @since 0.12.0.0} + with + has_side_effects = True + primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp ByteArray# -> Int# {Return the size of the array in bytes.} ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -371,6 +371,10 @@ emitPrimOp cfg primop = UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) arg +-- #define unsafeThawByteArrayzh(r,a) r=(a) + UnsafeThawByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> + emitAssign (CmmLocal res) arg + -- Reading/writing pointer arrays ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -327,7 +327,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache = do let (rts_wired_units, rts_wired_functions) = rtsDeps units -- all the units we want to link together, without their dependencies - let root_units = filter (/= mainUnitId) + let root_units = filter (/= ue_currentUnit unit_env) $ filter (/= interactiveUnitId) $ nub $ rts_wired_units ++ reverse obj_units ++ reverse units ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -652,6 +652,7 @@ genPrim prof bound ty op = case op of ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + UnsafeThawByteArrayOp -> \[a] [b] -> PrimInline $ a |= b SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" ===================================== libraries/base/Data/Foldable1.hs ===================================== @@ -2,6 +2,9 @@ -- Copyright: Edward Kmett, Oleg Grenrus -- License: BSD-3-Clause -- +-- A class of non-empty data structures that can be folded to a summary value. +-- +-- @since 4.18.0.0 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -12,7 +15,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} --- | A class of non-empty data structures that can be folded to a summary value. module Data.Foldable1 ( Foldable1(..), foldr1, foldr1', @@ -65,6 +67,8 @@ import Data.Coerce (Coercible, coerce) ------------------------------------------------------------------------------- -- | Non-empty data structures that can be folded. +-- +-- @since 4.18.0.0 class Foldable t => Foldable1 t where {-# MINIMAL foldMap1 | foldrMap1 #-} @@ -86,6 +90,8 @@ class Foldable t => Foldable1 t where -- them via the semigroup's @('<>')@ operator. This fold is -- right-associative and lazy in the accumulator. When you need a strict -- left-associative fold, use 'foldMap1'' instead, with 'id' as the map. + -- + -- @since 4.18.0.0 fold1 :: Semigroup m => t m -> m fold1 = foldMap1 id @@ -97,6 +103,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1 (:[]) (1 :| [2, 3, 4]) -- [1,2,3,4] -- + -- @since 4.18.0.0 foldMap1 :: Semigroup m => (a -> m) -> t a -> m foldMap1 f = foldrMap1 f (\a m -> f a <> m) @@ -107,6 +114,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1' Sum (1 :| [2, 3, 4]) -- Sum {getSum = 10} -- + -- @since 4.18.0.0 foldMap1' :: Semigroup m => (a -> m) -> t a -> m foldMap1' f = foldlMap1' f (\m a -> m <> f a) @@ -115,6 +123,7 @@ class Foldable t => Foldable1 t where -- >>> toNonEmpty (Identity 2) -- 2 :| [] -- + -- @since 4.18.0.0 toNonEmpty :: t a -> NonEmpty a toNonEmpty = runNonEmptyDList . foldMap1 singleton @@ -123,6 +132,7 @@ class Foldable t => Foldable1 t where -- >>> maximum (32 :| [64, 8, 128, 16]) -- 128 -- + -- @since 4.18.0.0 maximum :: Ord a => t a -> a maximum = getMax #. foldMap1' Max @@ -131,6 +141,7 @@ class Foldable t => Foldable1 t where -- >>> minimum (32 :| [64, 8, 128, 16]) -- 8 -- + -- @since 4.18.0.0 minimum :: Ord a => t a -> a minimum = getMin #. foldMap1' Min @@ -139,6 +150,7 @@ class Foldable t => Foldable1 t where -- >>> head (1 :| [2, 3, 4]) -- 1 -- + -- @since 4.18.0.0 head :: t a -> a head = getFirst #. foldMap1 First @@ -147,6 +159,7 @@ class Foldable t => Foldable1 t where -- >>> last (1 :| [2, 3, 4]) -- 4 -- + -- @since 4.18.0.0 last :: t a -> a last = getLast #. foldMap1 Last @@ -168,6 +181,7 @@ class Foldable t => Foldable1 t where -- -- @foldrMap1 f g = foldrMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1 f g xs = appFromMaybe (foldMap1 (FromMaybe #. h) xs) Nothing @@ -188,6 +202,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1' f z = foldlMap1' f z . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1' f g xs = foldrMap1 f' g' xs SNothing @@ -227,6 +242,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1 f g = foldlMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1 f g xs = appFromMaybe (getDual (foldMap1 ((Dual . FromMaybe) #. h) xs)) Nothing @@ -249,6 +265,7 @@ class Foldable t => Foldable1 t where -- poor fit for the task at hand. If the order in which the elements are -- combined is not important, use 'foldlMap1'' instead. -- + -- @since 4.18.0.0 foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1' f g xs = foldlMap1 f' g' xs SNothing @@ -264,21 +281,29 @@ class Foldable t => Foldable1 t where ------------------------------------------------------------------------------- -- | A variant of 'foldrMap1' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1 = foldrMap1 id {-# INLINE foldr1 #-} -- | A variant of 'foldrMap1'' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1' = foldrMap1' id {-# INLINE foldr1' #-} -- | A variant of 'foldlMap1' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1 = foldlMap1 id {-# INLINE foldl1 #-} -- | A variant of 'foldlMap1'' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1' = foldlMap1' id {-# INLINE foldl1' #-} @@ -294,6 +319,7 @@ foldl1' = foldlMap1' id -- >>> intercalate1 mempty $ "I" :| ["Am", "Fine", "You?"] -- "IAmFineYou?" -- +-- @since 4.18.0.0 intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m intercalate1 = flip intercalateMap1 id @@ -302,10 +328,14 @@ intercalateMap1 j f = flip joinee j . foldMap1 (JoinWith . const . f) -- | Monadic fold over the elements of a non-empty structure, -- associating to the right, i.e. from right to left. +-- +-- @since 4.18.0.0 foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldrM1 = foldrMapM1 return -- | Map variant of 'foldrM1'. +-- +-- @since 4.18.0.0 foldrMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (a -> b -> m b) -> t a -> m b foldrMapM1 g f = go . toNonEmpty where @@ -316,16 +346,22 @@ foldrMapM1 g f = go . toNonEmpty -- | Monadic fold over the elements of a non-empty structure, -- associating to the left, i.e. from left to right. +-- +-- @since 4.18.0.0 foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldlM1 = foldlMapM1 return -- | Map variant of 'foldlM1'. +-- +-- @since 4.18.0.0 foldlMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (b -> a -> m b) -> t a -> m b foldlMapM1 g f t = g x >>= \y -> foldlM f y xs where x:|xs = toNonEmpty t -- | The largest element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldl1' max' where max' x y = case cmp x y of @@ -334,6 +370,8 @@ maximumBy cmp = foldl1' max' -- | The least element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldl1' min' where min' x y = case cmp x y of @@ -379,6 +417,7 @@ instance Semigroup a => Semigroup (JoinWith a) where -- Instances for misc base types ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 NonEmpty where foldMap1 f (x :| xs) = go (f x) xs where go y [] = y @@ -398,9 +437,11 @@ instance Foldable1 NonEmpty where head = NE.head last = NE.last +-- | @since 4.18.0.0 instance Foldable1 Down where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Complex where foldMap1 f (x :+ y) = f x <> f y @@ -412,6 +453,7 @@ instance Foldable1 Complex where -- 3+ tuples are not Foldable/Traversable +-- | @since 4.18.0.0 instance Foldable1 Solo where foldMap1 f (MkSolo y) = f y toNonEmpty (MkSolo x) = x :| [] @@ -420,6 +462,7 @@ instance Foldable1 Solo where head (MkSolo x) = x last (MkSolo x) = x +-- | @since 4.18.0.0 instance Foldable1 ((,) a) where foldMap1 f (_, y) = f y toNonEmpty (_, x) = x :| [] @@ -432,52 +475,68 @@ instance Foldable1 ((,) a) where -- Monoid / Semigroup instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Dual where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Sum where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Product where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Min where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Max where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 First where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Last where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Alt f) +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Ap f) ------------------------------------------------------------------------------- -- GHC.Generics instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 V1 where foldMap1 _ x = x `seq` error "foldMap1 @V1" +-- | @since 4.18.0.0 instance Foldable1 Par1 where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (Rec1 f) +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (M1 i c f) +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where foldMap1 f (L1 x) = foldMap1 f x foldMap1 f (R1 y) = foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where foldMap1 f (x :*: y) = foldMap1 f x <> foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where foldMap1 f = foldMap1 (foldMap1 f) . unComp1 @@ -485,6 +544,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where -- Extra instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Identity where foldMap1 = coerce @@ -509,6 +569,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where head (Functor.Pair x _) = head x last (Functor.Pair _ y) = last y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where foldMap1 f (Functor.InL x) = foldMap1 f x foldMap1 f (Functor.InR y) = foldMap1 f y @@ -529,6 +590,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where maximum (Functor.InL x) = maximum x maximum (Functor.InR y) = maximum y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where foldMap1 f = foldMap1 (foldMap1 f) . getCompose ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -1,3 +1,10 @@ +## 0.12.0 + +- Shipped with GHC 9.10.1 + +- The `unsafeThawByteArray#` primop was added, serving as a inverse to the existing + `unsafeFreezeByteArray#` primop (see #22710). + ## 0.11.0 - Shipped with GHC 9.8.1 ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f ===================================== testsuite/tests/driver/T23613.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,6 +320,7 @@ test('T21869', [js_broken(22261), when(unregisterised(), skip)], makefile_test, test('T22044', normal, makefile_test, []) test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) test('T21722', normal, compile_fail, ['-fno-show-error-context']) -test('T22669', js_skip, makefile_test, []) -test('T23339', js_skip, makefile_test, []) -test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) +test('T22669', req_interp, makefile_test, []) +test('T23339', req_c, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, []) +test('T23613', normal, compile_and_run, ['-this-unit-id=foo']) ===================================== testsuite/tests/driver/multipleHomeUnits/all.T ===================================== @@ -1,7 +1,7 @@ test('multipleHomeUnits_single1', [extra_files([ 'a/', 'unitA'])], multiunit_compile, [['unitA'], '-fhide-source-paths']) test('multipleHomeUnits_single2', [extra_files([ 'b/', 'unitB'])], multiunit_compile, [['unitB'], '-fhide-source-paths']) -test('multipleHomeUnits_single3', [js_broken(22261),extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) -test('multipleHomeUnits_single4', [js_broken(22261),extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) +test('multipleHomeUnits_single3', [extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) +test('multipleHomeUnits_single4', [extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) test('multipleHomeUnits_single5', [req_th,extra_files([ 'th/', 'unitTH'])], multiunit_compile, [['unitTH'], '-fhide-source-paths']) test('multipleHomeUnits_cpp', [extra_files([ 'cpp-includes/', 'unitCPPIncludes'])], multiunit_compile, [['unitCPPIncludes'], '-fhide-source-paths']) test('multipleHomeUnits_cfile', [extra_files([ 'c-file/', 'unitCFile'])], multiunit_compile, [['unitCFile'], '-fhide-source-paths']) @@ -24,14 +24,12 @@ test('multipleHomeUnits002', [ extra_files( [ 'c/', 'd/' , 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits003', [ extra_files( [ 'a/', 'b/', 'c/', 'd/' , 'unitA', 'unitB', 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits004', ===================================== testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_hidir' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , makefile_test , ['mhu-hidir']) ===================================== testsuite/tests/driver/multipleHomeUnits/o-files/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_o-files' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) , pre_cmd('$MAKE -s --no-print-directory setup')] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) ===================================== testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_target-file-path' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) ===================================== testsuite/tests/primops/should_run/T22710.hs ===================================== @@ -0,0 +1,55 @@ +-- | Test 'unsafeThawByteArray#'. + +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Exts (newByteArray#, indexWord8Array#, writeWord8Array#, + unsafeFreezeByteArray#, unsafeThawByteArray#, + ByteArray#, MutableByteArray#, Int(I#)) +import GHC.Word +import GHC.ST +import Prelude hiding (toList) + +main :: IO () +main = do + res <- return $ runST $ do + let n = 32 :: Int + marr <- newByteArray n + mapM_ (\i -> writeWord8Array marr i (fromIntegral i)) [0..n-1] + arr <- unsafeFreezeByteArray marr + marr' <- unsafeThawByteArray arr + arr' <- unsafeFreezeByteArray marr' + return $ toList arr' 5 + + print res + +data ByteArray = ByteArray { unBA :: ByteArray# } +data MByteArray s = MByteArray { unMBA :: MutableByteArray# s } + +newByteArray :: Int -> ST s (MByteArray s) +newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +indexWord8Array :: ByteArray -> Int -> Word8 +indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of + a -> W8# a + +writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s () +writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# -> + case writeWord8Array# (unMBA marr) i# a s# of + s2# -> (# s2#, () #) + +unsafeFreezeByteArray :: MByteArray s -> ST s ByteArray +unsafeFreezeByteArray marr = ST $ \ s# -> + case unsafeFreezeByteArray# (unMBA marr) s# of + (# s2#, arr# #) -> (# s2#, ByteArray arr# #) + +unsafeThawByteArray :: ByteArray -> ST s (MByteArray s) +unsafeThawByteArray arr = ST $ \ s# -> + case unsafeThawByteArray# (unBA arr) s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +toList :: ByteArray -> Int -> [Word8] +toList arr n = go 0 + where + go i | i >= n = [] + | otherwise = indexWord8Array arr i : go (i+1) ===================================== testsuite/tests/primops/should_run/T22710.stdout ===================================== @@ -0,0 +1 @@ +[0,1,2,3,4] ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -71,3 +71,4 @@ test('FMA_ConstantFold' test('T21624', normal, compile_and_run, ['']) test('T23071', ignore_stdout, compile_and_run, ['']) +test('T22710', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9863cbdb553aa6384930145a24a690cb1698bd1c...53044bd6690fd72c7fd7a7fadef3cdffc7e772dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9863cbdb553aa6384930145a24a690cb1698bd1c...53044bd6690fd72c7fd7a7fadef3cdffc7e772dd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 14:23:26 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 08 Jul 2023 10:23:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-improve-getmonobind Message-ID: <64a9715ee45f1_46db6afc1c11344e@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-improve-getmonobind at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-improve-getmonobind You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 14:26:46 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 08 Jul 2023 10:26:46 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] EPA: Improve annotation management in getMonoBind Message-ID: <64a972266d775_46db6afb4011362d@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 695c6584 by Alan Zimmerman at 2023-07-08T15:26:29+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 6 changed files: - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/printer/Test19784.hs - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs Changes: ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -95,7 +95,7 @@ module GHC.Parser.Annotation ( setCommentsSrcAnn, setCommentsEpAnnS, addCommentsToEpAnnS, addCommentsToEpAnn, setCommentsEpAnn, - transferAnnsA, commentsOnlyA, commentsOnlyI, + transferAnnsA, transferAnnsOnlyA, transferCommentsOnlyA, commentsOnlyA, commentsOnlyI, removeCommentsA, removeCommentsI, placeholderRealSpan, @@ -1400,6 +1400,18 @@ transferAnnsA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) transferAnnsA (EpAnnS a an cs) (EpAnnS a' an' cs') = (EpAnnS a mempty emptyComments, EpAnnS a' (an' <> an) (cs' <> cs)) +-- | Transfer comments and trailing items from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferAnnsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferAnnsOnlyA (EpAnnS a an cs) (EpAnnS a' an' cs') + = (EpAnnS a mempty cs, EpAnnS a' (an' <> an) cs') + +-- | Transfer comments from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferCommentsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferCommentsOnlyA (EpAnnS a an cs) (EpAnnS a' an' cs') + = (EpAnnS a an emptyComments, EpAnnS a' an' (cs <> cs')) + -- | Remove the exact print annotations payload, leaving only the -- anchor and comments. commentsOnlyA :: Monoid ann => EpAnnS ann -> EpAnnS ann ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -576,11 +576,15 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) MG { mg_alts = (L _ m1@[L _ mtchs1]) } })) binds | has_args m1 - = go [L (removeCommentsA loc1) mtchs1] (commentsOnlyA loc1) binds [] + -- = go [L (commentsOnlyA loc1) mtchs1] (removeCommentsA loc1) binds [] + = go [L loc1 mtchs1] (noAnnSrcSpan $ locA loc1) binds [] where - go :: [LMatch GhcPs (LHsExpr GhcPs)] -> SrcSpanAnnA - -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] - -> (LHsBind GhcPs, [LHsDecl GhcPs]) -- AZ + -- See Note [Exact Print Annotations for FunBind] + go :: [LMatch GhcPs (LHsExpr GhcPs)] -- accumulates matches for current fun + -> SrcSpanAnnA -- current top level loc + -> [LHsDecl GhcPs] -- Any docbinds seen + -> [LHsDecl GhcPs] -- rest of decls to be processed + -> (LHsBind GhcPs, [LHsDecl GhcPs]) -- FunBind, rest of decls go mtchs loc ((L loc2 (ValD _ (FunBind { fun_id = (L _ f2) , fun_matches = @@ -595,15 +599,59 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) in go mtchs (combineSrcSpansA loc loc2) binds doc_decls' go mtchs loc binds doc_decls = let - L lm m = head mtchs -- Guaranteed at least one - (lm',loc') = transferAnnsA lm loc - in ( L loc' (makeFunBind fun_id1 (mkLocatedList $ reverse (L lm' m:tail mtchs))) + L llm last_m = head mtchs -- Guaranteed at least one + (llm',loc') = transferAnnsOnlyA llm loc -- Keep comments, transfer trailing + + matches' = reverse (L llm' last_m:tail mtchs) + L lfm first_m = head matches' + (lfm', loc'') = transferCommentsOnlyA lfm loc' + in ( L loc'' (makeFunBind fun_id1 (mkLocatedList $ (L lfm' first_m:tail matches'))) , (reverse doc_decls) ++ binds) -- Reverse the final matches, to get it back in the right order -- Do the same thing with the trailing doc comments getMonoBind bind binds = (bind, binds) +{- Note [Exact Print Annotations for FunBind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +An individual Match that ends up in a FunBind MatchGroup is initially +parsed as a LHsDecl. This takes the form + + L loc (ValD NoExtField (FunBind ... [L lm (Match ..)])) + +The loc contains the annotations, in particular comments, which are to +precede the declaration when printed, and [TrailingAnn] which are to +follow it. The [TrailingAnn] captures semicolons that may appear after +it when using the braces and semis style of coding. + +The match location (lm) has only a location in it at this point, no +annotations. Its location is the same as the top level location in +loc. + +What getMonoBind does it to take a sequence of FunBind LHsDecls that +belong to the same function and group them into a single function with +the component declarations all combined into the single MatchGroup as +[LMatch GhcPs]. + +Given that when exact printing a FunBind the exact printer simply +iterates over all the matches and prints each in turn, the simplest +behaviour would be to simply take the top level annotations (loc) for +each declaration, and use them for the individual component matches +(lm). + +The problem is the exact printer first has to deal with the top level +LHsDecl, which means annotations for the loc. This needs to be able to +be exact printed in the context of surrounding declarations, and if +some refactor decides to move the declaration elsewhere, the leading +comments and trailing semicolons need to be handled at that level. + +So the solution is to combine all the matches into one, pushing the +annotations into the LMatch's, and then at the end extract the +comments from the first match and [TrailingAnn] from the last to go in +the top level LHsDecl. +-} + -- Group together adjacent FunBinds for every function. getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs] getMonoBindAll [] = [] ===================================== testsuite/tests/ghc-api/exactprint/Test20239.stderr ===================================== @@ -223,7 +223,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { Test20239.hs:7:50 }) + (EpaSpan { Test20239.hs:7:50-86 }) (AnnParen (AnnParens) (EpaSpan { Test20239.hs:7:50 }) @@ -239,7 +239,7 @@ []))) (HsFunTy (EpAnn - (EpaSpan { Test20239.hs:7:51-60 }) + (EpaSpan { Test20239.hs:7:51-85 }) (NoEpAnns) (EpaComments [])) @@ -312,7 +312,7 @@ []))) (HsParTy (EpAnn - (EpaSpan { Test20239.hs:7:68 }) + (EpaSpan { Test20239.hs:7:68-85 }) (AnnParen (AnnParens) (EpaSpan { Test20239.hs:7:68 }) @@ -392,7 +392,7 @@ []))) (HsTupleTy (EpAnn - (EpaSpan { Test20239.hs:7:83 }) + (EpaSpan { Test20239.hs:7:83-84 }) (AnnParen (AnnParens) (EpaSpan { Test20239.hs:7:83 }) ===================================== testsuite/tests/printer/Test19784.hs ===================================== @@ -2,4 +2,9 @@ module Test19784 where { a 0 = 1; a _ = 2; + +-- c0 +b 0 = 1; -- c1 +b 1 = 2; -- c2 +b 2 = 3; -- c3 } ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -415,7 +415,7 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do -- EpaSpan _ -> setAcceptSpan False p <- getPosP pe0 <- getPriorEndD - debugM $ "enterAnn:starting:(p,pe,anchor',a) =" ++ show (p, pe0, eloc2str anchor', astId a) + debugM $ "enterAnn:starting:(anchor',p,pe,a) =" ++ show (eloc2str anchor', p, pe0, astId a) debugM $ "enterAnn:anchor_op=" ++ showGhc (anchor_op anchor') prevAnchor <- getAnchorU let curAnchor = case anchor' of @@ -549,7 +549,7 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do -- Deal with exit from the current anchor p1 <- getPosP pe1 <- getPriorEndD - debugM $ "enterAnn:done:(p,pe,anchor,a) =" ++ show (p1, pe1, eloc2str anchor', astId a') + debugM $ "enterAnn:done:(anchor',p,pe,a) =" ++ show (eloc2str anchor', p1, pe1, astId a') case anchor' of -- EpaDelta _ _ -> setPriorEndD p1 ===================================== utils/check-exact/Main.hs ===================================== @@ -99,7 +99,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Ppr007.hs" Nothing -- "../../testsuite/tests/printer/Ppr008.hs" Nothing -- "../../testsuite/tests/printer/Ppr009.hs" Nothing - "../../testsuite/tests/printer/Ppr011.hs" Nothing + -- "../../testsuite/tests/printer/Ppr011.hs" Nothing -- "../../testsuite/tests/printer/Ppr012.hs" Nothing -- "../../testsuite/tests/printer/Ppr013.hs" Nothing -- "../../testsuite/tests/printer/Ppr014.hs" Nothing @@ -134,7 +134,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Ppr043.hs" Nothing -- "../../testsuite/tests/printer/Ppr044.hs" Nothing -- "../../testsuite/tests/printer/Ppr045.hs" Nothing - -- "../../testsuite/tests/printer/Ppr046.hs" Nothing + "../../testsuite/tests/printer/Ppr046.hs" Nothing -- "../../testsuite/tests/printer/Ppr048.hs" Nothing -- "../../testsuite/tests/printer/Ppr049.hs" Nothing -- "../../testsuite/tests/printer/Ppr050.hs" Nothing @@ -211,7 +211,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test20297.hs" Nothing -- "../../testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/tcfail181.hs" Nothing --- cloneT does not need a test, function can be retired + -- "../../testsuite/tests/printer/PprBracesSemiDataDecl.hs" Nothing -- exact = ppr @@ -593,8 +593,9 @@ changeWhereIn3b _libdir (L l p) = do de1' = setEntryDP de1 (DifferentLine 2 0) d2' = setEntryDP d2 (DifferentLine 2 0) decls' = d2':de1':de0':tdecls + -- decls' = de1':de0:tdecls -- decls' = decls - debugM $ unlines w + -- debugM $ unlines w -- debugM $ "changeWhereIn3b:de1':" ++ showAst de1' let p2 = p { hsmodDecls = decls'} return (L l p2) @@ -610,6 +611,7 @@ addLocaLDecl1 libdir top = do let lp = top (de1:d2:d3:_) <- hsDecls lp (de1'',d2') <- balanceComments de1 d2 + -- let (de1'',d2') = (de1, d2) (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do return ((wrapDecl decl' : d),Nothing) replaceDecls lp [de1', d2', d3] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/695c6584d8a6c6bbf8f8567451bdfaac05e3e98c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/695c6584d8a6c6bbf8f8567451bdfaac05e3e98c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 17:21:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 13:21:47 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64a99b2ad45e7_46db6afc0813512c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8a02ce83 by Ben Gamari at 2023-07-08T13:21:22-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - feb2c1d6 by Bodigrim at 2023-07-08T13:21:31-04:00 Add since annotations for Data.Foldable1 - - - - - 436b87c9 by Sylvain Henry at 2023-07-08T13:21:35-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - b90955e6 by Bodigrim at 2023-07-08T13:21:37-04:00 Bump text submodule - - - - - 16 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Prim.hs - libraries/base/Data/Foldable1.hs - libraries/ghc-prim/changelog.md - libraries/text - + testsuite/tests/driver/T23613.hs - testsuite/tests/driver/all.T - testsuite/tests/driver/multipleHomeUnits/all.T - testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T - testsuite/tests/driver/multipleHomeUnits/o-files/all.T - testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T - + testsuite/tests/primops/should_run/T22710.hs - + testsuite/tests/primops/should_run/T22710.stdout - testsuite/tests/primops/should_run/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1922,6 +1922,14 @@ primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp with has_side_effects = True +primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp + ByteArray# -> State# s -> (# State# s, MutableByteArray# s #) + {Make an immutable byte array mutable, without copying. + + @since 0.12.0.0} + with + has_side_effects = True + primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp ByteArray# -> Int# {Return the size of the array in bytes.} ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -371,6 +371,10 @@ emitPrimOp cfg primop = UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) arg +-- #define unsafeThawByteArrayzh(r,a) r=(a) + UnsafeThawByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> + emitAssign (CmmLocal res) arg + -- Reading/writing pointer arrays ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -327,7 +327,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache = do let (rts_wired_units, rts_wired_functions) = rtsDeps units -- all the units we want to link together, without their dependencies - let root_units = filter (/= mainUnitId) + let root_units = filter (/= ue_currentUnit unit_env) $ filter (/= interactiveUnitId) $ nub $ rts_wired_units ++ reverse obj_units ++ reverse units ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -652,6 +652,7 @@ genPrim prof bound ty op = case op of ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + UnsafeThawByteArrayOp -> \[a] [b] -> PrimInline $ a |= b SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" ===================================== libraries/base/Data/Foldable1.hs ===================================== @@ -2,6 +2,9 @@ -- Copyright: Edward Kmett, Oleg Grenrus -- License: BSD-3-Clause -- +-- A class of non-empty data structures that can be folded to a summary value. +-- +-- @since 4.18.0.0 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -12,7 +15,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} --- | A class of non-empty data structures that can be folded to a summary value. module Data.Foldable1 ( Foldable1(..), foldr1, foldr1', @@ -65,6 +67,8 @@ import Data.Coerce (Coercible, coerce) ------------------------------------------------------------------------------- -- | Non-empty data structures that can be folded. +-- +-- @since 4.18.0.0 class Foldable t => Foldable1 t where {-# MINIMAL foldMap1 | foldrMap1 #-} @@ -86,6 +90,8 @@ class Foldable t => Foldable1 t where -- them via the semigroup's @('<>')@ operator. This fold is -- right-associative and lazy in the accumulator. When you need a strict -- left-associative fold, use 'foldMap1'' instead, with 'id' as the map. + -- + -- @since 4.18.0.0 fold1 :: Semigroup m => t m -> m fold1 = foldMap1 id @@ -97,6 +103,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1 (:[]) (1 :| [2, 3, 4]) -- [1,2,3,4] -- + -- @since 4.18.0.0 foldMap1 :: Semigroup m => (a -> m) -> t a -> m foldMap1 f = foldrMap1 f (\a m -> f a <> m) @@ -107,6 +114,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1' Sum (1 :| [2, 3, 4]) -- Sum {getSum = 10} -- + -- @since 4.18.0.0 foldMap1' :: Semigroup m => (a -> m) -> t a -> m foldMap1' f = foldlMap1' f (\m a -> m <> f a) @@ -115,6 +123,7 @@ class Foldable t => Foldable1 t where -- >>> toNonEmpty (Identity 2) -- 2 :| [] -- + -- @since 4.18.0.0 toNonEmpty :: t a -> NonEmpty a toNonEmpty = runNonEmptyDList . foldMap1 singleton @@ -123,6 +132,7 @@ class Foldable t => Foldable1 t where -- >>> maximum (32 :| [64, 8, 128, 16]) -- 128 -- + -- @since 4.18.0.0 maximum :: Ord a => t a -> a maximum = getMax #. foldMap1' Max @@ -131,6 +141,7 @@ class Foldable t => Foldable1 t where -- >>> minimum (32 :| [64, 8, 128, 16]) -- 8 -- + -- @since 4.18.0.0 minimum :: Ord a => t a -> a minimum = getMin #. foldMap1' Min @@ -139,6 +150,7 @@ class Foldable t => Foldable1 t where -- >>> head (1 :| [2, 3, 4]) -- 1 -- + -- @since 4.18.0.0 head :: t a -> a head = getFirst #. foldMap1 First @@ -147,6 +159,7 @@ class Foldable t => Foldable1 t where -- >>> last (1 :| [2, 3, 4]) -- 4 -- + -- @since 4.18.0.0 last :: t a -> a last = getLast #. foldMap1 Last @@ -168,6 +181,7 @@ class Foldable t => Foldable1 t where -- -- @foldrMap1 f g = foldrMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1 f g xs = appFromMaybe (foldMap1 (FromMaybe #. h) xs) Nothing @@ -188,6 +202,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1' f z = foldlMap1' f z . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1' f g xs = foldrMap1 f' g' xs SNothing @@ -227,6 +242,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1 f g = foldlMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1 f g xs = appFromMaybe (getDual (foldMap1 ((Dual . FromMaybe) #. h) xs)) Nothing @@ -249,6 +265,7 @@ class Foldable t => Foldable1 t where -- poor fit for the task at hand. If the order in which the elements are -- combined is not important, use 'foldlMap1'' instead. -- + -- @since 4.18.0.0 foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1' f g xs = foldlMap1 f' g' xs SNothing @@ -264,21 +281,29 @@ class Foldable t => Foldable1 t where ------------------------------------------------------------------------------- -- | A variant of 'foldrMap1' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1 = foldrMap1 id {-# INLINE foldr1 #-} -- | A variant of 'foldrMap1'' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1' = foldrMap1' id {-# INLINE foldr1' #-} -- | A variant of 'foldlMap1' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1 = foldlMap1 id {-# INLINE foldl1 #-} -- | A variant of 'foldlMap1'' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1' = foldlMap1' id {-# INLINE foldl1' #-} @@ -294,6 +319,7 @@ foldl1' = foldlMap1' id -- >>> intercalate1 mempty $ "I" :| ["Am", "Fine", "You?"] -- "IAmFineYou?" -- +-- @since 4.18.0.0 intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m intercalate1 = flip intercalateMap1 id @@ -302,10 +328,14 @@ intercalateMap1 j f = flip joinee j . foldMap1 (JoinWith . const . f) -- | Monadic fold over the elements of a non-empty structure, -- associating to the right, i.e. from right to left. +-- +-- @since 4.18.0.0 foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldrM1 = foldrMapM1 return -- | Map variant of 'foldrM1'. +-- +-- @since 4.18.0.0 foldrMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (a -> b -> m b) -> t a -> m b foldrMapM1 g f = go . toNonEmpty where @@ -316,16 +346,22 @@ foldrMapM1 g f = go . toNonEmpty -- | Monadic fold over the elements of a non-empty structure, -- associating to the left, i.e. from left to right. +-- +-- @since 4.18.0.0 foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldlM1 = foldlMapM1 return -- | Map variant of 'foldlM1'. +-- +-- @since 4.18.0.0 foldlMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (b -> a -> m b) -> t a -> m b foldlMapM1 g f t = g x >>= \y -> foldlM f y xs where x:|xs = toNonEmpty t -- | The largest element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldl1' max' where max' x y = case cmp x y of @@ -334,6 +370,8 @@ maximumBy cmp = foldl1' max' -- | The least element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldl1' min' where min' x y = case cmp x y of @@ -379,6 +417,7 @@ instance Semigroup a => Semigroup (JoinWith a) where -- Instances for misc base types ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 NonEmpty where foldMap1 f (x :| xs) = go (f x) xs where go y [] = y @@ -398,9 +437,11 @@ instance Foldable1 NonEmpty where head = NE.head last = NE.last +-- | @since 4.18.0.0 instance Foldable1 Down where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Complex where foldMap1 f (x :+ y) = f x <> f y @@ -412,6 +453,7 @@ instance Foldable1 Complex where -- 3+ tuples are not Foldable/Traversable +-- | @since 4.18.0.0 instance Foldable1 Solo where foldMap1 f (MkSolo y) = f y toNonEmpty (MkSolo x) = x :| [] @@ -420,6 +462,7 @@ instance Foldable1 Solo where head (MkSolo x) = x last (MkSolo x) = x +-- | @since 4.18.0.0 instance Foldable1 ((,) a) where foldMap1 f (_, y) = f y toNonEmpty (_, x) = x :| [] @@ -432,52 +475,68 @@ instance Foldable1 ((,) a) where -- Monoid / Semigroup instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Dual where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Sum where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Product where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Min where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Max where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 First where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Last where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Alt f) +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Ap f) ------------------------------------------------------------------------------- -- GHC.Generics instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 V1 where foldMap1 _ x = x `seq` error "foldMap1 @V1" +-- | @since 4.18.0.0 instance Foldable1 Par1 where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (Rec1 f) +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (M1 i c f) +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where foldMap1 f (L1 x) = foldMap1 f x foldMap1 f (R1 y) = foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where foldMap1 f (x :*: y) = foldMap1 f x <> foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where foldMap1 f = foldMap1 (foldMap1 f) . unComp1 @@ -485,6 +544,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where -- Extra instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Identity where foldMap1 = coerce @@ -509,6 +569,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where head (Functor.Pair x _) = head x last (Functor.Pair _ y) = last y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where foldMap1 f (Functor.InL x) = foldMap1 f x foldMap1 f (Functor.InR y) = foldMap1 f y @@ -529,6 +590,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where maximum (Functor.InL x) = maximum x maximum (Functor.InR y) = maximum y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where foldMap1 f = foldMap1 (foldMap1 f) . getCompose ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -1,3 +1,10 @@ +## 0.12.0 + +- Shipped with GHC 9.10.1 + +- The `unsafeThawByteArray#` primop was added, serving as a inverse to the existing + `unsafeFreezeByteArray#` primop (see #22710). + ## 0.11.0 - Shipped with GHC 9.8.1 ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f ===================================== testsuite/tests/driver/T23613.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,6 +320,7 @@ test('T21869', [js_broken(22261), when(unregisterised(), skip)], makefile_test, test('T22044', normal, makefile_test, []) test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) test('T21722', normal, compile_fail, ['-fno-show-error-context']) -test('T22669', js_skip, makefile_test, []) -test('T23339', js_skip, makefile_test, []) -test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) +test('T22669', req_interp, makefile_test, []) +test('T23339', req_c, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, []) +test('T23613', normal, compile_and_run, ['-this-unit-id=foo']) ===================================== testsuite/tests/driver/multipleHomeUnits/all.T ===================================== @@ -1,7 +1,7 @@ test('multipleHomeUnits_single1', [extra_files([ 'a/', 'unitA'])], multiunit_compile, [['unitA'], '-fhide-source-paths']) test('multipleHomeUnits_single2', [extra_files([ 'b/', 'unitB'])], multiunit_compile, [['unitB'], '-fhide-source-paths']) -test('multipleHomeUnits_single3', [js_broken(22261),extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) -test('multipleHomeUnits_single4', [js_broken(22261),extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) +test('multipleHomeUnits_single3', [extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) +test('multipleHomeUnits_single4', [extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) test('multipleHomeUnits_single5', [req_th,extra_files([ 'th/', 'unitTH'])], multiunit_compile, [['unitTH'], '-fhide-source-paths']) test('multipleHomeUnits_cpp', [extra_files([ 'cpp-includes/', 'unitCPPIncludes'])], multiunit_compile, [['unitCPPIncludes'], '-fhide-source-paths']) test('multipleHomeUnits_cfile', [extra_files([ 'c-file/', 'unitCFile'])], multiunit_compile, [['unitCFile'], '-fhide-source-paths']) @@ -24,14 +24,12 @@ test('multipleHomeUnits002', [ extra_files( [ 'c/', 'd/' , 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits003', [ extra_files( [ 'a/', 'b/', 'c/', 'd/' , 'unitA', 'unitB', 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits004', ===================================== testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_hidir' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , makefile_test , ['mhu-hidir']) ===================================== testsuite/tests/driver/multipleHomeUnits/o-files/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_o-files' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) , pre_cmd('$MAKE -s --no-print-directory setup')] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) ===================================== testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_target-file-path' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) ===================================== testsuite/tests/primops/should_run/T22710.hs ===================================== @@ -0,0 +1,55 @@ +-- | Test 'unsafeThawByteArray#'. + +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Exts (newByteArray#, indexWord8Array#, writeWord8Array#, + unsafeFreezeByteArray#, unsafeThawByteArray#, + ByteArray#, MutableByteArray#, Int(I#)) +import GHC.Word +import GHC.ST +import Prelude hiding (toList) + +main :: IO () +main = do + res <- return $ runST $ do + let n = 32 :: Int + marr <- newByteArray n + mapM_ (\i -> writeWord8Array marr i (fromIntegral i)) [0..n-1] + arr <- unsafeFreezeByteArray marr + marr' <- unsafeThawByteArray arr + arr' <- unsafeFreezeByteArray marr' + return $ toList arr' 5 + + print res + +data ByteArray = ByteArray { unBA :: ByteArray# } +data MByteArray s = MByteArray { unMBA :: MutableByteArray# s } + +newByteArray :: Int -> ST s (MByteArray s) +newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +indexWord8Array :: ByteArray -> Int -> Word8 +indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of + a -> W8# a + +writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s () +writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# -> + case writeWord8Array# (unMBA marr) i# a s# of + s2# -> (# s2#, () #) + +unsafeFreezeByteArray :: MByteArray s -> ST s ByteArray +unsafeFreezeByteArray marr = ST $ \ s# -> + case unsafeFreezeByteArray# (unMBA marr) s# of + (# s2#, arr# #) -> (# s2#, ByteArray arr# #) + +unsafeThawByteArray :: ByteArray -> ST s (MByteArray s) +unsafeThawByteArray arr = ST $ \ s# -> + case unsafeThawByteArray# (unBA arr) s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +toList :: ByteArray -> Int -> [Word8] +toList arr n = go 0 + where + go i | i >= n = [] + | otherwise = indexWord8Array arr i : go (i+1) ===================================== testsuite/tests/primops/should_run/T22710.stdout ===================================== @@ -0,0 +1 @@ +[0,1,2,3,4] ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -71,3 +71,4 @@ test('FMA_ConstantFold' test('T21624', normal, compile_and_run, ['']) test('T23071', ignore_stdout, compile_and_run, ['']) +test('T22710', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53044bd6690fd72c7fd7a7fadef3cdffc7e772dd...b90955e6e20fb20cb65fdf3eb1f3ad80130dfaa9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53044bd6690fd72c7fd7a7fadef3cdffc7e772dd...b90955e6e20fb20cb65fdf3eb1f3ad80130dfaa9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 21:12:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 17:12:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add since annotations for Data.Foldable1 Message-ID: <64a9d14c684d2_46db6afba41692da@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f6ba7ab7 by Bodigrim at 2023-07-08T17:12:32-04:00 Add since annotations for Data.Foldable1 - - - - - 1087c4a9 by Sylvain Henry at 2023-07-08T17:12:35-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - eff59a27 by Bodigrim at 2023-07-08T17:12:37-04:00 Bump text submodule - - - - - 9 changed files: - compiler/GHC/StgToJS/Linker/Linker.hs - libraries/base/Data/Foldable1.hs - libraries/text - + testsuite/tests/driver/T23613.hs - testsuite/tests/driver/all.T - testsuite/tests/driver/multipleHomeUnits/all.T - testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T - testsuite/tests/driver/multipleHomeUnits/o-files/all.T - testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -327,7 +327,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache = do let (rts_wired_units, rts_wired_functions) = rtsDeps units -- all the units we want to link together, without their dependencies - let root_units = filter (/= mainUnitId) + let root_units = filter (/= ue_currentUnit unit_env) $ filter (/= interactiveUnitId) $ nub $ rts_wired_units ++ reverse obj_units ++ reverse units ===================================== libraries/base/Data/Foldable1.hs ===================================== @@ -2,6 +2,9 @@ -- Copyright: Edward Kmett, Oleg Grenrus -- License: BSD-3-Clause -- +-- A class of non-empty data structures that can be folded to a summary value. +-- +-- @since 4.18.0.0 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -12,7 +15,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} --- | A class of non-empty data structures that can be folded to a summary value. module Data.Foldable1 ( Foldable1(..), foldr1, foldr1', @@ -65,6 +67,8 @@ import Data.Coerce (Coercible, coerce) ------------------------------------------------------------------------------- -- | Non-empty data structures that can be folded. +-- +-- @since 4.18.0.0 class Foldable t => Foldable1 t where {-# MINIMAL foldMap1 | foldrMap1 #-} @@ -86,6 +90,8 @@ class Foldable t => Foldable1 t where -- them via the semigroup's @('<>')@ operator. This fold is -- right-associative and lazy in the accumulator. When you need a strict -- left-associative fold, use 'foldMap1'' instead, with 'id' as the map. + -- + -- @since 4.18.0.0 fold1 :: Semigroup m => t m -> m fold1 = foldMap1 id @@ -97,6 +103,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1 (:[]) (1 :| [2, 3, 4]) -- [1,2,3,4] -- + -- @since 4.18.0.0 foldMap1 :: Semigroup m => (a -> m) -> t a -> m foldMap1 f = foldrMap1 f (\a m -> f a <> m) @@ -107,6 +114,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1' Sum (1 :| [2, 3, 4]) -- Sum {getSum = 10} -- + -- @since 4.18.0.0 foldMap1' :: Semigroup m => (a -> m) -> t a -> m foldMap1' f = foldlMap1' f (\m a -> m <> f a) @@ -115,6 +123,7 @@ class Foldable t => Foldable1 t where -- >>> toNonEmpty (Identity 2) -- 2 :| [] -- + -- @since 4.18.0.0 toNonEmpty :: t a -> NonEmpty a toNonEmpty = runNonEmptyDList . foldMap1 singleton @@ -123,6 +132,7 @@ class Foldable t => Foldable1 t where -- >>> maximum (32 :| [64, 8, 128, 16]) -- 128 -- + -- @since 4.18.0.0 maximum :: Ord a => t a -> a maximum = getMax #. foldMap1' Max @@ -131,6 +141,7 @@ class Foldable t => Foldable1 t where -- >>> minimum (32 :| [64, 8, 128, 16]) -- 8 -- + -- @since 4.18.0.0 minimum :: Ord a => t a -> a minimum = getMin #. foldMap1' Min @@ -139,6 +150,7 @@ class Foldable t => Foldable1 t where -- >>> head (1 :| [2, 3, 4]) -- 1 -- + -- @since 4.18.0.0 head :: t a -> a head = getFirst #. foldMap1 First @@ -147,6 +159,7 @@ class Foldable t => Foldable1 t where -- >>> last (1 :| [2, 3, 4]) -- 4 -- + -- @since 4.18.0.0 last :: t a -> a last = getLast #. foldMap1 Last @@ -168,6 +181,7 @@ class Foldable t => Foldable1 t where -- -- @foldrMap1 f g = foldrMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1 f g xs = appFromMaybe (foldMap1 (FromMaybe #. h) xs) Nothing @@ -188,6 +202,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1' f z = foldlMap1' f z . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1' f g xs = foldrMap1 f' g' xs SNothing @@ -227,6 +242,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1 f g = foldlMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1 f g xs = appFromMaybe (getDual (foldMap1 ((Dual . FromMaybe) #. h) xs)) Nothing @@ -249,6 +265,7 @@ class Foldable t => Foldable1 t where -- poor fit for the task at hand. If the order in which the elements are -- combined is not important, use 'foldlMap1'' instead. -- + -- @since 4.18.0.0 foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1' f g xs = foldlMap1 f' g' xs SNothing @@ -264,21 +281,29 @@ class Foldable t => Foldable1 t where ------------------------------------------------------------------------------- -- | A variant of 'foldrMap1' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1 = foldrMap1 id {-# INLINE foldr1 #-} -- | A variant of 'foldrMap1'' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1' = foldrMap1' id {-# INLINE foldr1' #-} -- | A variant of 'foldlMap1' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1 = foldlMap1 id {-# INLINE foldl1 #-} -- | A variant of 'foldlMap1'' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1' = foldlMap1' id {-# INLINE foldl1' #-} @@ -294,6 +319,7 @@ foldl1' = foldlMap1' id -- >>> intercalate1 mempty $ "I" :| ["Am", "Fine", "You?"] -- "IAmFineYou?" -- +-- @since 4.18.0.0 intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m intercalate1 = flip intercalateMap1 id @@ -302,10 +328,14 @@ intercalateMap1 j f = flip joinee j . foldMap1 (JoinWith . const . f) -- | Monadic fold over the elements of a non-empty structure, -- associating to the right, i.e. from right to left. +-- +-- @since 4.18.0.0 foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldrM1 = foldrMapM1 return -- | Map variant of 'foldrM1'. +-- +-- @since 4.18.0.0 foldrMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (a -> b -> m b) -> t a -> m b foldrMapM1 g f = go . toNonEmpty where @@ -316,16 +346,22 @@ foldrMapM1 g f = go . toNonEmpty -- | Monadic fold over the elements of a non-empty structure, -- associating to the left, i.e. from left to right. +-- +-- @since 4.18.0.0 foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldlM1 = foldlMapM1 return -- | Map variant of 'foldlM1'. +-- +-- @since 4.18.0.0 foldlMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (b -> a -> m b) -> t a -> m b foldlMapM1 g f t = g x >>= \y -> foldlM f y xs where x:|xs = toNonEmpty t -- | The largest element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldl1' max' where max' x y = case cmp x y of @@ -334,6 +370,8 @@ maximumBy cmp = foldl1' max' -- | The least element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldl1' min' where min' x y = case cmp x y of @@ -379,6 +417,7 @@ instance Semigroup a => Semigroup (JoinWith a) where -- Instances for misc base types ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 NonEmpty where foldMap1 f (x :| xs) = go (f x) xs where go y [] = y @@ -398,9 +437,11 @@ instance Foldable1 NonEmpty where head = NE.head last = NE.last +-- | @since 4.18.0.0 instance Foldable1 Down where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Complex where foldMap1 f (x :+ y) = f x <> f y @@ -412,6 +453,7 @@ instance Foldable1 Complex where -- 3+ tuples are not Foldable/Traversable +-- | @since 4.18.0.0 instance Foldable1 Solo where foldMap1 f (MkSolo y) = f y toNonEmpty (MkSolo x) = x :| [] @@ -420,6 +462,7 @@ instance Foldable1 Solo where head (MkSolo x) = x last (MkSolo x) = x +-- | @since 4.18.0.0 instance Foldable1 ((,) a) where foldMap1 f (_, y) = f y toNonEmpty (_, x) = x :| [] @@ -432,52 +475,68 @@ instance Foldable1 ((,) a) where -- Monoid / Semigroup instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Dual where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Sum where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Product where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Min where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Max where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 First where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Last where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Alt f) +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Ap f) ------------------------------------------------------------------------------- -- GHC.Generics instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 V1 where foldMap1 _ x = x `seq` error "foldMap1 @V1" +-- | @since 4.18.0.0 instance Foldable1 Par1 where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (Rec1 f) +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (M1 i c f) +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where foldMap1 f (L1 x) = foldMap1 f x foldMap1 f (R1 y) = foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where foldMap1 f (x :*: y) = foldMap1 f x <> foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where foldMap1 f = foldMap1 (foldMap1 f) . unComp1 @@ -485,6 +544,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where -- Extra instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Identity where foldMap1 = coerce @@ -509,6 +569,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where head (Functor.Pair x _) = head x last (Functor.Pair _ y) = last y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where foldMap1 f (Functor.InL x) = foldMap1 f x foldMap1 f (Functor.InR y) = foldMap1 f y @@ -529,6 +590,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where maximum (Functor.InL x) = maximum x maximum (Functor.InR y) = maximum y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where foldMap1 f = foldMap1 (foldMap1 f) . getCompose ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f ===================================== testsuite/tests/driver/T23613.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,6 +320,7 @@ test('T21869', [js_broken(22261), when(unregisterised(), skip)], makefile_test, test('T22044', normal, makefile_test, []) test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) test('T21722', normal, compile_fail, ['-fno-show-error-context']) -test('T22669', js_skip, makefile_test, []) -test('T23339', js_skip, makefile_test, []) -test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) +test('T22669', req_interp, makefile_test, []) +test('T23339', req_c, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, []) +test('T23613', normal, compile_and_run, ['-this-unit-id=foo']) ===================================== testsuite/tests/driver/multipleHomeUnits/all.T ===================================== @@ -1,7 +1,7 @@ test('multipleHomeUnits_single1', [extra_files([ 'a/', 'unitA'])], multiunit_compile, [['unitA'], '-fhide-source-paths']) test('multipleHomeUnits_single2', [extra_files([ 'b/', 'unitB'])], multiunit_compile, [['unitB'], '-fhide-source-paths']) -test('multipleHomeUnits_single3', [js_broken(22261),extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) -test('multipleHomeUnits_single4', [js_broken(22261),extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) +test('multipleHomeUnits_single3', [extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) +test('multipleHomeUnits_single4', [extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) test('multipleHomeUnits_single5', [req_th,extra_files([ 'th/', 'unitTH'])], multiunit_compile, [['unitTH'], '-fhide-source-paths']) test('multipleHomeUnits_cpp', [extra_files([ 'cpp-includes/', 'unitCPPIncludes'])], multiunit_compile, [['unitCPPIncludes'], '-fhide-source-paths']) test('multipleHomeUnits_cfile', [extra_files([ 'c-file/', 'unitCFile'])], multiunit_compile, [['unitCFile'], '-fhide-source-paths']) @@ -24,14 +24,12 @@ test('multipleHomeUnits002', [ extra_files( [ 'c/', 'd/' , 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits003', [ extra_files( [ 'a/', 'b/', 'c/', 'd/' , 'unitA', 'unitB', 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits004', ===================================== testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_hidir' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , makefile_test , ['mhu-hidir']) ===================================== testsuite/tests/driver/multipleHomeUnits/o-files/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_o-files' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) , pre_cmd('$MAKE -s --no-print-directory setup')] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) ===================================== testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_target-file-path' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b90955e6e20fb20cb65fdf3eb1f3ad80130dfaa9...eff59a27307f48150045718d5fa3b9f6aeb80b9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b90955e6e20fb20cb65fdf3eb1f3ad80130dfaa9...eff59a27307f48150045718d5fa3b9f6aeb80b9c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 21:17:00 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 08 Jul 2023 17:17:00 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Refine the too_many_occs story Message-ID: <64a9d24c9647a_46db6afb90176043@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 1ac91e56 by Simon Peyton Jones at 2023-07-08T22:16:34+01:00 Refine the too_many_occs story - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -4394,17 +4394,22 @@ simplLetUnfolding :: SimplEnv simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf | isStableUnfolding unf = simplStableUnfolding env bind_cxt id rhs_ty arity unf + | isExitJoinId id - = return noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify --- | isJoinId id --- , too_many_occs (idOccInfo id) --- = return noUnfolding + = -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify + return noUnfolding + + | isJoinId id + , isManyOccs (idOccInfo id) + = -- See Note [Heavily used join points] + return noUnfolding + | otherwise = -- Otherwise, we end up retaining all the SimpleEnv let !opts = seUnfoldingOpts env in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs -{- where +{- -- ToDo: document this too_many_occs (ManyOccs {}) = True too_many_occs (OneOcc { occ_n_br = n }) = n > 10 @@ -4539,6 +4544,17 @@ Wrinkles in GHC.Core.Opt.Simplify.Utils. We uphold this because the join-point case (bind_cxt = BC_Join {}) doesn't use eta_expand. +Note [Heavily used join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After inining join points we can end up with + let $j x = + in case x1 of + True -> case x2 of + True -> $j blah1 + False -> $j blah2 + False -> case x3 of .... +with a huge case tree + Note [Force bottoming field] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We need to force bottoming, or the new unfolding holds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ac91e5664072a3380e069737f2771a7f7336a23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ac91e5664072a3380e069737f2771a7f7336a23 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 23:33:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 19:33:15 -0400 Subject: [Git][ghc/ghc][master] Add since annotations for Data.Foldable1 Message-ID: <64a9f23b92802_46db6afbcc18295@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 1 changed file: - libraries/base/Data/Foldable1.hs Changes: ===================================== libraries/base/Data/Foldable1.hs ===================================== @@ -2,6 +2,9 @@ -- Copyright: Edward Kmett, Oleg Grenrus -- License: BSD-3-Clause -- +-- A class of non-empty data structures that can be folded to a summary value. +-- +-- @since 4.18.0.0 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -12,7 +15,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} --- | A class of non-empty data structures that can be folded to a summary value. module Data.Foldable1 ( Foldable1(..), foldr1, foldr1', @@ -65,6 +67,8 @@ import Data.Coerce (Coercible, coerce) ------------------------------------------------------------------------------- -- | Non-empty data structures that can be folded. +-- +-- @since 4.18.0.0 class Foldable t => Foldable1 t where {-# MINIMAL foldMap1 | foldrMap1 #-} @@ -86,6 +90,8 @@ class Foldable t => Foldable1 t where -- them via the semigroup's @('<>')@ operator. This fold is -- right-associative and lazy in the accumulator. When you need a strict -- left-associative fold, use 'foldMap1'' instead, with 'id' as the map. + -- + -- @since 4.18.0.0 fold1 :: Semigroup m => t m -> m fold1 = foldMap1 id @@ -97,6 +103,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1 (:[]) (1 :| [2, 3, 4]) -- [1,2,3,4] -- + -- @since 4.18.0.0 foldMap1 :: Semigroup m => (a -> m) -> t a -> m foldMap1 f = foldrMap1 f (\a m -> f a <> m) @@ -107,6 +114,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1' Sum (1 :| [2, 3, 4]) -- Sum {getSum = 10} -- + -- @since 4.18.0.0 foldMap1' :: Semigroup m => (a -> m) -> t a -> m foldMap1' f = foldlMap1' f (\m a -> m <> f a) @@ -115,6 +123,7 @@ class Foldable t => Foldable1 t where -- >>> toNonEmpty (Identity 2) -- 2 :| [] -- + -- @since 4.18.0.0 toNonEmpty :: t a -> NonEmpty a toNonEmpty = runNonEmptyDList . foldMap1 singleton @@ -123,6 +132,7 @@ class Foldable t => Foldable1 t where -- >>> maximum (32 :| [64, 8, 128, 16]) -- 128 -- + -- @since 4.18.0.0 maximum :: Ord a => t a -> a maximum = getMax #. foldMap1' Max @@ -131,6 +141,7 @@ class Foldable t => Foldable1 t where -- >>> minimum (32 :| [64, 8, 128, 16]) -- 8 -- + -- @since 4.18.0.0 minimum :: Ord a => t a -> a minimum = getMin #. foldMap1' Min @@ -139,6 +150,7 @@ class Foldable t => Foldable1 t where -- >>> head (1 :| [2, 3, 4]) -- 1 -- + -- @since 4.18.0.0 head :: t a -> a head = getFirst #. foldMap1 First @@ -147,6 +159,7 @@ class Foldable t => Foldable1 t where -- >>> last (1 :| [2, 3, 4]) -- 4 -- + -- @since 4.18.0.0 last :: t a -> a last = getLast #. foldMap1 Last @@ -168,6 +181,7 @@ class Foldable t => Foldable1 t where -- -- @foldrMap1 f g = foldrMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1 f g xs = appFromMaybe (foldMap1 (FromMaybe #. h) xs) Nothing @@ -188,6 +202,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1' f z = foldlMap1' f z . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1' f g xs = foldrMap1 f' g' xs SNothing @@ -227,6 +242,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1 f g = foldlMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1 f g xs = appFromMaybe (getDual (foldMap1 ((Dual . FromMaybe) #. h) xs)) Nothing @@ -249,6 +265,7 @@ class Foldable t => Foldable1 t where -- poor fit for the task at hand. If the order in which the elements are -- combined is not important, use 'foldlMap1'' instead. -- + -- @since 4.18.0.0 foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1' f g xs = foldlMap1 f' g' xs SNothing @@ -264,21 +281,29 @@ class Foldable t => Foldable1 t where ------------------------------------------------------------------------------- -- | A variant of 'foldrMap1' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1 = foldrMap1 id {-# INLINE foldr1 #-} -- | A variant of 'foldrMap1'' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1' = foldrMap1' id {-# INLINE foldr1' #-} -- | A variant of 'foldlMap1' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1 = foldlMap1 id {-# INLINE foldl1 #-} -- | A variant of 'foldlMap1'' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1' = foldlMap1' id {-# INLINE foldl1' #-} @@ -294,6 +319,7 @@ foldl1' = foldlMap1' id -- >>> intercalate1 mempty $ "I" :| ["Am", "Fine", "You?"] -- "IAmFineYou?" -- +-- @since 4.18.0.0 intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m intercalate1 = flip intercalateMap1 id @@ -302,10 +328,14 @@ intercalateMap1 j f = flip joinee j . foldMap1 (JoinWith . const . f) -- | Monadic fold over the elements of a non-empty structure, -- associating to the right, i.e. from right to left. +-- +-- @since 4.18.0.0 foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldrM1 = foldrMapM1 return -- | Map variant of 'foldrM1'. +-- +-- @since 4.18.0.0 foldrMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (a -> b -> m b) -> t a -> m b foldrMapM1 g f = go . toNonEmpty where @@ -316,16 +346,22 @@ foldrMapM1 g f = go . toNonEmpty -- | Monadic fold over the elements of a non-empty structure, -- associating to the left, i.e. from left to right. +-- +-- @since 4.18.0.0 foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldlM1 = foldlMapM1 return -- | Map variant of 'foldlM1'. +-- +-- @since 4.18.0.0 foldlMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (b -> a -> m b) -> t a -> m b foldlMapM1 g f t = g x >>= \y -> foldlM f y xs where x:|xs = toNonEmpty t -- | The largest element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldl1' max' where max' x y = case cmp x y of @@ -334,6 +370,8 @@ maximumBy cmp = foldl1' max' -- | The least element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldl1' min' where min' x y = case cmp x y of @@ -379,6 +417,7 @@ instance Semigroup a => Semigroup (JoinWith a) where -- Instances for misc base types ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 NonEmpty where foldMap1 f (x :| xs) = go (f x) xs where go y [] = y @@ -398,9 +437,11 @@ instance Foldable1 NonEmpty where head = NE.head last = NE.last +-- | @since 4.18.0.0 instance Foldable1 Down where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Complex where foldMap1 f (x :+ y) = f x <> f y @@ -412,6 +453,7 @@ instance Foldable1 Complex where -- 3+ tuples are not Foldable/Traversable +-- | @since 4.18.0.0 instance Foldable1 Solo where foldMap1 f (MkSolo y) = f y toNonEmpty (MkSolo x) = x :| [] @@ -420,6 +462,7 @@ instance Foldable1 Solo where head (MkSolo x) = x last (MkSolo x) = x +-- | @since 4.18.0.0 instance Foldable1 ((,) a) where foldMap1 f (_, y) = f y toNonEmpty (_, x) = x :| [] @@ -432,52 +475,68 @@ instance Foldable1 ((,) a) where -- Monoid / Semigroup instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Dual where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Sum where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Product where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Min where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Max where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 First where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Last where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Alt f) +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Ap f) ------------------------------------------------------------------------------- -- GHC.Generics instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 V1 where foldMap1 _ x = x `seq` error "foldMap1 @V1" +-- | @since 4.18.0.0 instance Foldable1 Par1 where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (Rec1 f) +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (M1 i c f) +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where foldMap1 f (L1 x) = foldMap1 f x foldMap1 f (R1 y) = foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where foldMap1 f (x :*: y) = foldMap1 f x <> foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where foldMap1 f = foldMap1 (foldMap1 f) . unComp1 @@ -485,6 +544,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where -- Extra instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Identity where foldMap1 = coerce @@ -509,6 +569,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where head (Functor.Pair x _) = head x last (Functor.Pair _ y) = last y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where foldMap1 f (Functor.InL x) = foldMap1 f x foldMap1 f (Functor.InR y) = foldMap1 f y @@ -529,6 +590,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where maximum (Functor.InL x) = maximum x maximum (Functor.InR y) = maximum y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where foldMap1 f = foldMap1 (foldMap1 f) . getCompose View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/054261dd319b505392458da7745e768847015887 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/054261dd319b505392458da7745e768847015887 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 23:33:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 19:33:57 -0400 Subject: [Git][ghc/ghc][master] JS: support -this-unit-id for programs in the linker (#23613) Message-ID: <64a9f2655bcca_46db6afc08186711@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - 7 changed files: - compiler/GHC/StgToJS/Linker/Linker.hs - + testsuite/tests/driver/T23613.hs - testsuite/tests/driver/all.T - testsuite/tests/driver/multipleHomeUnits/all.T - testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T - testsuite/tests/driver/multipleHomeUnits/o-files/all.T - testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T Changes: ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -327,7 +327,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache = do let (rts_wired_units, rts_wired_functions) = rtsDeps units -- all the units we want to link together, without their dependencies - let root_units = filter (/= mainUnitId) + let root_units = filter (/= ue_currentUnit unit_env) $ filter (/= interactiveUnitId) $ nub $ rts_wired_units ++ reverse obj_units ++ reverse units ===================================== testsuite/tests/driver/T23613.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,6 +320,7 @@ test('T21869', [js_broken(22261), when(unregisterised(), skip)], makefile_test, test('T22044', normal, makefile_test, []) test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) test('T21722', normal, compile_fail, ['-fno-show-error-context']) -test('T22669', js_skip, makefile_test, []) -test('T23339', js_skip, makefile_test, []) -test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) +test('T22669', req_interp, makefile_test, []) +test('T23339', req_c, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, []) +test('T23613', normal, compile_and_run, ['-this-unit-id=foo']) ===================================== testsuite/tests/driver/multipleHomeUnits/all.T ===================================== @@ -1,7 +1,7 @@ test('multipleHomeUnits_single1', [extra_files([ 'a/', 'unitA'])], multiunit_compile, [['unitA'], '-fhide-source-paths']) test('multipleHomeUnits_single2', [extra_files([ 'b/', 'unitB'])], multiunit_compile, [['unitB'], '-fhide-source-paths']) -test('multipleHomeUnits_single3', [js_broken(22261),extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) -test('multipleHomeUnits_single4', [js_broken(22261),extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) +test('multipleHomeUnits_single3', [extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) +test('multipleHomeUnits_single4', [extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) test('multipleHomeUnits_single5', [req_th,extra_files([ 'th/', 'unitTH'])], multiunit_compile, [['unitTH'], '-fhide-source-paths']) test('multipleHomeUnits_cpp', [extra_files([ 'cpp-includes/', 'unitCPPIncludes'])], multiunit_compile, [['unitCPPIncludes'], '-fhide-source-paths']) test('multipleHomeUnits_cfile', [extra_files([ 'c-file/', 'unitCFile'])], multiunit_compile, [['unitCFile'], '-fhide-source-paths']) @@ -24,14 +24,12 @@ test('multipleHomeUnits002', [ extra_files( [ 'c/', 'd/' , 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits003', [ extra_files( [ 'a/', 'b/', 'c/', 'd/' , 'unitA', 'unitB', 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits004', ===================================== testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_hidir' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , makefile_test , ['mhu-hidir']) ===================================== testsuite/tests/driver/multipleHomeUnits/o-files/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_o-files' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) , pre_cmd('$MAKE -s --no-print-directory setup')] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) ===================================== testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_target-file-path' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/550af50559931b7681fe24fddafd6e3467de077c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/550af50559931b7681fe24fddafd6e3467de077c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 8 23:34:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 08 Jul 2023 19:34:49 -0400 Subject: [Git][ghc/ghc][master] Bump text submodule Message-ID: <64a9f29981d07_46db6afc08190260@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 1 changed file: - libraries/text Changes: ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d284470a77042e6bc17bdb0ab0d740011196958a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d284470a77042e6bc17bdb0ab0d740011196958a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 9 11:09:40 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 09 Jul 2023 07:09:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/list-tuple-changelogs Message-ID: <64aa9574121bb_46db6af8e8234814@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/list-tuple-changelogs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/list-tuple-changelogs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 9 11:36:15 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 09 Jul 2023 07:36:15 -0400 Subject: [Git][ghc/ghc][wip/int-index/list-tuple-changelogs] List and Tuple: update documentation Message-ID: <64aa9baf9ea8f_46db6afba4238982@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/list-tuple-changelogs at Glasgow Haskell Compiler / GHC Commits: 02f0d0eb by Vladislav Zavialov at 2023-07-09T14:36:03+03:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 4 changed files: - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -111,6 +111,8 @@ * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to `Debug.Trace`, per [CLC proposal #36](https://github.com/haskell/core-libraries-committee/issues/36). + * Export `List` from `GHC.List` + ([CLC proposal #186](https://github.com/haskell/core-libraries-committee/issues/186)). ## 4.17.0.0 *August 2022* ===================================== libraries/ghc-prim/GHC/Tuple/Prim.hs ===================================== @@ -24,6 +24,9 @@ default () -- Double and Integer aren't available yet -- | The unit datatype @Unit@ has one non-undefined member, the nullary -- constructor @()@. +-- +-- @since 0.11.0 +-- data Unit = () -- The desugarer uses 1-tuples, @@ -107,147 +110,471 @@ getSolo :: Solo a -> a -- to have getSolo as its own separate function (#20562) getSolo (MkSolo a) = a +-- | A tuple of zero elements, a synonym for 'Unit'. +-- +-- @since 0.11.0 +-- type Tuple0 = Unit + +-- | A tuple of one element, a synonym for 'Solo'. +-- +-- @since 0.11.0 +-- type Tuple1 = Solo + +-- | A tuple of two elements. +-- +-- @since 0.11.0 +-- data Tuple2 a b = (a,b) + +-- | A tuple of three elements. +-- +-- @since 0.11.0 +-- data Tuple3 a b c = (a,b,c) + +-- | A tuple of four elements. +-- +-- @since 0.11.0 +-- data Tuple4 a b c d = (a,b,c,d) + +-- | A tuple of five elements. +-- +-- @since 0.11.0 +-- data Tuple5 a b c d e = (a,b,c,d,e) + +-- | A tuple of six elements. +-- +-- @since 0.11.0 +-- data Tuple6 a b c d e f = (a,b,c,d,e,f) + +-- | A tuple of seven elements. +-- +-- @since 0.11.0 +-- data Tuple7 a b c d e f g = (a,b,c,d,e,f,g) + +-- | A tuple of eight elements. +-- +-- @since 0.11.0 +-- data Tuple8 a b c d e f g h = (a,b,c,d,e,f,g,h) + +-- | A tuple of nine elements. +-- +-- @since 0.11.0 +-- data Tuple9 a b c d e f g h i = (a,b,c,d,e,f,g,h,i) + +-- | A tuple of ten elements. +-- +-- @since 0.11.0 +-- data Tuple10 a b c d e f g h i j = (a,b,c,d,e,f,g,h,i,j) + +-- | A tuple of eleven elements. +-- +-- @since 0.11.0 +-- data Tuple11 a b c d e f g h i j k = (a,b,c,d,e,f,g,h,i,j,k) + +-- | A tuple of twelve elements. +-- +-- @since 0.11.0 +-- data Tuple12 a b c d e f g h i j k l = (a,b,c,d,e,f,g,h,i,j,k,l) + +-- | A tuple of 13 elements. +-- +-- @since 0.11.0 +-- data Tuple13 a b c d e f g h i j k l m = (a,b,c,d,e,f,g,h,i,j,k,l,m) + +-- | A tuple of 14 elements. +-- +-- @since 0.11.0 +-- data Tuple14 a b c d e f g h i j k l m n = (a,b,c,d,e,f,g,h,i,j,k,l,m,n) + +-- | A tuple of 15 elements. +-- +-- @since 0.11.0 +-- data Tuple15 a b c d e f g h i j k l m n o = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) + +-- | A tuple of 16 elements. +-- +-- @since 0.11.0 +-- data Tuple16 a b c d e f g h i j k l m n o p = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) + +-- | A tuple of 17 elements. +-- +-- @since 0.11.0 +-- data Tuple17 a b c d e f g h i j k l m n o p q = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) + +-- | A tuple of 18 elements. +-- +-- @since 0.11.0 +-- data Tuple18 a b c d e f g h i j k l m n o p q r = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) + +-- | A tuple of 19 elements. +-- +-- @since 0.11.0 +-- data Tuple19 a b c d e f g h i j k l m n o p q r s = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) + +-- | A tuple of 20 elements. +-- +-- @since 0.11.0 +-- data Tuple20 a b c d e f g h i j k l m n o p q r s t = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) + +-- | A tuple of 21 elements. + +-- +-- @since 0.11.0 +-- data Tuple21 a b c d e f g h i j k l m n o p q r s t u = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) + +-- | A tuple of 22 elements. +-- +-- @since 0.11.0 +-- data Tuple22 a b c d e f g h i j k l m n o p q r s t u v = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) + +-- | A tuple of 23 elements. +-- +-- @since 0.11.0 +-- data Tuple23 a b c d e f g h i j k l m n o p q r s t u v w = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) + +-- | A tuple of 24 elements. +-- +-- @since 0.11.0 +-- data Tuple24 a b c d e f g h i j k l m n o p q r s t u v w x = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) + +-- | A tuple of 25 elements. +-- +-- @since 0.11.0 +-- data Tuple25 a b c d e f g h i j k l m n o p q r s t u v w x y = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) + +-- | A tuple of 26 elements. +-- +-- @since 0.11.0 +-- data Tuple26 a b c d e f g h i j k l m n o p q r s t u v w x y z = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) +-- | A tuple of 27 elements. +-- +-- @since 0.11.0 +-- data Tuple27 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1) + +-- | A tuple of 28 elements. +-- +-- @since 0.11.0 +-- data Tuple28 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1) + +-- | A tuple of 29 elements. +-- +-- @since 0.11.0 +-- data Tuple29 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1) + +-- | A tuple of 30 elements. +-- +-- @since 0.11.0 +-- data Tuple30 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1) + +-- | A tuple of 31 elements. +-- +-- @since 0.11.0 +-- data Tuple31 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1) + +-- | A tuple of 32 elements. +-- +-- @since 0.11.0 +-- data Tuple32 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1) + +-- | A tuple of 33 elements. +-- +-- @since 0.11.0 +-- data Tuple33 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1) + +-- | A tuple of 34 elements. +-- +-- @since 0.11.0 +-- data Tuple34 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1) + +-- | A tuple of 35 elements. +-- +-- @since 0.11.0 +-- data Tuple35 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1) + +-- | A tuple of 36 elements. +-- +-- @since 0.11.0 +-- data Tuple36 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1) + +-- | A tuple of 37 elements. +-- +-- @since 0.11.0 +-- data Tuple37 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1) + +-- | A tuple of 38 elements. +-- +-- @since 0.11.0 +-- data Tuple38 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1) + +-- | A tuple of 39 elements. +-- +-- @since 0.11.0 +-- data Tuple39 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1) + +-- | A tuple of 40 elements. +-- +-- @since 0.11.0 +-- data Tuple40 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1) + +-- | A tuple of 41 elements. +-- +-- @since 0.11.0 +-- data Tuple41 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1) + +-- | A tuple of 42 elements. +-- +-- @since 0.11.0 +-- data Tuple42 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1) + +-- | A tuple of 43 elements. +-- +-- @since 0.11.0 +-- data Tuple43 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1) + +-- | A tuple of 44 elements. +-- +-- @since 0.11.0 +-- data Tuple44 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1) + +-- | A tuple of 45 elements. +-- +-- @since 0.11.0 +-- data Tuple45 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,r1,s1) + +-- | A tuple of 46 elements. +-- +-- @since 0.11.0 +-- data Tuple46 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1) + +-- | A tuple of 47 elements. +-- +-- @since 0.11.0 +-- data Tuple47 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1) + +-- | A tuple of 48 elements. +-- +-- @since 0.11.0 +-- data Tuple48 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1) + +-- | A tuple of 49 elements. +-- +-- @since 0.11.0 +-- data Tuple49 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1) + +-- | A tuple of 50 elements. +-- +-- @since 0.11.0 +-- data Tuple50 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1) + +-- | A tuple of 51 elements. +-- +-- @since 0.11.0 +-- data Tuple51 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1) + +-- | A tuple of 52 elements. +-- +-- @since 0.11.0 +-- data Tuple52 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1) + +-- | A tuple of 53 elements. +-- +-- @since 0.11.0 +-- data Tuple53 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2) + +-- | A tuple of 54 elements. +-- +-- @since 0.11.0 +-- data Tuple54 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2) + +-- | A tuple of 55 elements. +-- +-- @since 0.11.0 +-- data Tuple55 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2) + +-- | A tuple of 56 elements. +-- +-- @since 0.11.0 +-- data Tuple56 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2) + +-- | A tuple of 57 elements. +-- +-- @since 0.11.0 +-- data Tuple57 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2) + +-- | A tuple of 58 elements. +-- +-- @since 0.11.0 +-- data Tuple58 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2) + +-- | A tuple of 59 elements. +-- +-- @since 0.11.0 +-- data Tuple59 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2) + +-- | A tuple of 60 elements. +-- +-- @since 0.11.0 +-- data Tuple60 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2) + +-- | A tuple of 61 elements. +-- +-- @since 0.11.0 +-- data Tuple61 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2) + +-- | A tuple of 62 elements. +-- +-- @since 0.11.0 +-- data Tuple62 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2) + +-- | A tuple of 63 elements. +-- +-- @since 0.11.0 +-- data Tuple63 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2) + +-- | A tuple of 64 elements. +-- +-- @since 0.11.0 +-- data Tuple64 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 l2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -184,6 +184,8 @@ type family Any :: k where { } -- >>> ['h','e','l','l','o'] == "hello" -- True -- +-- @since 0.10.0 +-- data List a = [] | a : List a ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -41,6 +41,9 @@ Warning: on unsupported architectures, the software emulation provided by the fallback to the C standard library is not guaranteed to be IEEE-compliant. +- `Unit`, `Tuple0`, `Tuple1`, `Tuple2`, `Tuple3` and so on (up to `Tuple64`) + are now exported from `GHC.Tuple.Prim` and reexported from `GHC.Tuple`. + ## 0.10.0 - Shipped with GHC 9.6.1 @@ -71,6 +74,8 @@ We are working on ways to allow users and library authors to get back the performance benefits of the old behaviour where possible. +- `List` is now exported from `GHC.Types`. + ## 0.9.0 *August 2022* - Shipped with GHC 9.4.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02f0d0eb53231564df5644e463a65cbc68de59bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02f0d0eb53231564df5644e463a65cbc68de59bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 9 16:01:01 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 09 Jul 2023 12:01:01 -0400 Subject: [Git][ghc/ghc][wip/bump-bytestring-0.11.5.0] Bump bytestring submodule to 0.11.5.0 Message-ID: <64aad9bd62cde_1926c0b13b467012@gitlab.mail> Matthew Craven pushed to branch wip/bump-bytestring-0.11.5.0 at Glasgow Haskell Compiler / GHC Commits: c586491f by Matthew Craven at 2023-07-09T11:59:34-04:00 Bump bytestring submodule to 0.11.5.0 - - - - - 5 changed files: - compiler/GHC/Utils/Binary.hs - hadrian/src/Settings/Warnings.hs - libraries/bytestring - testsuite/tests/ghci/scripts/T9881.stdout - testsuite/tests/ghci/scripts/ghci025.stdout Changes: ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -1228,13 +1228,13 @@ putBS :: BinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l - putPrim bh l (\op -> BS.memcpy op (castPtr ptr) l) + putPrim bh l (\op -> copyBytes op (castPtr ptr) l) getBS :: BinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do - getPrim bh l (\src -> BS.memcpy dest src l) + getPrim bh l (\src -> copyBytes dest src l) instance Binary ByteString where put_ bh f = putBS bh f ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -53,10 +53,12 @@ ghcWarningsArgs = do , package primitive ? pure [ "-Wno-unused-imports" , "-Wno-deprecations" ] , package rts ? pure [ "-Wcpp-undef" ] + , package text ? pure [ "-Wno-deprecations" ] , package terminfo ? pure [ "-Wno-unused-imports" ] , package transformers ? pure [ "-Wno-unused-matches" , "-Wno-unused-imports" , "-Wno-redundant-constraints" , "-Wno-orphans" ] + , package unix ? pure [ "-Wno-deprecations" ] , package win32 ? pure [ "-Wno-trustworthy-safe" ] , package xhtml ? pure [ "-Wno-unused-imports" ] ] ] ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 9cab76dc861f651c3940e873ce921d9e09733cc8 +Subproject commit 980206c96ff8ea3e10983d060f0b2c6685edf825 ===================================== testsuite/tests/ghci/scripts/T9881.stdout ===================================== @@ -19,19 +19,19 @@ instance Ord Data.ByteString.Lazy.ByteString type Data.ByteString.ByteString :: * data Data.ByteString.ByteString - = bytestring-0.11.4.0:Data.ByteString.Internal.Type.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr + = bytestring-0.11.5.0:Data.ByteString.Internal.Type.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr GHC.Word.Word8) {-# UNPACK #-}Int - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Monoid Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Read Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Semigroup Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Show Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Eq Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Ord Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ ===================================== testsuite/tests/ghci/scripts/ghci025.stdout ===================================== @@ -54,7 +54,7 @@ Prelude.length :: Data.Foldable.Foldable t => t a -> GHC.Types.Int type T.Integer :: * data T.Integer = ... T.length :: - bytestring-0.11.4.0:Data.ByteString.Internal.Type.ByteString + bytestring-0.11.5.0:Data.ByteString.Internal.Type.ByteString -> GHC.Types.Int :browse! T -- defined locally View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c586491f880304b36a55b18d755fbd3eab294c0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c586491f880304b36a55b18d755fbd3eab294c0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 9 20:51:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 09 Jul 2023 16:51:54 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 3 commits: gitlab-ci: Bump DOCKER_REV Message-ID: <64ab1deab1a9a_1926c0b13787954b@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: badff2d0 by Ben Gamari at 2023-07-09T13:40:32-04:00 gitlab-ci: Bump DOCKER_REV Ensuring that we bootstrap with GHC 9.4 universally. - - - - - 008664da by Ben Gamari at 2023-07-09T16:14:01-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. - - - - - 507de982 by Ben Gamari at 2023-07-09T16:15:14-04:00 testsuite: Accept new output of bkpcabal08 It seems that Cabal now configures in a different order. - - - - - 3 changed files: - .gitlab-ci.yml - testsuite/driver/testlib.py - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: c29d97c469a23db1c77ac1184eebbb2fd86ef623 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== testsuite/driver/testlib.py ===================================== @@ -1006,7 +1006,7 @@ def normalise_win32_io_errors(name, opts): def normalise_version_( *pkgs ): def normalise_version__( str ): # (name)(-version)(-hash)(-components) - return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-zA-Z]+)?(-[0-9a-zA-Z]+)?', + return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-zA-Z\+]+)?(-[0-9a-zA-Z]+)?', '\\1--', str) return normalise_version__ ===================================== testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout ===================================== @@ -1,5 +1,3 @@ -Preprocessing library 'impl' for bkpcabal08-0.1.0.0... -Building library 'impl' for bkpcabal08-0.1.0.0... Preprocessing library 'p' for bkpcabal08-0.1.0.0... Building library 'p' instantiated with A = @@ -14,6 +12,8 @@ for bkpcabal08-0.1.0.0... [2 of 4] Compiling B[sig] ( q/B.hsig, nothing ) [3 of 4] Compiling M ( q/M.hs, nothing ) [A changed] [4 of 4] Instantiating bkpcabal08-0.1.0.0-5O1mUtZZLBeDZEqqtwJcCj-p +Preprocessing library 'impl' for bkpcabal08-0.1.0.0... +Building library 'impl' for bkpcabal08-0.1.0.0... Preprocessing library 'q' for bkpcabal08-0.1.0.0... Building library 'q' instantiated with A = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:A View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02b96edd178865610b933f6441cd6985be039eea...507de98253f018d0363c2ff2ff8f65009be26ac9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02b96edd178865610b933f6441cd6985be039eea...507de98253f018d0363c2ff2ff8f65009be26ac9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 9 22:36:02 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sun, 09 Jul 2023 18:36:02 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 24 commits: EPA: Improve annotation management in getMonoBind Message-ID: <64ab36521e064_1926c04eaf3cc908de@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 3e907421 by Alan Zimmerman at 2023-07-08T15:17:46+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ceeba004 by Alan Zimmerman at 2023-07-08T15:27:19+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 28930d78 by Alan Zimmerman at 2023-07-08T15:29:10+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - f2076f52 by Alan Zimmerman at 2023-07-08T15:29:15+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 44d5d0f5 by Alan Zimmerman at 2023-07-08T15:29:15+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - 3b46fcff by Alan Zimmerman at 2023-07-08T15:29:15+01:00 EPA: Fix span for GRHS - - - - - f6207046 by Alan Zimmerman at 2023-07-08T15:29:15+01:00 EPA: Fix span for Located Context - - - - - ffcf3ea7 by Alan Zimmerman at 2023-07-08T15:29:15+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - 61d95a7d by Alan Zimmerman at 2023-07-08T15:29:15+01:00 EPA: widen more TrailingAnn usages - - - - - fdd7d6ef by Alan Zimmerman at 2023-07-08T15:29:15+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 16646c32 by Alan Zimmerman at 2023-07-08T15:29:16+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 61541f61 by Alan Zimmerman at 2023-07-08T15:29:16+01:00 WIP - - - - - 7e362241 by Alan Zimmerman at 2023-07-08T15:29:16+01:00 Fixup after rebase - - - - - 31da78a5 by Alan Zimmerman at 2023-07-08T15:29:16+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - c4140d36 by Alan Zimmerman at 2023-07-08T15:29:16+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 558ea510 by Alan Zimmerman at 2023-07-08T15:29:16+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - 512e548f by Alan Zimmerman at 2023-07-08T15:30:12+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - efb5e348 by Alan Zimmerman at 2023-07-08T15:30:14+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - a38f3465 by Alan Zimmerman at 2023-07-08T15:30:14+01:00 EPA: More extending anchors to full span in Parser.y - - - - - f384b602 by Alan Zimmerman at 2023-07-08T15:30:14+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - e8529b87 by Alan Zimmerman at 2023-07-08T15:30:40+01:00 EPA: Fix simple tests - - - - - 7c87ae74 by Alan Zimmerman at 2023-07-08T15:30:44+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 882a0ea5 by Alan Zimmerman at 2023-07-08T15:32:19+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 50635f33 by Alan Zimmerman at 2023-07-09T23:35:49+01:00 EPA: deal with fallout from getMonoBind - - - - - 23 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/695c6584d8a6c6bbf8f8567451bdfaac05e3e98c...50635f33fd99dded59efc6606bca0a1133d7cc77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/695c6584d8a6c6bbf8f8567451bdfaac05e3e98c...50635f33fd99dded59efc6606bca0a1133d7cc77 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 9 22:36:29 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sun, 09 Jul 2023 18:36:29 -0400 Subject: [Git][ghc/ghc][wip/T18389-task-zero] 99 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64ab366de0ed4_1926c04eaf3e0910dc@gitlab.mail> Ryan Scott pushed to branch wip/T18389-task-zero at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8827dca5 by Ryan Scott at 2023-07-09T18:36:17-04:00 Introduce and use ConGadtSigBody (preparatory refactor for #18389) This patch removes the `con_g_args :: HsConDeclGADTDetails pass` and `con_res_ty :: LHsType pass` fields of `ConDeclGADT` in favor of a unified `con_body :: ConGadtSigBody pass` field. There are two major differences between `HsConDeclGADTDetails` and `ConGadtSigBody`: 1. `HsConDeclGADTDetails` only contains the argument type, while `ConGadtSigBody` contains both the argument and result types. 2. The `PrefixConGADT` constructor of `ConGadtSigBody` now uses a new `PrefixConGadtSigBody` data type. `PrefixConGadtSigBody` closely mirrors the structure of `HsType`, but with minor, data constructor–specific tweaks. This will become vital in a future patch which implements nested `forall`s and contexts in prefix GADT constructor types (see #18389). Besides the refactoring in the GHC API (and some minor changes in GHC AST–related test cases) this does not introduce any user-visible changes in behavior. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/MachOp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/506da29ac625613d869ad14b02bfff153db8521b...8827dca5a7e330c4d32c7f9de4ac12f7b792245d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/506da29ac625613d869ad14b02bfff153db8521b...8827dca5a7e330c4d32c7f9de4ac12f7b792245d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 9 22:38:19 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 09 Jul 2023 18:38:19 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 69 commits: configure: Rip out Solaris dyld check Message-ID: <64ab36db39b96_1926c0b1134915f0@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 101eba5a by Simon Peyton Jones at 2023-07-09T23:37:11+01:00 Inline more, sooner - - - - - ccb94b05 by Simon Peyton Jones at 2023-07-09T23:37:11+01:00 One more Simplifier optimistaions Inline in exprIsConAppMaybe - - - - - e1193a00 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Further improvements - - - - - cc2025a9 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Remove trace - - - - - f92b368a by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Add a strategic inline pragma - - - - - bda0d4df by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Two improvements to coercion optimisation One (mkSymCo) makes a big difference in GHC.Read The other (in zapSubstEnv) makes a big diffference in T18223 - - - - - bf6212ad by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Optimise every time we do mkTransCo - - - - - a4827894 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Wibble: remove unused field - - - - - adbfda89 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Fix a total bug in mkSelCo: wrong role We were simply giving an outright-wrong role to a Refl coercion in mkSelCo. - - - - - 2b25265f by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Add assert back into mkCast - - - - - 28fd2bcc by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Don't repeatedly optimise coercions in simplCast This matters when we have (case x of (a,b) -> (case x of (a,b) -> e |> co1 ) |> co2 ) |> co3 Those casts end up successively pushed onto the continuation stack, and we don't want to optimise (co1;co2) and then (co1;co2;co3) etc. - - - - - a641e92d by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Better documentation - - - - - d2aeffe2 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Improve pretty printing of InstCo - - - - - 5e9a3964 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 More improvements * Make opt_co4 (SelCo cs Refl) work properly. It wasn't! * Deal well with (ax ty ; sym (ax ty)). Bizarrely that didn't work. I just put the ax/sym-ax rule first. * Make (mkInstCo Refl ty) work. Bizarrely it didn't! - - - - - e1363617 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Optimise opt_trans_rule a bit This make a significant (5% ish) difference in T13386 - - - - - 8acc9e22 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 Allow join points to inline a bit more This makes a big difference in T14697 -- but only because we still don't have #22404 yet. The critical function is in GHC.Driver.CmdLine, and is called lgo1_uniq It is called from `processArgs` when we find a "-" sign. For some reason this function is called (incl recursive calls) 19,021,947 times in T14967. - - - - - 45ab3ed5 by Simon Peyton Jones at 2023-07-09T23:38:06+01:00 wibble - - - - - 8780cae9 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Try making postInlineUnconditionally a bit more aggressive In particular, inline if n_br == 1 - - - - - c40a3db8 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Try dropping the early-preInlineUnconditionally test - - - - - 53814e74 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Make postInlineUnconditionally a bit more aggressive Try postInlineUnconditionally for one-branch things, even if under a lambda Reinstate the check in simplAuxBind - - - - - 14745306 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Comments only - - - - - d9abcd45 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Fixes for T15630 What a struggle. Finally understood exponential behaviour - - - - - be49266f by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Wibble - - - - - 834678a9 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Move T18730 to perf/compiler where it belongs - - - - - 709f8f32 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Try removing the too_many_occs idea Maybe other things now cover this adequately; if not we should know exactly why we need it. - - - - - 455fd7bc by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Refine the too_many_occs story - - - - - 8fc0f2b2 by Simon Peyton Jones at 2023-07-09T23:38:07+01:00 Comments only - - - - - 26 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ac91e5664072a3380e069737f2771a7f7336a23...8fc0f2b29ed83b26d59c59fdebffeea97225cc1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ac91e5664072a3380e069737f2771a7f7336a23...8fc0f2b29ed83b26d59c59fdebffeea97225cc1c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 03:05:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 09 Jul 2023 23:05:10 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] rts: Work around missing prototypes errors Message-ID: <64ab7566cdb6b_1926c04eaf3a410678d@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 0b61479a by Ben Gamari at 2023-07-09T23:04:51-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. (cherry picked from commit 5b6612bc4f6b0a7ecc9868750bee1c359ffca871) - - - - - 1 changed file: - rts/include/stg/SMP.h Changes: ===================================== rts/include/stg/SMP.h ===================================== @@ -589,9 +589,9 @@ load_load_barrier(void) { EXTERN_INLINE void write_barrier(void); EXTERN_INLINE void store_load_barrier(void); EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ +EXTERN_INLINE void write_barrier (void) {} /* nothing */ +EXTERN_INLINE void store_load_barrier(void) {} /* nothing */ +EXTERN_INLINE void load_load_barrier (void) {} /* nothing */ // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b61479aa3861b3b5337ef0eda5c197f5e817abd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b61479aa3861b3b5337ef0eda5c197f5e817abd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 06:28:46 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 10 Jul 2023 02:28:46 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Apply int-index suggestions about naming and checking type level literals Message-ID: <64aba51ee900d_1926c0b1134124524@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 6c214e64 by Andrei Borzenkov at 2023-07-10T10:28:33+04:00 Apply int-index suggestions about naming and checking type level literals - - - - - 3 changed files: - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Types.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Rename.HsType ( rnHsType, rnLHsType, rnLHsTypes, rnContext, rnMaybeContext, rnLHsKind, rnLHsTypeArgs, rnHsSigType, rnHsWcType, rnHsTyLit, - HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, rnHsPatSigTypeOnLevel, + HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, rnHsPatSigKind, newTyVarNameRn, rnConDeclFields, lookupField, mkHsOpTyRn, @@ -138,7 +138,7 @@ rnHsSigWcType doc (HsWC { hswc_body = ; (nwc_rdrs', imp_tv_nms) <- partition_nwcs free_vars ; let nwc_rdrs = nubL nwc_rdrs' ; bindHsOuterTyVarBndrs doc Nothing imp_tv_nms outer_bndrs $ \outer_bndrs' -> - do { (wcs, body_ty', fvs) <- rnWcBody doc nwc_rdrs body_ty + do { (wcs, body_ty', fvs) <- rnWcBodyType doc nwc_rdrs body_ty ; pure ( HsWC { hswc_ext = wcs, hswc_body = L loc $ HsSig { sig_ext = noExtField , sig_bndrs = outer_bndrs', sig_body = body_ty' }} @@ -149,9 +149,16 @@ rnHsPatSigType :: HsPatSigTypeScoping -> HsPatSigType GhcPs -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -rnHsPatSigType = rnHsPatSigTypeOnLevel TypeLevel +rnHsPatSigType = rnHsPatSigTyKi TypeLevel -rnHsPatSigTypeOnLevel :: TypeOrKind +rnHsPatSigKind :: HsPatSigTypeScoping + -> HsDocContext + -> HsPatSigType GhcPs + -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) + -> RnM (a, FreeVars) +rnHsPatSigKind = rnHsPatSigTyKi KindLevel + +rnHsPatSigTyKi :: TypeOrKind -> HsPatSigTypeScoping -> HsDocContext -> HsPatSigType GhcPs @@ -164,7 +171,7 @@ rnHsPatSigTypeOnLevel :: TypeOrKind -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type -rnHsPatSigTypeOnLevel level scoping ctx sig_ty thing_inside +rnHsPatSigTyKi level scoping ctx sig_ty thing_inside = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) @@ -174,7 +181,7 @@ rnHsPatSigTypeOnLevel level scoping ctx sig_ty thing_inside AlwaysBind -> tv_rdrs NeverBind -> [] ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> - do { (nwcs, pat_sig_ty', fvs1) <- rnWcBodyOnLevel level ctx nwc_rdrs pat_sig_ty + do { (nwcs, pat_sig_ty', fvs1) <- rnWcBodyTyKi level ctx nwc_rdrs pat_sig_ty ; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs } sig_ty' = HsPS { hsps_ext = sig_names, hsps_body = pat_sig_ty' } ; (res, fvs2) <- thing_inside sig_ty' @@ -187,18 +194,18 @@ rnHsWcType ctxt (HsWC { hswc_body = hs_ty }) = do { free_vars <- filterInScopeM (extractHsTyRdrTyVars hs_ty) ; (nwc_rdrs', _) <- partition_nwcs free_vars ; let nwc_rdrs = nubL nwc_rdrs' - ; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty + ; (wcs, hs_ty', fvs) <- rnWcBodyType ctxt nwc_rdrs hs_ty ; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' } ; return (sig_ty', fvs) } -rnWcBody :: HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs +rnWcBodyType :: HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs -> RnM ([Name], LHsType GhcRn, FreeVars) -rnWcBody = rnWcBodyOnLevel TypeLevel +rnWcBodyType = rnWcBodyTyKi TypeLevel -rnWcBodyOnLevel :: TypeOrKind -> HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs +rnWcBodyTyKi :: TypeOrKind -> HsDocContext -> [LocatedN RdrName] -> LHsType GhcPs -> RnM ([Name], LHsType GhcRn, FreeVars) -rnWcBodyOnLevel level ctxt nwc_rdrs hs_ty +rnWcBodyTyKi level ctxt nwc_rdrs hs_ty = do { nwcs <- mapM newLocalBndrRn nwc_rdrs ; let env = RTKE { rtke_level = level , rtke_what = RnTypeBody @@ -616,13 +623,8 @@ rnHsTyKi env sumTy@(HsSumTy x tys) rnHsTyKi env tyLit@(HsTyLit src t) = do { data_kinds <- xoptM LangExt.DataKinds ; unless data_kinds (addErr (dataKindsErr env tyLit)) - ; when (negLit t) (addErr $ TcRnNegativeNumTypeLiteral tyLit) - ; return (HsTyLit src (rnHsTyLit t), emptyFVs) } - where - negLit :: HsTyLit (GhcPass p) -> Bool - negLit (HsStrTy _ _) = False - negLit (HsNumTy _ i) = i < 0 - negLit (HsCharTy _ _) = False + ; t' <- rnHsTyLit t + ; return (HsTyLit src t', emptyFVs) } rnHsTyKi env (HsAppTy _ ty1 ty2) = do { (ty1', fvs1) <- rnLHsTyKi env ty1 @@ -687,10 +689,13 @@ rnHsTyKi env (HsWildCardTy _) ; return (HsWildCardTy noExtField, emptyFVs) } -rnHsTyLit :: HsTyLit GhcPs -> HsTyLit GhcRn -rnHsTyLit (HsStrTy x s) = HsStrTy x s -rnHsTyLit (HsNumTy x i) = HsNumTy x i -rnHsTyLit (HsCharTy x c) = HsCharTy x c +rnHsTyLit :: HsTyLit GhcPs -> RnM (HsTyLit GhcRn) +rnHsTyLit (HsStrTy x s) = pure (HsStrTy x s) +rnHsTyLit tyLit@(HsNumTy x i) = do + when (i < 0) $ + addErr $ TcRnNegativeNumTypeLiteral tyLit + pure (HsNumTy x i) +rnHsTyLit (HsCharTy x c) = pure (HsCharTy x c) rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars) ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -1327,13 +1327,8 @@ rn_ty_pat ty@(HsExplicitTupleTy _ tys) = do rn_ty_pat tyLit@(HsTyLit src t) = do data_kinds <- liftRn $ xoptM LangExt.DataKinds unless data_kinds (liftRn $ addErr (TcRnDataKindsError TypeLevel tyLit)) - when (negLit t) (liftRn $ addErr $ TcRnNegativeNumTypeLiteral tyLit) - pure (HsTyLit src (rnHsTyLit t)) - where - negLit :: HsTyLit (GhcPass p) -> Bool - negLit (HsStrTy _ _) = False - negLit (HsNumTy _ i) = i < 0 - negLit (HsCharTy _ _) = False + t' <- liftRn $ rnHsTyLit t + pure (HsTyLit src t') rn_ty_pat (HsWildCardTy _) = pure (HsWildCardTy noExtField) @@ -1343,7 +1338,7 @@ rn_ty_pat (HsKindSig an ty ki) = do kind_sigs_ok <- liftRn $ xoptM LangExt.KindSignatures unless kind_sigs_ok (liftRn $ badKindSigErr ctxt ki) ~(HsPS hsps ki') <- liftRnWithCont $ - rnHsPatSigTypeOnLevel KindLevel AlwaysBind ctxt (HsPS noAnn ki) + rnHsPatSigKind AlwaysBind ctxt (HsPS noAnn ki) ty' <- rn_lty_pat ty tellTPB (tpb_hsps hsps) pure (HsKindSig an ty' ki') ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -717,7 +717,7 @@ data TcRnMessage where Test cases: th/T8412 typecheck/should_fail/T8306 -} - TcRnNegativeNumTypeLiteral :: HsType GhcPs -> TcRnMessage + TcRnNegativeNumTypeLiteral :: HsTyLit GhcPs -> TcRnMessage {-| TcRnIllegalWildcardsInConstructor is an error that occurs whenever the record wildcards '..' are used inside a constructor without labeled fields. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c214e6433738ca6423dcebb4ac30714ff7bc77f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c214e6433738ca6423dcebb4ac30714ff7bc77f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 07:30:21 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 10 Jul 2023 03:30:21 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix wrong MIN_VERSION_GLASGOW_HASKELL macros Message-ID: <64abb38d4356f_1926c04ebe37c1306a2@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 726c9196 by Jaro Reinders at 2023-07-10T09:29:11+02:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 1 changed file: - compiler/cbits/genSym.c Changes: ===================================== compiler/cbits/genSym.c ===================================== @@ -9,7 +9,7 @@ // // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) HsWord64 ghc_unique_counter64 = 0; #endif #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) @@ -18,7 +18,7 @@ HsInt ghc_unique_inc = 1; // This function has been added to the RTS. Here we pessimistically assume // that a threaded RTS is used. This function is only used for bootstrapping. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/726c91961a0ab2a3ed22ade6c161c837ac3d4756 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/726c91961a0ab2a3ed22ade6c161c837ac3d4756 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 07:33:32 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 10 Jul 2023 03:33:32 -0400 Subject: [Git][ghc/ghc][wip/T22010] 66 commits: Define FFI_GO_CLOSURES Message-ID: <64abb44c8d153_1926c0b138c1328fa@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 133feed6 by Jaro Reinders at 2023-07-10T09:33:12+02:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/726c91961a0ab2a3ed22ade6c161c837ac3d4756...133feed641ae40b3bd97e684e537c2771e64def3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/726c91961a0ab2a3ed22ade6c161c837ac3d4756...133feed641ae40b3bd97e684e537c2771e64def3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 08:10:52 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 10 Jul 2023 04:10:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-string-codepoint Message-ID: <64abbd0ca4fb3_1926c04eaf3e01411c9@gitlab.mail> Josh Meredith pushed new branch wip/js-string-codepoint at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-string-codepoint You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 08:29:21 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 10 Jul 2023 04:29:21 -0400 Subject: [Git][ghc/ghc][wip/T23578] Also change Enum Int64 Message-ID: <64abc160f3eeb_1926c04eaf3a415217b@gitlab.mail> Jaro Reinders pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC Commits: f5c665f4 by Jaro Reinders at 2023-07-10T10:29:11+02:00 Also change Enum Int64 - - - - - 2 changed files: - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs Changes: ===================================== libraries/base/GHC/Int.hs ===================================== @@ -753,27 +753,153 @@ instance Enum Int64 where | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = I# (int64ToInt# x#) | otherwise = fromEnumError "Int64" x -#if WORD_SIZE_IN_BITS < 64 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFrom #-} - enumFrom = integralEnumFrom - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThen #-} - enumFromThen = integralEnumFromThen + enumFrom (I64# x) = eftInt64 x maxInt64# + where !(I64# maxInt64#) = maxBound + -- Blarg: technically I guess enumFrom isn't strict! + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromTo #-} - enumFromTo = integralEnumFromTo - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThenTo #-} - enumFromThenTo = integralEnumFromThenTo -#else - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFrom #-} - enumFrom = boundedEnumFrom + enumFromTo (I64# x) (I64# y) = eftInt64 x y + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThen #-} - enumFromThen = boundedEnumFromThen -#endif + enumFromThen (I64# x1) (I64# x2) = efdInt64 x1 x2 + + -- See Note [Stable Unfolding for list producers] in GHC.Enum + {-# INLINE enumFromThenTo #-} + enumFromThenTo (I64# x1) (I64# x2) (I64# y) = efdtInt64 x1 x2 y + + +----------------------------------------------------- +-- eftInt64 and eftInt64FB deal with [a..b], which is the +-- most common form, so we take a lot of care +-- In particular, we have rules for deforestation + +-- See Note [How the Enum rules work] in GHC.Enum +{-# RULES +"eftInt64" [~1] forall x y. eftInt64 x y = build (\ c n -> eftInt64FB c n x y) +"eftInt64List" [1] eftInt64FB (:) [] = eftInt64 + #-} + +{-# NOINLINE [1] eftInt64 #-} +eftInt64 :: Int64# -> Int64# -> [Int64] +-- [x1..x2] +eftInt64 x0 y | isTrue# (x0 `geInt64#` y) = [] + | otherwise = go x0 + where + go x = I64# x : if isTrue# (x `eqInt64#` y) + then [] + else go (x `plusInt64#` (intToInt64# 1#)) + +{-# INLINE [0] eftInt64FB #-} -- See Note [Inline FB functions] in GHC.List +eftInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> r +eftInt64FB c n x0 y | isTrue# (x0 `geInt64#` y) = n + | otherwise = go x0 + where + go x = I64# x `c` if isTrue# (x `eqInt64#` y) + then n + else go (x `plusInt64#` (intToInt64# 1#)) + -- Watch out for y=maxBound; hence ==, not > + -- Be very careful not to have more than one "c" + -- so that when eftInfFB is inlined we can inline + -- whatever is bound to "c" + + +----------------------------------------------------- +-- efdInt64 and efdtInt64 deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Int64 overflow. + +-- See Note [How the Enum rules work] in GHC.Enum +{-# RULES +"efdtInt64" [~1] forall x1 x2 y. + efdtInt64 x1 x2 y = build (\ c n -> efdtInt64FB c n x1 x2 y) +"efdtInt64UpList" [1] efdtInt64FB (:) [] = efdtInt64 + #-} + +efdInt64 :: Int64# -> Int64# -> [Int64] +-- [x1,x2..maxInt64] +efdInt64 x1 x2 + | isTrue# (x2 `geInt64#` x1) = case maxBound of I64# y -> efdtInt64Up x1 x2 y + | otherwise = case maxBound of I64# y -> efdtInt64Dn x1 x2 y + +{-# NOINLINE [1] efdtInt64 #-} +efdtInt64 :: Int64# -> Int64# -> Int64# -> [Int64] +-- [x1,x2..y] +efdtInt64 x1 x2 y + | isTrue# (x2 `geInt64#` x1) = efdtInt64Up x1 x2 y + | otherwise = efdtInt64Dn x1 x2 y + +{-# INLINE [0] efdtInt64FB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64FB c n x1 x2 y + | isTrue# (x2 `geInt64#` x1) = efdtInt64UpFB c n x1 x2 y + | otherwise = efdtInt64DnFB c n x1 x2 y + +-- Requires x2 >= x1 +efdtInt64Up :: Int64# -> Int64# -> Int64# -> [Int64] +efdtInt64Up x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then [] else [I64# x1] + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subInt64#` x1 -- >= 0 + !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtInt64#` y') = [I64# x] + | otherwise = I64# x : go_up (x `plusInt64#` delta) + in I64# x1 : go_up x2 + +-- Requires x2 >= x1 +{-# INLINE [0] efdtInt64UpFB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64UpFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64UpFB c n x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then n else I64# x1 `c` n + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subInt64#` x1 -- >= 0 + !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `geInt64#` y') = I64# x `c` n + | otherwise = I64# x `c` go_up (x `plusInt64#` delta) + in I64# x1 `c` go_up x2 + +-- Requires x2 <= x1 +efdtInt64Dn :: Int64# -> Int64# -> Int64# -> [Int64] +efdtInt64Dn x1 x2 y -- Be careful about underflow! + | isTrue# (y `geInt64#` x2) = if isTrue# (y `geInt64#` x1) then [] else [I64# x1] + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subInt64#` x1 -- <= 0 + !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltInt64#` y') = [I64# x] + | otherwise = I64# x : go_dn (x `plusInt64#` delta) + in I64# x1 : go_dn x2 + +-- Requires x2 <= x1 +{-# INLINE [0] efdtInt64DnFB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64DnFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64DnFB c n x1 x2 y -- Be careful about underflow! + | isTrue# (y `geInt64#` x2) = if isTrue# (y `geInt64#` x1) then n else I64# x1 `c` n + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subInt64#` x1 -- <= 0 + !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltInt64#` y') = I64# x `c` n + | otherwise = I64# x `c` go_dn (x `plusInt64#` delta) + in I64# x1 `c` go_dn x2 + -- | @since 2.01 instance Integral Int64 where ===================================== libraries/base/GHC/Word.hs ===================================== @@ -731,17 +731,21 @@ instance Enum Word64 where = I# (word2Int# (word64ToWord# x#)) | otherwise = fromEnumError "Word64" x + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFrom #-} enumFrom (W64# x#) = eftWord64 x# maxWord# where !(W64# maxWord#) = maxBound -- Blarg: technically I guess enumFrom isn't strict! + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromTo #-} enumFromTo (W64# x) (W64# y) = eftWord64 x y + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThen #-} enumFromThen (W64# x1) (W64# x2) = efdWord64 x1 x2 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThenTo #-} enumFromThenTo (W64# x1) (W64# x2) (W64# y) = efdtWord64 x1 x2 y @@ -811,7 +815,7 @@ efdtWord64 x1 x2 y efdtWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r efdtWord64FB c n x1 x2 y | isTrue# (x2 `geWord64#` x1) = efdtWord64UpFB c n x1 x2 y - | otherwise = efdtWord64DnFB c n x1 x2 y + | otherwise = efdtWord64DnFB c n x1 x2 y -- Requires x2 >= x1 efdtWord64Up :: Word64# -> Word64# -> Word64# -> [Word64] @@ -825,7 +829,7 @@ efdtWord64Up x1 x2 y -- Be careful about overflow! -- Note that: z <= y' => z + delta won't overflow -- so we are guaranteed not to overflow if/when we recurse go_up x | isTrue# (x `gtWord64#` y') = [W64# x] - | otherwise = W64# x : go_up (x `plusWord64#` delta) + | otherwise = W64# x : go_up (x `plusWord64#` delta) in W64# x1 : go_up x2 -- Requires x2 >= x1 @@ -841,7 +845,7 @@ efdtWord64UpFB c n x1 x2 y -- Be careful about overflow! -- Note that: z <= y' => z + delta won't overflow -- so we are guaranteed not to overflow if/when we recurse go_up x | isTrue# (x `gtWord64#` y') = W64# x `c` n - | otherwise = W64# x `c` go_up (x `plusWord64#` delta) + | otherwise = W64# x `c` go_up (x `plusWord64#` delta) in W64# x1 `c` go_up x2 -- Requires x2 <= x1 @@ -856,7 +860,7 @@ efdtWord64Dn x1 x2 y -- Be careful about underflow! -- Note that: z >= y' => z + delta won't underflow -- so we are guaranteed not to underflow if/when we recurse go_dn x | isTrue# (x `ltWord64#` y') = [W64# x] - | otherwise = W64# x : go_dn (x `plusWord64#` delta) + | otherwise = W64# x : go_dn (x `plusWord64#` delta) in W64# x1 : go_dn x2 -- Requires x2 <= x1 @@ -872,7 +876,7 @@ efdtWord64DnFB c n x1 x2 y -- Be careful about underflow! -- Note that: z >= y' => z + delta won't underflow -- so we are guaranteed not to underflow if/when we recurse go_dn x | isTrue# (x `ltWord64#` y') = W64# x `c` n - | otherwise = W64# x `c` go_dn (x `plusWord64#` delta) + | otherwise = W64# x `c` go_dn (x `plusWord64#` delta) in W64# x1 `c` go_dn x2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c665f4cc6a56127f716e36c4e5242e57502333 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c665f4cc6a56127f716e36c4e5242e57502333 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 08:59:10 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 10 Jul 2023 04:59:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/revert-text-bump Message-ID: <64abc85e85d21_1926c0b1134164282@gitlab.mail> Matthew Pickering pushed new branch wip/revert-text-bump at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/revert-text-bump You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 09:04:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 05:04:43 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 39 commits: Improve the situation with the stimes cycle Message-ID: <64abc9abe4dee_1926c0b11341732f7@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 3d3a7fec by Ben Gamari at 2023-07-10T09:42:59+01:00 ghc-toolchain: Initial commit - - - - - 47fb3e71 by Rodrigo Mesquita at 2023-07-10T09:43:00+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 2405b138 by Rodrigo Mesquita at 2023-07-10T09:43:00+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - 3d05705a by Rodrigo Mesquita at 2023-07-10T09:43:00+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - f1ed02d4 by Rodrigo Mesquita at 2023-07-10T09:43:00+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - b43857e4 by Rodrigo Mesquita at 2023-07-10T09:44:24+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 78744b24 by Rodrigo Mesquita at 2023-07-10T09:44:26+01:00 Use ghc-platform instead of ghc-boot - - - - - bf86ae78 by Rodrigo Mesquita at 2023-07-10T09:44:26+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - a75d6630 by Rodrigo Mesquita at 2023-07-10T09:44:26+01:00 FixeWs Fixes2 - - - - - 07e269dd by Rodrigo Mesquita at 2023-07-10T09:55:19+01:00 Try to add locally-executable arg - - - - - 29 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - + TODO - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/465d92b1b0564d044d863b90eeeb0b5b99e1556a...07e269dde37f128c0d5be773a5306edb0610cf43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/465d92b1b0564d044d863b90eeeb0b5b99e1556a...07e269dde37f128c0d5be773a5306edb0610cf43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 09:27:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 10 Jul 2023 05:27:09 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add since annotations for Data.Foldable1 Message-ID: <64abceed21fed_1926c04eaf3e017894a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - bc922f5a by Alan Zimmerman at 2023-07-10T05:26:54-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - bfc584c6 by Bodigrim at 2023-07-10T05:26:59-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 11 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Parser.y - compiler/GHC/StgToJS/Linker/Linker.hs - libraries/base/Data/Foldable1.hs - libraries/text - + testsuite/tests/driver/T23613.hs - testsuite/tests/driver/all.T - testsuite/tests/driver/multipleHomeUnits/all.T - testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T - testsuite/tests/driver/multipleHomeUnits/o-files/all.T - testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1953,7 +1953,9 @@ primop CompareByteArraysOp "compareByteArrays#" GenPrimOp specified ranges, but this is not checked. Returns an 'Int#' less than, equal to, or greater than zero if the range is found, respectively, to be byte-wise lexicographically less than, to - match, or be greater than the second range.} + match, or be greater than the second range. + + @since 0.5.2.0} with can_fail = True ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,14 +1026,14 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } - | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } - | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } @@ -1371,7 +1371,7 @@ inst_decl :: { LInstDecl GhcPs } , cid_tyfam_insts = ats , cid_overlap_mode = $2 , cid_datafam_insts = adts } - ; acsA (\cs -> L (comb3 $1 (reLoc $3) $4) + ; acsA (\cs -> L (comb3 $1 $3 $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid cs })) } } @@ -1498,7 +1498,7 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } at_decl_cls :: { LHsDecl GhcPs } : -- data family declarations, with optional 'family' keyword 'data' opt_family type opt_datafam_kind_sig - {% liftM mkTyClD (mkFamDecl (comb3 $1 (reLoc $3) $4) DataFamily NotTopLevel $3 + {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3 (snd $ unLoc $4) Nothing (mj AnnData $1:$2++(fst $ unLoc $4))) } @@ -1506,13 +1506,13 @@ at_decl_cls :: { LHsDecl GhcPs } -- (can't use opt_instance because you get shift/reduce errors | 'type' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $2) $3) OpenTypeFamily NotTopLevel $2 + (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2 (fst . snd $ unLoc $3) (snd . snd $ unLoc $3) (mj AnnType $1:(fst $ unLoc $3)) )} | 'type' 'family' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $3) $4) OpenTypeFamily NotTopLevel $3 + (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3 (fst . snd $ unLoc $4) (snd . snd $ unLoc $4) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))} @@ -1651,7 +1651,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } role_annot :: { LRoleAnnotDecl GhcPs } role_annot : 'type' 'role' oqtycon maybe_roles - {% mkRoleAnnotDecl (comb3N $1 $4 $3) $3 (reverse (unLoc $4)) + {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4)) [mj AnnType $1,mj AnnRole $2] } -- Reversed! @@ -2594,7 +2594,7 @@ decl :: { LHsDecl GhcPs } rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } : '=' exp wherebinds {% runPV (unECP $2) >>= \ $2 -> do { let L l (bs, csw) = adaptWhereBinds $3 - ; let loc = (comb3 $1 (reLoc $2) (L l bs)) + ; let loc = (comb3 $1 $2 (L l bs)) ; acs (\cs -> sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2) bs)) } } @@ -2907,7 +2907,7 @@ aexp :: { ECP } | 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) -> return $ ECP $ $4 >>= \ $4 -> - mkHsCasePV (comb3 $1 $3 (reLoc $4)) $2 $4 + mkHsCasePV (comb3 $1 $3 $4) $2 $4 (EpAnnHsCase (glAA $1) (glAA $3) []) } -- QualifiedDo. | DO stmtlist {% do @@ -4090,17 +4090,9 @@ stringLiteralToHsDocWst = lexStringLiteral parseIdentifier comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan comb2 a b = a `seq` b `seq` combineHasLocs a b -comb3 :: Located a -> Located b -> Located c -> SrcSpan +comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c)) - -comb3A :: Located a -> Located b -> LocatedAn t c -> SrcSpan -comb3A a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) - -comb3N :: Located a -> Located b -> LocatedN c -> SrcSpan -comb3N a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) + combineSrcSpans (getHasLoc a) (combineHasLocs b c) comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -327,7 +327,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache = do let (rts_wired_units, rts_wired_functions) = rtsDeps units -- all the units we want to link together, without their dependencies - let root_units = filter (/= mainUnitId) + let root_units = filter (/= ue_currentUnit unit_env) $ filter (/= interactiveUnitId) $ nub $ rts_wired_units ++ reverse obj_units ++ reverse units ===================================== libraries/base/Data/Foldable1.hs ===================================== @@ -2,6 +2,9 @@ -- Copyright: Edward Kmett, Oleg Grenrus -- License: BSD-3-Clause -- +-- A class of non-empty data structures that can be folded to a summary value. +-- +-- @since 4.18.0.0 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -12,7 +15,6 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} --- | A class of non-empty data structures that can be folded to a summary value. module Data.Foldable1 ( Foldable1(..), foldr1, foldr1', @@ -65,6 +67,8 @@ import Data.Coerce (Coercible, coerce) ------------------------------------------------------------------------------- -- | Non-empty data structures that can be folded. +-- +-- @since 4.18.0.0 class Foldable t => Foldable1 t where {-# MINIMAL foldMap1 | foldrMap1 #-} @@ -86,6 +90,8 @@ class Foldable t => Foldable1 t where -- them via the semigroup's @('<>')@ operator. This fold is -- right-associative and lazy in the accumulator. When you need a strict -- left-associative fold, use 'foldMap1'' instead, with 'id' as the map. + -- + -- @since 4.18.0.0 fold1 :: Semigroup m => t m -> m fold1 = foldMap1 id @@ -97,6 +103,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1 (:[]) (1 :| [2, 3, 4]) -- [1,2,3,4] -- + -- @since 4.18.0.0 foldMap1 :: Semigroup m => (a -> m) -> t a -> m foldMap1 f = foldrMap1 f (\a m -> f a <> m) @@ -107,6 +114,7 @@ class Foldable t => Foldable1 t where -- >>> foldMap1' Sum (1 :| [2, 3, 4]) -- Sum {getSum = 10} -- + -- @since 4.18.0.0 foldMap1' :: Semigroup m => (a -> m) -> t a -> m foldMap1' f = foldlMap1' f (\m a -> m <> f a) @@ -115,6 +123,7 @@ class Foldable t => Foldable1 t where -- >>> toNonEmpty (Identity 2) -- 2 :| [] -- + -- @since 4.18.0.0 toNonEmpty :: t a -> NonEmpty a toNonEmpty = runNonEmptyDList . foldMap1 singleton @@ -123,6 +132,7 @@ class Foldable t => Foldable1 t where -- >>> maximum (32 :| [64, 8, 128, 16]) -- 128 -- + -- @since 4.18.0.0 maximum :: Ord a => t a -> a maximum = getMax #. foldMap1' Max @@ -131,6 +141,7 @@ class Foldable t => Foldable1 t where -- >>> minimum (32 :| [64, 8, 128, 16]) -- 8 -- + -- @since 4.18.0.0 minimum :: Ord a => t a -> a minimum = getMin #. foldMap1' Min @@ -139,6 +150,7 @@ class Foldable t => Foldable1 t where -- >>> head (1 :| [2, 3, 4]) -- 1 -- + -- @since 4.18.0.0 head :: t a -> a head = getFirst #. foldMap1 First @@ -147,6 +159,7 @@ class Foldable t => Foldable1 t where -- >>> last (1 :| [2, 3, 4]) -- 4 -- + -- @since 4.18.0.0 last :: t a -> a last = getLast #. foldMap1 Last @@ -168,6 +181,7 @@ class Foldable t => Foldable1 t where -- -- @foldrMap1 f g = foldrMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1 f g xs = appFromMaybe (foldMap1 (FromMaybe #. h) xs) Nothing @@ -188,6 +202,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1' f z = foldlMap1' f z . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1' f g xs = foldrMap1 f' g' xs SNothing @@ -227,6 +242,7 @@ class Foldable t => Foldable1 t where -- -- @foldlMap1 f g = foldlMap1 f g . 'toNonEmpty'@ -- + -- @since 4.18.0.0 foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b foldlMap1 f g xs = appFromMaybe (getDual (foldMap1 ((Dual . FromMaybe) #. h) xs)) Nothing @@ -249,6 +265,7 @@ class Foldable t => Foldable1 t where -- poor fit for the task at hand. If the order in which the elements are -- combined is not important, use 'foldlMap1'' instead. -- + -- @since 4.18.0.0 foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b foldrMap1' f g xs = foldlMap1 f' g' xs SNothing @@ -264,21 +281,29 @@ class Foldable t => Foldable1 t where ------------------------------------------------------------------------------- -- | A variant of 'foldrMap1' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1 = foldrMap1 id {-# INLINE foldr1 #-} -- | A variant of 'foldrMap1'' where the rightmost element maps to itself. +-- +-- @since 4.18.0.0 foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldr1' = foldrMap1' id {-# INLINE foldr1' #-} -- | A variant of 'foldlMap1' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1 = foldlMap1 id {-# INLINE foldl1 #-} -- | A variant of 'foldlMap1'' where the leftmost element maps to itself. +-- +-- @since 4.18.0.0 foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a foldl1' = foldlMap1' id {-# INLINE foldl1' #-} @@ -294,6 +319,7 @@ foldl1' = foldlMap1' id -- >>> intercalate1 mempty $ "I" :| ["Am", "Fine", "You?"] -- "IAmFineYou?" -- +-- @since 4.18.0.0 intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m intercalate1 = flip intercalateMap1 id @@ -302,10 +328,14 @@ intercalateMap1 j f = flip joinee j . foldMap1 (JoinWith . const . f) -- | Monadic fold over the elements of a non-empty structure, -- associating to the right, i.e. from right to left. +-- +-- @since 4.18.0.0 foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldrM1 = foldrMapM1 return -- | Map variant of 'foldrM1'. +-- +-- @since 4.18.0.0 foldrMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (a -> b -> m b) -> t a -> m b foldrMapM1 g f = go . toNonEmpty where @@ -316,16 +346,22 @@ foldrMapM1 g f = go . toNonEmpty -- | Monadic fold over the elements of a non-empty structure, -- associating to the left, i.e. from left to right. +-- +-- @since 4.18.0.0 foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a foldlM1 = foldlMapM1 return -- | Map variant of 'foldlM1'. +-- +-- @since 4.18.0.0 foldlMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (b -> a -> m b) -> t a -> m b foldlMapM1 g f t = g x >>= \y -> foldlM f y xs where x:|xs = toNonEmpty t -- | The largest element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a maximumBy cmp = foldl1' max' where max' x y = case cmp x y of @@ -334,6 +370,8 @@ maximumBy cmp = foldl1' max' -- | The least element of a non-empty structure with respect to the -- given comparison function. +-- +-- @since 4.18.0.0 minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a minimumBy cmp = foldl1' min' where min' x y = case cmp x y of @@ -379,6 +417,7 @@ instance Semigroup a => Semigroup (JoinWith a) where -- Instances for misc base types ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 NonEmpty where foldMap1 f (x :| xs) = go (f x) xs where go y [] = y @@ -398,9 +437,11 @@ instance Foldable1 NonEmpty where head = NE.head last = NE.last +-- | @since 4.18.0.0 instance Foldable1 Down where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Complex where foldMap1 f (x :+ y) = f x <> f y @@ -412,6 +453,7 @@ instance Foldable1 Complex where -- 3+ tuples are not Foldable/Traversable +-- | @since 4.18.0.0 instance Foldable1 Solo where foldMap1 f (MkSolo y) = f y toNonEmpty (MkSolo x) = x :| [] @@ -420,6 +462,7 @@ instance Foldable1 Solo where head (MkSolo x) = x last (MkSolo x) = x +-- | @since 4.18.0.0 instance Foldable1 ((,) a) where foldMap1 f (_, y) = f y toNonEmpty (_, x) = x :| [] @@ -432,52 +475,68 @@ instance Foldable1 ((,) a) where -- Monoid / Semigroup instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Dual where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Sum where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Product where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Min where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Max where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 First where foldMap1 = coerce +-- | @since 4.18.0.0 instance Foldable1 Last where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Alt f) +-- | @since 4.18.0.0 deriving instance (Foldable1 f) => Foldable1 (Mon.Ap f) ------------------------------------------------------------------------------- -- GHC.Generics instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 V1 where foldMap1 _ x = x `seq` error "foldMap1 @V1" +-- | @since 4.18.0.0 instance Foldable1 Par1 where foldMap1 = coerce +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (Rec1 f) +-- | @since 4.18.0.0 deriving instance Foldable1 f => Foldable1 (M1 i c f) +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where foldMap1 f (L1 x) = foldMap1 f x foldMap1 f (R1 y) = foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where foldMap1 f (x :*: y) = foldMap1 f x <> foldMap1 f y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where foldMap1 f = foldMap1 (foldMap1 f) . unComp1 @@ -485,6 +544,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where -- Extra instances ------------------------------------------------------------------------------- +-- | @since 4.18.0.0 instance Foldable1 Identity where foldMap1 = coerce @@ -509,6 +569,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where head (Functor.Pair x _) = head x last (Functor.Pair _ y) = last y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where foldMap1 f (Functor.InL x) = foldMap1 f x foldMap1 f (Functor.InR y) = foldMap1 f y @@ -529,6 +590,7 @@ instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where maximum (Functor.InL x) = maximum x maximum (Functor.InR y) = maximum y +-- | @since 4.18.0.0 instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where foldMap1 f = foldMap1 (foldMap1 f) . getCompose ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f ===================================== testsuite/tests/driver/T23613.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,6 +320,7 @@ test('T21869', [js_broken(22261), when(unregisterised(), skip)], makefile_test, test('T22044', normal, makefile_test, []) test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"]) test('T21722', normal, compile_fail, ['-fno-show-error-context']) -test('T22669', js_skip, makefile_test, []) -test('T23339', js_skip, makefile_test, []) -test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) +test('T22669', req_interp, makefile_test, []) +test('T23339', req_c, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, []) +test('T23613', normal, compile_and_run, ['-this-unit-id=foo']) ===================================== testsuite/tests/driver/multipleHomeUnits/all.T ===================================== @@ -1,7 +1,7 @@ test('multipleHomeUnits_single1', [extra_files([ 'a/', 'unitA'])], multiunit_compile, [['unitA'], '-fhide-source-paths']) test('multipleHomeUnits_single2', [extra_files([ 'b/', 'unitB'])], multiunit_compile, [['unitB'], '-fhide-source-paths']) -test('multipleHomeUnits_single3', [js_broken(22261),extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) -test('multipleHomeUnits_single4', [js_broken(22261),extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) +test('multipleHomeUnits_single3', [extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths']) +test('multipleHomeUnits_single4', [extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths']) test('multipleHomeUnits_single5', [req_th,extra_files([ 'th/', 'unitTH'])], multiunit_compile, [['unitTH'], '-fhide-source-paths']) test('multipleHomeUnits_cpp', [extra_files([ 'cpp-includes/', 'unitCPPIncludes'])], multiunit_compile, [['unitCPPIncludes'], '-fhide-source-paths']) test('multipleHomeUnits_cfile', [extra_files([ 'c-file/', 'unitCFile'])], multiunit_compile, [['unitCFile'], '-fhide-source-paths']) @@ -24,14 +24,12 @@ test('multipleHomeUnits002', [ extra_files( [ 'c/', 'd/' , 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits003', [ extra_files( [ 'a/', 'b/', 'c/', 'd/' , 'unitA', 'unitB', 'unitC', 'unitD']) - , js_broken(22261) ], makefile_test, []) test('multipleHomeUnits004', ===================================== testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_hidir' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , makefile_test , ['mhu-hidir']) ===================================== testsuite/tests/driver/multipleHomeUnits/o-files/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_o-files' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) , pre_cmd('$MAKE -s --no-print-directory setup')] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) ===================================== testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T ===================================== @@ -1,7 +1,6 @@ # This test checks that getRootSummary doesn't cross package boundaries. test('multipleHomeUnits_target-file-path' , [extra_files([ 'p1/', 'unitP1']) - , js_broken(22261) ] , multiunit_compile , [['unitP1'], '-fhide-source-paths']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eff59a27307f48150045718d5fa3b9f6aeb80b9c...bfc584c64ab593a3a52af97badb25ebb6c5ab1f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eff59a27307f48150045718d5fa3b9f6aeb80b9c...bfc584c64ab593a3a52af97badb25ebb6c5ab1f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 11:06:36 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 07:06:36 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Try to add locally-executable arg Message-ID: <64abe63c412cc_1926c04ebe37c224255@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9e6ffc7f by Rodrigo Mesquita at 2023-07-10T12:06:20+01:00 Try to add locally-executable arg - - - - - 7 changed files: - default.target.in - hadrian/src/Context.hs - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== default.target.in ===================================== @@ -1,6 +1,7 @@ Target { tgtArchOs = ArchOS {archOS_arch = @HaskellTargetArch@, archOS_OS = @HaskellTargetOs@} , tgtVendor = @TargetVendor_CPPMaybeStr@ +, tgtLocallyExecutable = @NotCrossCompilingBool@ , tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ , tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ , tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ @@ -11,9 +12,9 @@ Target , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ -, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @CFLAGSList@}} -, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @CXXFLAGSList@}} -, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @CPPFLAGSList@}} +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @SettingsCPPFlagsList@}} , tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@SettingsHaskellCPPCommand@", prgFlags = @SettingsHaskellCPPFlagsList@}} , tgtCCompilerLink = CcLink { ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} ===================================== hadrian/src/Context.hs ===================================== @@ -20,7 +20,6 @@ import Hadrian.Expression import Hadrian.Haskell.Cabal import Oracles.Setting import GHC.Toolchain.Target (Target(..)) -import Hadrian.Oracles.TextFile import GHC.Platform.ArchOS -- | Most targets are built only one way, hence the notion of 'vanillaContext'. ===================================== m4/ghc_toolchain.m4 ===================================== @@ -17,6 +17,15 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], fi ]) +AC_DEFUN([ENABLE_GHC_TOOLCHAIN_NOT_ARG], +[ + if test "$2" = "NO"; then + echo "--enable-$1" >> acargs + elif test "$2" = "YES"; then + echo "--disable-$1" >> acargs + fi +]) + AC_DEFUN([INVOKE_GHC_TOOLCHAIN], [ ( @@ -89,6 +98,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs echo "--dllwrap=$DllWrapCmd" >> acargs + ENABLE_GHC_TOOLCHAIN_NOT_ARG([locally-executable], [$CrossCompiling]) ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ===================================== m4/prep_target_file.m4 ===================================== @@ -52,6 +52,26 @@ AC_DEFUN([PREP_BOOLEAN],[ AC_SUBST([$1Bool]) ]) +# PREP_NOT_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [Not$1Bool] when $1 has NO/YES value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_NOT_BOOLEAN],[ + case "$$1" in + NO) + Not$1Bool=True + ;; + YES) + Not$1Bool=False + ;; + *) + AC_MSG_ERROR([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([Not$1Bool]) +]) + # PREP_LIST # ============ # @@ -103,6 +123,7 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_BOOLEAN([UseLibffiForAdjustors]) PREP_BOOLEAN([ArIsGNUAr]) PREP_BOOLEAN([ArNeedsRanLib]) + PREP_NOT_BOOLEAN([CrossCompiling]) PREP_LIST([SettingsMergeObjectsFlags]) PREP_LIST([ArArgs]) PREP_LIST([SettingsCCompilerLinkFlags]) ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Toolchain.Tools.Readelf data Opts = Opts { optTriple :: String , optTargetPrefix :: Maybe String + , optLocallyExecutable :: Maybe Bool , optLlvmTriple :: Maybe String , optOutput :: String , optCc :: ProgOpt @@ -59,6 +60,7 @@ emptyOpts :: Opts emptyOpts = Opts { optTriple = "" , optTargetPrefix = Nothing + , optLocallyExecutable = Nothing , optLlvmTriple = Nothing , optOutput = "" , optCc = po0 @@ -111,16 +113,11 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x}) _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) -_optUnregisterised :: Lens Opts (Maybe Bool) +_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool) +_optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x}) _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) - -_optTablesNextToCode :: Lens Opts (Maybe Bool) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) - -_optUseLibFFIForAdjustors :: Lens Opts (Maybe Bool) _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) - -_optLdOvveride :: Lens Opts (Maybe Bool) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) _optVerbosity :: Lens Opts Int @@ -143,6 +140,7 @@ options = , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode , enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride + , enableDisable "locally-executable" "A target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -191,6 +189,7 @@ options = targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX") "A target prefix which will be added to all tool names when searching for toolchain components" + verbosityOpt = Option ['v'] ["verbose"] (OptArg f "N") "set output verbosity" where f mb = set _optVerbosity (parseVerbosity mb) @@ -219,6 +218,7 @@ main = do Just prefix -> Just prefix Nothing -> Just $ optTriple opts ++ "-" , keepTemp = optKeepTemp opts + , canLocallyExecute = fromMaybe True (optLocallyExecutable opts) , logContexts = [] } r <- runM env (run opts) @@ -372,6 +372,7 @@ mkTarget opts = do let t = Target { tgtArchOs = archOs , tgtVendor + , tgtLocallyExecutable = fromMaybe True (optLocallyExecutable opts) , tgtCCompiler = cc , tgtCxxCompiler = cxx , tgtCPreprocessor = cpp ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -39,6 +39,7 @@ import System.IO hiding (readFile, writeFile, appendFile) data Env = Env { verbosity :: Int , targetPrefix :: Maybe String , keepTemp :: Bool + , canLocallyExecute :: Bool , logContexts :: [String] } @@ -122,4 +123,7 @@ ifCrossCompiling :: M a -- ^ what to do when cross-compiling -> M a -- ^ what to do otherwise -> M a -ifCrossCompiling cross other = other -- TODO +ifCrossCompiling cross other = do + canExec <- canLocallyExecute <$> getEnv + if not canExec then cross -- can't execute, this is a cross target + else other -- can execute, run the other action ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -42,7 +42,7 @@ data Target = Target { -- Platform tgtArchOs :: ArchOS , tgtVendor :: Maybe String - -- , tgtHostCanExecute :: Bool -- TODO: Rename hostCanExecute? We might need this to determine whether or not we can execute a program when configuring it + , tgtLocallyExecutable :: Bool , tgtSupportsGnuNonexecStack :: Bool , tgtSupportsSubsectionsViaSymbols :: Bool , tgtSupportsIdentDirective :: Bool @@ -79,6 +79,7 @@ instance Show Target where [ "Target" , "{ tgtArchOs = " ++ show tgtArchOs , ", tgtVendor = " ++ show tgtVendor + , ", tgtLocallyExecutable = " ++ show tgtLocallyExecutable , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e6ffc7fb6460ecedc7b4378cca2116ae160a03f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e6ffc7fb6460ecedc7b4378cca2116ae160a03f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 11:59:45 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 07:59:45 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Try to add locally-executable arg Message-ID: <64abf2b151f9b_1926c0b1378254123@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 2554fd24 by Rodrigo Mesquita at 2023-07-10T12:59:35+01:00 Try to add locally-executable arg - - - - - 7 changed files: - default.target.in - hadrian/src/Context.hs - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== default.target.in ===================================== @@ -1,6 +1,7 @@ Target { tgtArchOs = ArchOS {archOS_arch = @HaskellTargetArch@, archOS_OS = @HaskellTargetOs@} , tgtVendor = @TargetVendor_CPPMaybeStr@ +, tgtLocallyExecutable = @NotCrossCompilingBool@ , tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ , tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ , tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ @@ -11,9 +12,9 @@ Target , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ -, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @CFLAGSList@}} -, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @CXXFLAGSList@}} -, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @CPPFLAGSList@}} +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @SettingsCPPFlagsList@}} , tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@SettingsHaskellCPPCommand@", prgFlags = @SettingsHaskellCPPFlagsList@}} , tgtCCompilerLink = CcLink { ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} ===================================== hadrian/src/Context.hs ===================================== @@ -20,7 +20,6 @@ import Hadrian.Expression import Hadrian.Haskell.Cabal import Oracles.Setting import GHC.Toolchain.Target (Target(..)) -import Hadrian.Oracles.TextFile import GHC.Platform.ArchOS -- | Most targets are built only one way, hence the notion of 'vanillaContext'. ===================================== m4/ghc_toolchain.m4 ===================================== @@ -17,6 +17,15 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], fi ]) +AC_DEFUN([ENABLE_GHC_TOOLCHAIN_NOT_ARG], +[ + if test "$2" = "NO"; then + echo "--enable-$1" >> acargs + elif test "$2" = "YES"; then + echo "--disable-$1" >> acargs + fi +]) + AC_DEFUN([INVOKE_GHC_TOOLCHAIN], [ ( @@ -89,6 +98,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs echo "--dllwrap=$DllWrapCmd" >> acargs + ENABLE_GHC_TOOLCHAIN_NOT_ARG([locally-executable], [$CrossCompiling]) ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ===================================== m4/prep_target_file.m4 ===================================== @@ -52,6 +52,26 @@ AC_DEFUN([PREP_BOOLEAN],[ AC_SUBST([$1Bool]) ]) +# PREP_NOT_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [Not$1Bool] when $1 has NO/YES value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_NOT_BOOLEAN],[ + case "$$1" in + NO) + Not$1Bool=True + ;; + YES) + Not$1Bool=False + ;; + *) + AC_MSG_ERROR([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([Not$1Bool]) +]) + # PREP_LIST # ============ # @@ -103,16 +123,17 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_BOOLEAN([UseLibffiForAdjustors]) PREP_BOOLEAN([ArIsGNUAr]) PREP_BOOLEAN([ArNeedsRanLib]) + PREP_NOT_BOOLEAN([CrossCompiling]) PREP_LIST([SettingsMergeObjectsFlags]) PREP_LIST([ArArgs]) PREP_LIST([SettingsCCompilerLinkFlags]) PREP_LIST([SettingsHaskellCPPFlags]) - PREP_LIST([CPPFLAGS]) - PREP_LIST([CXXFLAGS]) - PREP_LIST([CFLAGS]) PREP_MAYBE_SIMPLE_PROGRAM([DllWrapCmd]) PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) PREP_MAYBE_STRING([TargetVendor_CPP]) + PREP_LIST([SettingsCPPFlags]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) dnl PREP_ENDIANNESS case "$TargetWordBigEndian" in ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Toolchain.Tools.Readelf data Opts = Opts { optTriple :: String , optTargetPrefix :: Maybe String + , optLocallyExecutable :: Maybe Bool , optLlvmTriple :: Maybe String , optOutput :: String , optCc :: ProgOpt @@ -59,6 +60,7 @@ emptyOpts :: Opts emptyOpts = Opts { optTriple = "" , optTargetPrefix = Nothing + , optLocallyExecutable = Nothing , optLlvmTriple = Nothing , optOutput = "" , optCc = po0 @@ -111,16 +113,11 @@ _optOutput = Lens optOutput (\x o -> o {optOutput=x}) _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) -_optUnregisterised :: Lens Opts (Maybe Bool) +_optLocallyExecutable, _optUnregisterised, _optTablesNextToCode, _optUseLibFFIForAdjustors, _optLdOvveride :: Lens Opts (Maybe Bool) +_optLocallyExecutable = Lens optLocallyExecutable (\x o -> o {optLocallyExecutable=x}) _optUnregisterised = Lens optUnregisterised (\x o -> o {optUnregisterised=x}) - -_optTablesNextToCode :: Lens Opts (Maybe Bool) _optTablesNextToCode = Lens optTablesNextToCode (\x o -> o {optTablesNextToCode=x}) - -_optUseLibFFIForAdjustors :: Lens Opts (Maybe Bool) _optUseLibFFIForAdjustors = Lens optUseLibFFIForAdjustors (\x o -> o {optUseLibFFIForAdjustors=x}) - -_optLdOvveride :: Lens Opts (Maybe Bool) _optLdOvveride = Lens optLdOverride (\x o -> o {optLdOverride=x}) _optVerbosity :: Lens Opts Int @@ -143,6 +140,7 @@ options = , enableDisable "tables-next-to-code" "Tables-next-to-code optimisation" _optTablesNextToCode , enableDisable "libffi-adjustors" "Force use of libffi for adjustors, even on platforms which have support for more efficient, native adjustors." _optUseLibFFIForAdjustors , enableDisable "ld-override" "override gcc's default linker" _optLdOvveride + , enableDisable "locally-executable" "A target prefix which will be added to all tool names when searching for toolchain components" _optLocallyExecutable ] ++ concat [ progOpts "cc" "C compiler" _optCc @@ -191,6 +189,7 @@ options = targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX") "A target prefix which will be added to all tool names when searching for toolchain components" + verbosityOpt = Option ['v'] ["verbose"] (OptArg f "N") "set output verbosity" where f mb = set _optVerbosity (parseVerbosity mb) @@ -219,6 +218,7 @@ main = do Just prefix -> Just prefix Nothing -> Just $ optTriple opts ++ "-" , keepTemp = optKeepTemp opts + , canLocallyExecute = fromMaybe True (optLocallyExecutable opts) , logContexts = [] } r <- runM env (run opts) @@ -372,6 +372,7 @@ mkTarget opts = do let t = Target { tgtArchOs = archOs , tgtVendor + , tgtLocallyExecutable = fromMaybe True (optLocallyExecutable opts) , tgtCCompiler = cc , tgtCxxCompiler = cxx , tgtCPreprocessor = cpp ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -39,6 +39,7 @@ import System.IO hiding (readFile, writeFile, appendFile) data Env = Env { verbosity :: Int , targetPrefix :: Maybe String , keepTemp :: Bool + , canLocallyExecute :: Bool , logContexts :: [String] } @@ -122,4 +123,7 @@ ifCrossCompiling :: M a -- ^ what to do when cross-compiling -> M a -- ^ what to do otherwise -> M a -ifCrossCompiling cross other = other -- TODO +ifCrossCompiling cross other = do + canExec <- canLocallyExecute <$> getEnv + if not canExec then cross -- can't execute, this is a cross target + else other -- can execute, run the other action ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -42,7 +42,7 @@ data Target = Target { -- Platform tgtArchOs :: ArchOS , tgtVendor :: Maybe String - -- , tgtHostCanExecute :: Bool -- TODO: Rename hostCanExecute? We might need this to determine whether or not we can execute a program when configuring it + , tgtLocallyExecutable :: Bool , tgtSupportsGnuNonexecStack :: Bool , tgtSupportsSubsectionsViaSymbols :: Bool , tgtSupportsIdentDirective :: Bool @@ -79,6 +79,7 @@ instance Show Target where [ "Target" , "{ tgtArchOs = " ++ show tgtArchOs , ", tgtVendor = " ++ show tgtVendor + , ", tgtLocallyExecutable = " ++ show tgtLocallyExecutable , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2554fd247305874d0a747d1b27b5987ccf934a56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2554fd247305874d0a747d1b27b5987ccf934a56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 12:06:26 2023 From: gitlab at gitlab.haskell.org (Berk Ozkutuk (@ozkutuk)) Date: Mon, 10 Jul 2023 08:06:26 -0400 Subject: [Git][ghc/ghc][wip/ozkutuk/sprint-fun] 150 commits: Report scoped kind variables at the type-checking phase (#16635) Message-ID: <64abf442162e3_1926c0b133c2550b8@gitlab.mail> Berk Ozkutuk pushed to branch wip/ozkutuk/sprint-fun at Glasgow Haskell Compiler / GHC Commits: 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - c8c7d915 by Berk Ozkutuk at 2023-07-09T14:45:31+02:00 Disambiguate closures' printing from thunks (#23507) - - - - - da7761fe by Berk Ozkutuk at 2023-07-09T16:59:17+02:00 Only print function closures - - - - - 23 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/ByteCode/Asm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d3f1d67fdfd157826715eea83e163581d4449da...da7761fec9f99abc42b60f5b7012e8a1e470d12a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d3f1d67fdfd157826715eea83e163581d4449da...da7761fec9f99abc42b60f5b7012e8a1e470d12a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 12:25:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 10 Jul 2023 08:25:29 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 7 commits: Define FFI_GO_CLOSURES Message-ID: <64abf8b9364c6_1926c04eaf3a4257523@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 6d5c0112 by Ben Gamari at 2023-07-10T08:23:45-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files (cherry picked from commit 8b35e8caafeeccbf06b7faa70e807028a3f0ff43) - - - - - 0c763c3b by Ben Gamari at 2023-07-10T08:23:54-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. (cherry picked from commit d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8) - - - - - b92f2660 by Ben Gamari at 2023-07-10T08:24:02-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. (cherry picked from commit 7c7d1f66d35f73a2faa898a33aa80cd276159dc2) - - - - - 1b2af02d by Ben Gamari at 2023-07-10T08:24:07-04:00 rts: Various warnings fixes (cherry picked from commit cb92051e3d85575ff6abd753c9b135930cc50cf8) - - - - - e90c114d by Ben Gamari at 2023-07-10T08:24:17-04:00 hadrian: Ignore warnings in unix and semaphore-compat (cherry picked from commit dec81dd1fd0475dde4929baae625d155387300bb) - - - - - 63c05986 by Matthew Pickering at 2023-07-10T08:24:21-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 (cherry picked from commit d7f6448aa06bbf26173a06ee5c624f5b734786c5) - - - - - 80211b50 by Ben Gamari at 2023-07-10T08:24:31-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. (cherry picked from commit fd8c57694a00f6359bd66365f1284388c869ac60) - - - - - 17 changed files: - compiler/GHC/Driver/CodeOutput.hs - hadrian/src/Flavour.hs - hadrian/src/Rules/Documentation.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/Schedule.c - rts/Sparks.c - rts/Trace.h - rts/TraverseHeap.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Storage.c Changes: ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -295,7 +295,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | platformMisc_libFFI $ platformMisc dflags = "#include \n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"rts/ghc_ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== hadrian/src/Flavour.hs ===================================== @@ -128,9 +128,13 @@ werror = ? notStage0 ? mconcat [ arg "-Werror" - , flag CrossCompiling - ? package unix + -- unix has many unused imports + , package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] + -- semaphore-compat relies on sem_getvalue as provided by unix, which is + -- not implemented on Darwin and therefore throws a deprecation warning + , package semaphoreCompat + ? mconcat [arg "-Wwarn=deprecations"] ] , builder Ghc ? package rts ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -258,6 +258,15 @@ buildPackageDocumentation = do need [ takeDirectory file -/- "haddock-prologue.txt"] haddocks <- haddockDependencies context + -- Build Haddock documentation + -- TODO: Pass the correct way from Rules via Context. + dynamicPrograms <- dynamicGhcPrograms =<< flavour + let haddockWay = if dynamicPrograms then dynamic else vanilla + + -- Build the dependencies of the package we are going to build documentation for + dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p}) + | (p, _) <- haddocks] + -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just -- for Haddock. We need to 'union' (instead of '++') to avoid passing -- 'GHC.PrimopWrappers' (which unfortunately shows up in both @@ -266,12 +275,8 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ (map snd haddocks) + need $ srcs ++ (map snd haddocks) ++ dep_pkgs - -- Build Haddock documentation - -- TODO: Pass the correct way from Rules via Context. - dynamicPrograms <- dynamicGhcPrograms =<< flavour - let haddockWay = if dynamicPrograms then dynamic else vanilla statsFilesDir <- haddockStatsFilesDir createDirectory statsFilesDir build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file] ===================================== libraries/base/include/HsBase.h ===================================== @@ -540,7 +540,7 @@ INLINE int __hscore_open(char *file, int how, mode_t mode) { } #endif -#if darwin_HOST_OS +#if defined(darwin_HOST_OS) // You should not access _environ directly on Darwin in a bundle/shared library. // See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html #include ===================================== libraries/ghci/GHCi/FFI.hsc ===================================== @@ -22,6 +22,14 @@ -} #if !defined(javascript_HOST_ARCH) +-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h +-- We can't include ghc_ffi.h here as we must build with stage0 +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + #include #endif ===================================== rts/Interpreter.c ===================================== @@ -39,7 +39,7 @@ #endif #endif -#include "ffi.h" +#include "rts/ghc_ffi.h" /* -------------------------------------------------------------------------- * The bytecode interpreter ===================================== rts/Schedule.c ===================================== @@ -1160,9 +1160,11 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t ) barf("allocation of %ld bytes too large (GHC should have complained at compile-time)", (long)cap->r.rHpAlloc); } +#if defined(DEBUG) debugTrace(DEBUG_sched, "--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n", (long)t->id, what_next_strs[t->what_next], blocks); +#endif // don't do this if the nursery is (nearly) full, we'll GC first. if (cap->r.rCurrentNursery->link != NULL || @@ -1231,9 +1233,11 @@ scheduleHandleYield( Capability *cap, StgTSO *t, uint32_t prev_what_next ) // Shortcut if we're just switching evaluators: just run the thread. See // Note [avoiding threadPaused] in Interpreter.c. if (t->what_next != prev_what_next) { +#if defined(DEBUG) debugTrace(DEBUG_sched, "--<< thread %ld (%s) stopped to switch evaluators", (long)t->id, what_next_strs[t->what_next]); +#endif return true; } @@ -1806,7 +1810,7 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, } } } - debugTrace(DEBUG_sched, "%d idle caps", n_idle_caps); + debugTrace(DEBUG_sched, "%d idle caps, %d failed grabs", n_idle_caps, n_failed_trygrab_idles); for (i=0; i < n_capabilities; i++) { NONATOMIC_ADD(&getCapability(i)->idle, 1); @@ -2643,7 +2647,6 @@ void scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) { Task *task; - DEBUG_ONLY( StgThreadID id ); Capability *cap; cap = *pcap; @@ -2662,8 +2665,9 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) appendToRunQueue(cap,tso); - DEBUG_ONLY( id = tso->id ); - debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", id); + DEBUG_ONLY( + debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", (StgThreadID) tso->id); + ); // As the TSO is bound and on the run queue, schedule() will run the TSO. cap = schedule(cap,task); @@ -2671,7 +2675,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) ASSERT(task->incall->rstat != NoStatus); ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task); - debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", id); + debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", (StgThreadID) tso->id); *pcap = cap; } @@ -2793,9 +2797,6 @@ exitScheduler (bool wait_foreign USED_IF_THREADS) shutdownCapabilities(task, wait_foreign); - // debugBelch("n_failed_trygrab_idles = %d, n_idle_caps = %d\n", - // n_failed_trygrab_idles, n_idle_caps); - exitMyTask(); } ===================================== rts/Sparks.c ===================================== @@ -119,11 +119,10 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) { SparkPool *pool; StgClosurePtr spark, tmp, *elements; - uint32_t n, pruned_sparks; // stats only + uint32_t pruned_sparks; // stats only StgInt botInd,oldBotInd,currInd; // indices in array (always < size) const StgInfoTable *info; - n = 0; pruned_sparks = 0; pool = cap->sparks; @@ -217,7 +216,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) if (closure_SHOULD_SPARK(tmp)) { elements[botInd] = tmp; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; @@ -247,7 +245,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) if (closure_SHOULD_SPARK(spark)) { elements[botInd] = spark; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; @@ -265,7 +262,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) // isAlive() also ignores static closures (see GCAux.c) elements[botInd] = spark; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; ===================================== rts/Trace.h ===================================== @@ -235,26 +235,25 @@ void traceThreadLabel_(Capability *cap, char *label, size_t len); + +#if defined(DEBUG) +#define DEBUG_RTS 1 +#else +#define DEBUG_RTS 0 +#endif + /* * Emit a debug message (only when DEBUG is defined) */ -#if defined(DEBUG) #define debugTrace(class, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ + if (DEBUG_RTS && RTS_UNLIKELY(class)) { \ trace_(msg, ##__VA_ARGS__); \ } -#else -#define debugTrace(class, str, ...) /* nothing */ -#endif -#if defined(DEBUG) -#define debugTraceCap(class, cap, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ +#define debugTraceCap(class, cap, msg, ...) \ + if (DEBUG_RTS && RTS_UNLIKELY(class)) { \ traceCap_(cap, msg, ##__VA_ARGS__); \ } -#else -#define debugTraceCap(class, cap, str, ...) /* nothing */ -#endif /* * Emit a message/event describing the state of a thread ===================================== rts/TraverseHeap.c ===================================== @@ -48,7 +48,7 @@ static void debug(const char *s, ...) va_end(ap); } #else -#define debug(...) +static void debug(const char *s STG_UNUSED, ...) {} #endif // number of blocks allocated for one stack ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -11,7 +11,7 @@ #include "Hash.h" #include "Adjustor.h" -#include "ffi.h" +#include "rts/ghc_ffi.h" #include // Note that ffi_alloc_prep_closure is a non-standard libffi closure ===================================== rts/include/rts/ghc_ffi.h ===================================== @@ -0,0 +1,28 @@ +/* + * wrapper working around #23586. + * + * (c) The University of Glasgow 2023 + * + */ + +#pragma once + +/* + * Note [FFI_GO_CLOSURES workaround] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Apple ships a broken libffi with Xcode which lacks a definition of + * FFI_GO_CLOSURES despite having references to said macro. Work around this + * for now to avoid -Wundef warnings. + * + * We choose the value zero here by following the model of OpenJDK. + * See https://github.com/openjdk/jdk17u-dev/pull/741/files. + * + * See #23568. + */ +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + +#include "ffi.h" ===================================== rts/rts.cabal.in ===================================== @@ -237,6 +237,7 @@ library rts/EventLogConstants.h rts/EventTypes.h -- ^ generated + rts/ghc_ffi.h rts/Adjustor.h rts/ExecPage.h rts/BlockSignals.h ===================================== rts/sm/GC.c ===================================== @@ -691,6 +691,7 @@ GarbageCollect (struct GcConfig config, } copied += mut_list_size; +#if defined(DEBUG) debugTrace(DEBUG_gc, "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d TVARs, %d TVAR_WATCH_QUEUEs, %d TREC_CHUNKs, %d TREC_HEADERs, %d others)", (unsigned long)(mut_list_size * sizeof(W_)), @@ -702,6 +703,7 @@ GarbageCollect (struct GcConfig config, mutlist_scav_stats.n_TREC_CHUNK, mutlist_scav_stats.n_TREC_HEADER, mutlist_scav_stats.n_OTHERS); +#endif } bdescr *next, *prev; ===================================== rts/sm/NonMoving.c ===================================== @@ -901,14 +901,12 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // updated their snapshot pointers and move them to the sweep list. for (int alloca_idx = 0; alloca_idx < NONMOVING_ALLOCA_CNT; ++alloca_idx) { struct NonmovingSegment *filled = nonmovingHeap.allocators[alloca_idx].saved_filled; - uint32_t n_filled = 0; if (filled) { struct NonmovingSegment *seg = filled; while (true) { // Set snapshot nonmovingSegmentInfo(seg)->next_free_snap = seg->next_free; SET_SEGMENT_STATE(seg, FILLED_SWEEPING); - n_filled++; if (seg->link) { seg = seg->link; } else { @@ -1161,24 +1159,20 @@ void assert_in_nonmoving_heap(StgPtr p) } // Search active segments - int seg_idx = 0; struct NonmovingSegment *seg = alloca->active; while (seg) { if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } - seg_idx++; seg = seg->link; } // Search filled segments - seg_idx = 0; seg = alloca->filled; while (seg) { if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } - seg_idx++; seg = seg->link; } } ===================================== rts/sm/NonMovingMark.c ===================================== @@ -268,7 +268,7 @@ void nonmovingMarkInit(void) { #endif } -#if defined(THREADED_RTS) && defined(DEBUG) +#if defined(THREADED_RTS) static uint32_t markQueueLength(MarkQueue *q); #endif static void init_mark_queue_(MarkQueue *queue); @@ -985,7 +985,7 @@ void freeMarkQueue (MarkQueue *queue) freeChain_lock(queue->blocks); } -#if defined(THREADED_RTS) && defined(DEBUG) +#if defined(THREADED_RTS) static uint32_t markQueueLength (MarkQueue *q) { ===================================== rts/sm/Storage.c ===================================== @@ -53,7 +53,7 @@ #include -#include "ffi.h" +#include "rts/ghc_ffi.h" /* * All these globals require sm_mutex to access in THREADED_RTS mode. @@ -1231,6 +1231,74 @@ allocateMightFail (Capability *cap, W_ n) */ #define MEMSET_SLOP_W(p, val, len_w) memset(p, val, (len_w) * sizeof(W_)) +/** + * Finish the capability's current pinned object accumulator block + * (cap->pinned_object_block), if any, and start a new one. + */ +static bdescr * +start_new_pinned_block(Capability *cap) +{ + bdescr *bd = cap->pinned_object_block; + + // stash the old block on cap->pinned_object_blocks. On the + // next GC cycle these objects will be moved to + // g0->large_objects. + if (bd != NULL) { + // add it to the allocation stats when the block is full + finishedNurseryBlock(cap, bd); + dbl_link_onto(bd, &cap->pinned_object_blocks); + } + + // We need to find another block. We could just allocate one, + // but that means taking a global lock and we really want to + // avoid that (benchmarks that allocate a lot of pinned + // objects scale really badly if we do this). + // + // See Note [Sources of Block Level Fragmentation] + // for a more complete history of this section. + bd = cap->pinned_object_empty; + if (bd == NULL) { + // The pinned block list is empty: allocate a fresh block (we can't fail + // here). + ACQUIRE_SM_LOCK; + bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE); + RELEASE_SM_LOCK; + } + + // Bump up the nursery pointer to avoid the pathological situation + // where a program is *only* allocating pinned objects. + // T4018 fails without this safety. + // This has the effect of counting a full pinned block in the same way + // as a full nursery block, so GCs will be triggered at the same interval + // if you are only allocating pinned data compared to normal allocations + // via allocate(). + bdescr *nbd = cap->r.rCurrentNursery->link; + if (nbd != NULL){ + newNurseryBlock(nbd); + cap->r.rCurrentNursery->link = nbd->link; + if (nbd->link != NULL) { + nbd->link->u.back = cap->r.rCurrentNursery; + } + dbl_link_onto(nbd, &cap->r.rNursery->blocks); + // Important for accounting purposes + if (cap->r.rCurrentAlloc){ + finishedNurseryBlock(cap, cap->r.rCurrentAlloc); + } + cap->r.rCurrentAlloc = nbd; + } + + cap->pinned_object_empty = bd->link; + newNurseryBlock(bd); + if (bd->link != NULL) { + bd->link->u.back = cap->pinned_object_empty; + } + initBdescr(bd, g0, g0); + + cap->pinned_object_block = bd; + bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED; + return bd; +} + /* --------------------------------------------------------------------------- Allocate a fixed/pinned object. @@ -1258,135 +1326,76 @@ allocateMightFail (Capability *cap, W_ n) StgPtr allocatePinned (Capability *cap, W_ n /*words*/, W_ alignment /*bytes*/, W_ align_off /*bytes*/) { - StgPtr p; - bdescr *bd; - // Alignment and offset have to be a power of two - ASSERT(alignment && !(alignment & (alignment - 1))); - ASSERT(alignment >= sizeof(W_)); - - ASSERT(!(align_off & (align_off - 1))); + CHECK(alignment && !(alignment & (alignment - 1))); + CHECK(!(align_off & (align_off - 1))); + // We don't support sub-word alignments + CHECK(alignment >= sizeof(W_)); + + bdescr *bd = cap->pinned_object_block; + if (bd == NULL) { + bd = start_new_pinned_block(cap); + } const StgWord alignment_w = alignment / sizeof(W_); + W_ off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + + // If the request is is smaller than LARGE_OBJECT_THRESHOLD then + // allocate into the pinned object accumulator. + if (n + off_w < LARGE_OBJECT_THRESHOLD/sizeof(W_)) { + // If the current pinned object block isn't large enough to hold the new + // object, get a new one. + if ((bd->free + off_w + n) > (bd->start + BLOCK_SIZE_W)) { + bd = start_new_pinned_block(cap); + + // The pinned_object_block remains attached to the capability + // until it is full, even if a GC occurs. We want this + // behaviour because otherwise the unallocated portion of the + // block would be forever slop, and under certain workloads + // (allocating a few ByteStrings per GC) we accumulate a lot + // of slop. + // + // So, the pinned_object_block is initially marked + // BF_EVACUATED so the GC won't touch it. When it is full, + // we place it on the large_objects list, and at the start of + // the next GC the BF_EVACUATED flag will be cleared, and the + // block will be promoted as usual (if anything in it is + // live). + + off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + } - // If the request is for a large object, then allocate() - // will give us a pinned object anyway. - if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - // For large objects we don't bother optimizing the number of words - // allocated for alignment reasons. Here we just allocate the maximum - // number of extra words we could possibly need to satisfy the alignment - // constraint. - p = allocateMightFail(cap, n + alignment_w - 1); - if (p == NULL) { - return NULL; - } else { - Bdescr(p)->flags |= BF_PINNED; - W_ off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); + // N.B. it is important that we account for the alignment padding + // when determining large-object-ness, lest we may over-fill the + // block. See #23400. + if (n + off_w < LARGE_OBJECT_THRESHOLD/sizeof(W_)) { + StgPtr p = bd->free; MEMSET_SLOP_W(p, 0, off_w); + n += off_w; p += off_w; - MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); + bd->free += n; + ASSERT(bd->free <= bd->start + bd->blocks * BLOCK_SIZE_W); + accountAllocation(cap, n); return p; } } - bd = cap->pinned_object_block; - - W_ off_w = 0; - - if(bd) - off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); - - // If we don't have a block of pinned objects yet, or the current - // one isn't large enough to hold the new object, get a new one. - if (bd == NULL || (bd->free + off_w + n) > (bd->start + BLOCK_SIZE_W)) { - - // stash the old block on cap->pinned_object_blocks. On the - // next GC cycle these objects will be moved to - // g0->large_objects. - if (bd != NULL) { - // add it to the allocation stats when the block is full - finishedNurseryBlock(cap, bd); - dbl_link_onto(bd, &cap->pinned_object_blocks); - } - - // We need to find another block. We could just allocate one, - // but that means taking a global lock and we really want to - // avoid that (benchmarks that allocate a lot of pinned - // objects scale really badly if we do this). - // - // See Note [Sources of Block Level Fragmentation] - // for a more complete history of this section. - bd = cap->pinned_object_empty; - if (bd == NULL) { - // The pinned block list is empty: allocate a fresh block (we can't fail - // here). - ACQUIRE_SM_LOCK; - bd = allocNursery(cap->node, NULL, PINNED_EMPTY_SIZE); - RELEASE_SM_LOCK; - } - - // Bump up the nursery pointer to avoid the pathological situation - // where a program is *only* allocating pinned objects. - // T4018 fails without this safety. - // This has the effect of counting a full pinned block in the same way - // as a full nursery block, so GCs will be triggered at the same interval - // if you are only allocating pinned data compared to normal allocations - // via allocate(). - bdescr * nbd; - nbd = cap->r.rCurrentNursery->link; - if (nbd != NULL){ - newNurseryBlock(nbd); - cap->r.rCurrentNursery->link = nbd->link; - if (nbd->link != NULL) { - nbd->link->u.back = cap->r.rCurrentNursery; - } - dbl_link_onto(nbd, &cap->r.rNursery->blocks); - // Important for accounting purposes - if (cap->r.rCurrentAlloc){ - finishedNurseryBlock(cap, cap->r.rCurrentAlloc); - } - cap->r.rCurrentAlloc = nbd; - } - - - cap->pinned_object_empty = bd->link; - newNurseryBlock(bd); - if (bd->link != NULL) { - bd->link->u.back = cap->pinned_object_empty; - } - initBdescr(bd, g0, g0); - - cap->pinned_object_block = bd; - bd->flags = BF_PINNED | BF_LARGE | BF_EVACUATED; - - // The pinned_object_block remains attached to the capability - // until it is full, even if a GC occurs. We want this - // behaviour because otherwise the unallocated portion of the - // block would be forever slop, and under certain workloads - // (allocating a few ByteStrings per GC) we accumulate a lot - // of slop. - // - // So, the pinned_object_block is initially marked - // BF_EVACUATED so the GC won't touch it. When it is full, - // we place it on the large_objects list, and at the start of - // the next GC the BF_EVACUATED flag will be cleared, and the - // block will be promoted as usual (if anything in it is - // live). - - off_w = ALIGN_WITH_OFF_W(bd->free, alignment, align_off); + // Otherwise handle the request as a large object + // For large objects we don't bother optimizing the number of words + // allocated for alignment reasons. Here we just allocate the maximum + // number of extra words we could possibly need to satisfy the alignment + // constraint. + StgPtr p = allocateMightFail(cap, n + alignment_w - 1); + if (p == NULL) { + return NULL; + } else { + Bdescr(p)->flags |= BF_PINNED; + off_w = ALIGN_WITH_OFF_W(p, alignment, align_off); + MEMSET_SLOP_W(p, 0, off_w); + p += off_w; + MEMSET_SLOP_W(p + n, 0, alignment_w - off_w - 1); + return p; } - - p = bd->free; - - MEMSET_SLOP_W(p, 0, off_w); - - n += off_w; - p += off_w; - bd->free += n; - - accountAllocation(cap, n); - - return p; } /* ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b61479aa3861b3b5337ef0eda5c197f5e817abd...80211b508b3b7e1973fbb1d8425acd23d6bd4d07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b61479aa3861b3b5337ef0eda5c197f5e817abd...80211b508b3b7e1973fbb1d8425acd23d6bd4d07 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 12:26:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 10 Jul 2023 08:26:05 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 9 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64abf8dd776b5_1926c0b138c25793d@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: eccd6eae by Luite Stegeman at 2023-07-10T08:25:46-04:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 (cherry picked from commit 564164ef323a9f2cdeb8c69dcb2cf6df6382de4e) - - - - - 35c054f9 by Torsten Schmits at 2023-07-10T08:25:46-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 (cherry picked from commit 40f4ef7c40e747dfea491d297475458d2ccaf860) - - - - - 8d7a92d0 by Torsten Schmits at 2023-07-10T08:25:46-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 (cherry picked from commit 6fdcf969db85f3fe64123ba150e9226a0d2995cd) - - - - - dc5dae84 by Ben Bellick at 2023-07-10T08:25:46-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure (cherry picked from commit 03f941f45607a5ee52ca53a358333bbb41ddb1bc) - - - - - ae239cd4 by aadaa_fgtaa at 2023-07-10T08:25:46-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts (cherry picked from commit b3e1436f968c0c36a27ea0339ee2554970b329fe) - - - - - 5bedded5 by Moisés Ackerman at 2023-07-10T08:25:46-04:00 Add failing test case for #23492 (cherry picked from commit 6074cc3cda9b9836c784942a1aa7f766fb142787) - - - - - ac1b59f3 by Moisés Ackerman at 2023-07-10T08:25:46-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. (cherry picked from commit 356a269258a50bf67811fe0edb193fc9f82dfad1) - - - - - 31d4a4d6 by Moisés Ackerman at 2023-07-10T08:25:47-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils (cherry picked from commit 3efe7f399a53ec7930c8a333ad2c114d956f0c2a) - - - - - 31632aee by Moisés Ackerman at 2023-07-10T08:25:47-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors (cherry picked from commit dd782343f131cfd983a7fb2431d9d4a9ae497551) - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - rts/Disassembler.c - rts/Interpreter.c - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/deriving/should_fail/T8165_fail2.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80211b508b3b7e1973fbb1d8425acd23d6bd4d07...31632aee2825dbbbc3410ad60e6cc1e71c6732f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80211b508b3b7e1973fbb1d8425acd23d6bd4d07...31632aee2825dbbbc3410ad60e6cc1e71c6732f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 13:03:44 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 09:03:44 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: New host.target Message-ID: <64ac01b083ee0_1926c0b1378259947@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1bde6995 by Rodrigo Mesquita at 2023-07-10T13:19:15+01:00 New host.target - - - - - 4aafc880 by Rodrigo Mesquita at 2023-07-10T13:56:32+01:00 Try to parse the undefined fields - - - - - bc625fac by Rodrigo Mesquita at 2023-07-10T14:03:36+01:00 Configure Host toolchain with dummy options, hope they aren't used - - - - - 9 changed files: - configure.ac - + default.host.target.in - distrib/configure.ac.in - hadrian/src/Base.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Rules/BinaryDist.hs - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== configure.ac ===================================== @@ -1184,6 +1184,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.host.target default.target ]) @@ -1298,5 +1299,6 @@ For more information on how to configure your GHC build, see https://gitlab.haskell.org/ghc/ghc/wikis/building "] -VALIDATE_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.ghc-toolchain.host.target]) +VALIDATE_GHC_TOOLCHAIN([default.target],[default.ghc-toolchain.target]) ===================================== default.host.target.in ===================================== @@ -0,0 +1,40 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellTargetOs@} +, tgtVendor = @HostVendor_CPPMaybeStr@ +, tgtLocallyExecutable = True +, tgtSupportsGnuNonexecStack = False +, tgtSupportsSubsectionsViaSymbols = False +, tgtSupportsIdentDirective = False +, tgtWordSize = WS8 +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = False +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = False +, tgtTablesNextToCode = True +, tgtUseLibffiForAdjustors = True +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @SettingsHaskellCPPFlagsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_GCC_LINKER_OPTS_STAGE0List@} +, ccLinkSupportsNoPie = False +, ccLinkSupportsCompactUnwind = False +, ccLinkSupportsFilelist = False +, ccLinkIsGnu = False +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR_STAGE0@", prgFlags = @AR_OPTS_STAGE0List@} +, arIsGnu = False +, arSupportsAtFile = @ArSupportsAtFile_STAGE0Bool@ +, arSupportsDashL = @ArSupportsDashL_STAGE0Bool@ +, arNeedsRanlib = False +} + +, tgtRanlib = Nothing +, tgtNm = Nm {nmProgram = Program {prgPath = "@NM@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = []}) +, tgtDllwrap = @DllWrapCmdMaybeProg@ +, tgtWindres = @WindresCmdMaybeProg@ +} ===================================== distrib/configure.ac.in ===================================== @@ -287,6 +287,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS AC_CONFIG_FILES([config.mk]) +AC_CONFIG_FILES([default.host.target]) AC_CONFIG_FILES([default.target]) AC_OUTPUT @@ -312,7 +313,8 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE FIND_GHC_TOOLCHAIN -VALIDATE_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.ghc-toolchain.host.target]) +VALIDATE_GHC_TOOLCHAIN([default.target],[default.ghc-toolchain.target]) echo "****************************************************" echo "Configuration done, ready to 'make install'" ===================================== hadrian/src/Base.hs ===================================== @@ -83,12 +83,12 @@ configFile = configPath -/- "system.config" -- | The target configuration file generated by ghc-toolchain for the -- compilation build platform buildTargetFile :: FilePath -buildTargetFile = "default.ghc-toolchain.host.target" -- ROMES:TODO: Not hardcode this value? +buildTargetFile = "default.host.target" -- ROMES:TODO: Not hardcode this value? -- | The target configuration file generated by ghc-toolchain for the -- compilation host platform hostTargetFile :: FilePath -hostTargetFile = "default.ghc-toolchain.host.target" -- ROMES:TODO: Not hardcode this value? +hostTargetFile = "default.host.target" -- ROMES:TODO: Not hardcode this value? -- | The target configuration file generated by ghc-toolchain for the -- compilation target platform ===================================== hadrian/src/Hadrian/Oracles/TextFile.hs ===================================== @@ -27,6 +27,7 @@ import Development.Shake import Development.Shake.Classes import Development.Shake.Config import Base +import Text.Read (readMaybe) import qualified GHC.Toolchain.Target as Toolchain @@ -157,8 +158,10 @@ textFileOracle = do tf <- newCache $ \file -> do need [file] putVerbose $ "| TargetFile oracle: reading " ++ quote file ++ "..." - target <- read <$> readFile' file - return (target :: Toolchain.Target) + mtarget <- readMaybe <$> readFile' file + case mtarget of + Nothing -> error $ "Failed to read a Toolchain.Target from " ++ quote file + Just target -> return (target :: Toolchain.Target) void $ addOracleCache $ \(TargetFile file) -> tf file -- Orphan instances for (ShakeValue Toolchain.Target) ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -259,6 +259,7 @@ bindistRules = do (["configure", "Makefile"] ++ bindistInstallFiles) copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") copyFile ("default.target.in") (bindistFilesDir -/- "default.target.in") + copyFile ("default.host.target.in") (bindistFilesDir -/- "default.host.target.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do ===================================== m4/ghc_toolchain.m4 ===================================== @@ -107,13 +107,6 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], INVOKE_GHC_TOOLCHAIN() - echo "ROMES:RESULT: default.target" - cat default.target - echo "ROMES:RESULT: default.ghc-toolchain.host.target" - cat default.ghc-toolchain.host.target - echo "ROMES:RESULT: default.ghc-toolchain.target" - cat default.ghc-toolchain.target - #rm -Rf acargs acghc-toolchain actmp-ghc-toolchain dnl ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) @@ -131,15 +124,15 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ]) +dnl $1 like "default.target" +dnl $2 like "default.ghc-toolchain.target" AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ - A="default.target" - B="default.ghc-toolchain.target" - diff_output=`diff "$A" "$B" 2>&1` + diff_output=`diff "$1" "$2" 2>&1` if test -z "$diff_output"; then true else AC_MSG_WARN([ - There are some differences between the toolchain configured by "configure" ($A) and the toolchain configured by the "ghc-toolchain" program ($B). + There are some differences between the toolchain configured by "configure" ($1) and the toolchain configured by the "ghc-toolchain" program ($2). $diff_output Don't worry! This won't affect your ghc in any way. However, in a near future, we will move to configuring toolchains with "ghc-toolchain" by default, so you might have discovered a future bug! @@ -148,6 +141,8 @@ AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ ]) fi - echo "default.target printed:" - cat default.target + echo "$1:" + cat $1 + echo "$2:" + cat $2 ]) ===================================== m4/prep_target_file.m4 ===================================== @@ -131,10 +131,20 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_MAYBE_SIMPLE_PROGRAM([DllWrapCmd]) PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) PREP_MAYBE_STRING([TargetVendor_CPP]) + PREP_MAYBE_STRING([HostVendor_CPP]) PREP_LIST([SettingsCPPFlags]) PREP_LIST([SettingsCxxCompilerFlags]) PREP_LIST([SettingsCCompilerFlags]) + dnl Host-target + PREP_BOOLEAN([ArSupportsAtFile_STAGE0]) + PREP_BOOLEAN([ArSupportsDashL_STAGE0]) + PREP_LIST([AR_OPTS_STAGE0]) + PREP_LIST([CONF_CC_OPTS_STAGE0]) + PREP_LIST([CONF_CPP_OPTS_STAGE0]) + PREP_LIST([CONF_CXX_OPTS_STAGE0]) + PREP_LIST([CONF_GCC_LINKER_OPTS_STAGE0]) + dnl PREP_ENDIANNESS case "$TargetWordBigEndian" in YES) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -74,6 +74,23 @@ data Target = Target } deriving (Read, Eq, Ord) +-- | The word size as an integer representing the number of bytes +wordSize2Bytes :: WordSize -> Int +wordSize2Bytes WS4 = 4 +wordSize2Bytes WS8 = 8 + +-- | Reconstruct the platform triple from a toolchain target +-- (specifically from tgtArchOs and tgtVendor) +targetPlatformTriple :: Target -> String +targetPlatformTriple Target{tgtArchOs, tgtVendor} = + let archStr = stringEncodeArch $ archOS_arch tgtArchOs + osStr = stringEncodeOS $ archOS_OS tgtArchOs + in case tgtVendor of + Nothing -> archStr <> "-" <> osStr + Just vendor -> archStr <> "-" <> vendor <> "-" <> osStr + +-- | Handwritten Show instance to have have better diffs against the toolchain +-- targets generated by configure instance Show Target where show Target{..} = unlines [ "Target" @@ -103,18 +120,3 @@ instance Show Target where , ", tgtWindres = " ++ show tgtDllwrap , "}" ] - --- | The word size as an integer representing the number of bytes -wordSize2Bytes :: WordSize -> Int -wordSize2Bytes WS4 = 4 -wordSize2Bytes WS8 = 8 - --- | Reconstruct the platform triple from a toolchain target --- (specifically from tgtArchOs and tgtVendor) -targetPlatformTriple :: Target -> String -targetPlatformTriple Target{tgtArchOs, tgtVendor} = - let archStr = stringEncodeArch $ archOS_arch tgtArchOs - osStr = stringEncodeOS $ archOS_OS tgtArchOs - in case tgtVendor of - Nothing -> archStr <> "-" <> osStr - Just vendor -> archStr <> "-" <> vendor <> "-" <> osStr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2554fd247305874d0a747d1b27b5987ccf934a56...bc625facfac57e4df664f670b5d292b59a663d8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2554fd247305874d0a747d1b27b5987ccf934a56...bc625facfac57e4df664f670b5d292b59a663d8b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 13:09:15 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 10 Jul 2023 09:09:15 -0400 Subject: [Git][ghc/ghc][wip/T23578] Fix indentation and alignment Message-ID: <64ac02fb7995a_1926c04eaf3e026046f@gitlab.mail> Jaro Reinders pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC Commits: 76332665 by Jaro Reinders at 2023-07-10T15:09:08+02:00 Fix indentation and alignment - - - - - 1 changed file: - libraries/base/GHC/Word.hs Changes: ===================================== libraries/base/GHC/Word.hs ===================================== @@ -767,21 +767,21 @@ instance Enum Word64 where eftWord64 :: Word64# -> Word64# -> [Word64] -- [x1..x2] eftWord64 x0 y | isTrue# (x0 `gtWord64#` y) = [] - | otherwise = go x0 - where - go x = W64# x : if isTrue# (x `eqWord64#` y) - then [] - else go (x `plusWord64#` (wordToWord64# 1##)) + | otherwise = go x0 + where + go x = W64# x : if isTrue# (x `eqWord64#` y) + then [] + else go (x `plusWord64#` (wordToWord64# 1##)) {-# INLINE [0] eftWord64FB #-} -- See Note [Inline FB functions] in GHC.List eftWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> r eftWord64FB c n x0 y | isTrue# (x0 `gtWord64#` y) = n - | otherwise = go x0 - where - go x = W64# x `c` if isTrue# (x `eqWord64#` y) - then n - else go (x `plusWord64#` (wordToWord64# 1##)) - -- Watch out for y=maxBound; hence ==, not > + | otherwise = go x0 + where + go x = W64# x `c` if isTrue# (x `eqWord64#` y) + then n + else go (x `plusWord64#` (wordToWord64# 1##)) + -- Watch out for y=maxBound; hence ==, not > -- Be very careful not to have more than one "c" -- so that when eftInfFB is inlined we can inline -- whatever is bound to "c" @@ -802,14 +802,14 @@ efdWord64 :: Word64# -> Word64# -> [Word64] -- [x1,x2..maxWord64] efdWord64 x1 x2 | isTrue# (x2 `geWord64#` x1) = case maxBound of W64# y -> efdtWord64Up x1 x2 y - | otherwise = case minBound of W64# y -> efdtWord64Dn x1 x2 y + | otherwise = case minBound of W64# y -> efdtWord64Dn x1 x2 y {-# NOINLINE [1] efdtWord64 #-} efdtWord64 :: Word64# -> Word64# -> Word64# -> [Word64] -- [x1,x2..y] efdtWord64 x1 x2 y | isTrue# (x2 `geWord64#` x1) = efdtWord64Up x1 x2 y - | otherwise = efdtWord64Dn x1 x2 y + | otherwise = efdtWord64Dn x1 x2 y {-# INLINE [0] efdtWord64FB #-} -- See Note [Inline FB functions] in GHC.List efdtWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/763326655933962029a27ca8454ea4a54392e0e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/763326655933962029a27ca8454ea4a54392e0e7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 13:23:56 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 09:23:56 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Configure Host toolchain with dummy options, hope they aren't used Message-ID: <64ac066ced5b8_1926c04eaf3cc2642b1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9d47c1d0 by Rodrigo Mesquita at 2023-07-10T14:23:46+01:00 Configure Host toolchain with dummy options, hope they aren't used - - - - - 2 changed files: - default.host.target.in - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== default.host.target.in ===================================== @@ -2,39 +2,39 @@ Target { tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellTargetOs@} , tgtVendor = @HostVendor_CPPMaybeStr@ , tgtLocallyExecutable = True -, tgtSupportsGnuNonexecStack = undefined -, tgtSupportsSubsectionsViaSymbols = undefined -, tgtSupportsIdentDirective = undefined -, tgtWordSize = undefined -, tgtEndianness = undefined -, tgtSymbolsHaveLeadingUnderscore = undefined -, tgtLlvmTarget = undefined -, tgtUnregisterised = undefined -, tgtTablesNextToCode = undefined -, tgtUseLibffiForAdjustors = undefined +, tgtSupportsGnuNonexecStack = False +, tgtSupportsSubsectionsViaSymbols = False +, tgtSupportsIdentDirective = False +, tgtWordSize = WS8 +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = False +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = False +, tgtTablesNextToCode = True +, tgtUseLibffiForAdjustors = True , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} , tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @SettingsHaskellCPPFlagsList@}} , tgtCCompilerLink = CcLink { ccLinkProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_GCC_LINKER_OPTS_STAGE0List@} -, ccLinkSupportsNoPie = undefined -, ccLinkSupportsCompactUnwind = undefined -, ccLinkSupportsFilelist = undefined -, ccLinkIsGnu = undefined +, ccLinkSupportsNoPie = False +, ccLinkSupportsCompactUnwind = False +, ccLinkSupportsFilelist = False +, ccLinkIsGnu = False } , tgtAr = Ar { arMkArchive = Program {prgPath = "@AR_STAGE0@", prgFlags = @AR_OPTS_STAGE0List@} -, arIsGnu = undefined +, arIsGnu = False , arSupportsAtFile = @ArSupportsAtFile_STAGE0Bool@ , arSupportsDashL = @ArSupportsDashL_STAGE0Bool@ -, arNeedsRanlib = undefined +, arNeedsRanlib = False } -, tgtRanlib = undefined -, tgtNm = undefined -, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = undefined}, mergeObjsSupportsResponseFiles = undefined}) +, tgtRanlib = Nothing +, tgtNm = Nm {nmProgram = Program {prgPath = "@NM@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False}) , tgtDllwrap = @DllWrapCmdMaybeProg@ , tgtWindres = @WindresCmdMaybeProg@ } ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -16,10 +16,6 @@ import GHC.Toolchain.Tools.Link import GHC.Toolchain.Tools.Nm import GHC.Toolchain.Tools.MergeObjs -import GHC.Read -import Text.ParserCombinators.ReadPrec (prec, reset, (<++)) -import Text.Read.Lex - data WordSize = WS4 | WS8 deriving (Show, Read, Eq, Ord) @@ -29,7 +25,7 @@ data Endianness = LittleEndian | BigEndian -- ROMES:TODO: A target might also need -- * Llc command -- * Opt command --- * DistroMinGW? +-- * DistroMinGW? -- no, this should be configured with existing flags to point to the bindist mingw -- * Install_name_tool -- * Touch cmd -- * otool command @@ -76,7 +72,7 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Eq, Ord) + deriving (Read, Eq, Ord) -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int @@ -93,11 +89,8 @@ targetPlatformTriple Target{tgtArchOs, tgtVendor} = Nothing -> archStr <> "-" <> osStr Just vendor -> archStr <> "-" <> vendor <> "-" <> osStr -{- - Handwritten Show and Read instances to have have better diffs and parse - toolchain targets generated by configure --} - +-- | Handwritten Show instance to have have better diffs against the toolchain +-- targets generated by configure instance Show Target where show Target{..} = unlines [ "Target" @@ -127,64 +120,3 @@ instance Show Target where , ", tgtWindres = " ++ show tgtDllwrap , "}" ] - -instance Read GHC.Toolchain.Target.Target where - readPrec = parens $ prec 11 $ do - expectP (Ident "Target") - expectP (Punc "{") - tgtArchOs <- readFieldOrUndefined "tgtArchOs" - expectP (Punc ",") - tgtVendor <- readFieldOrUndefined "tgtVendor" - expectP (Punc ",") - tgtLocallyExecutable <- readFieldOrUndefined "tgtLocallyExecutable" - expectP (Punc ",") - tgtSupportsGnuNonexecStack <- readFieldOrUndefined "tgtSupportsGnuNonexecStack" - expectP (Punc ",") - tgtSupportsSubsectionsViaSymbols <- readFieldOrUndefined "tgtSupportsSubsectionsViaSymbols" - expectP (Punc ",") - tgtSupportsIdentDirective <- readFieldOrUndefined "tgtSupportsIdentDirective" - expectP (Punc ",") - tgtWordSize <- readFieldOrUndefined "tgtWordSize" - expectP (Punc ",") - tgtEndianness <- readFieldOrUndefined "tgtEndianness" - expectP (Punc ",") - tgtSymbolsHaveLeadingUnderscore <- readFieldOrUndefined "tgtSymbolsHaveLeadingUnderscore" - expectP (Punc ",") - tgtLlvmTarget <- readFieldOrUndefined "tgtLlvmTarget" - expectP (Punc ",") - tgtUnregisterised <- readFieldOrUndefined "tgtUnregisterised" - expectP (Punc ",") - tgtTablesNextToCode <- readFieldOrUndefined "tgtTablesNextToCode" - expectP (Punc ",") - tgtUseLibffiForAdjustors <- readFieldOrUndefined "tgtUseLibffiForAdjustors" - expectP (Punc ",") - tgtCCompiler <- readFieldOrUndefined "tgtCCompiler" - expectP (Punc ",") - tgtCxxCompiler <- readFieldOrUndefined "tgtCxxCompiler" - expectP (Punc ",") - tgtCPreprocessor <- readFieldOrUndefined "tgtCPreprocessor" - expectP (Punc ",") - tgtHsCPreprocessor <- readFieldOrUndefined "tgtHsCPreprocessor" - expectP (Punc ",") - tgtCCompilerLink <- readFieldOrUndefined "tgtCCompilerLink" - expectP (Punc ",") - tgtAr <- readFieldOrUndefined "tgtAr" - expectP (Punc ",") - tgtRanlib <- readFieldOrUndefined "tgtRanlib" - expectP (Punc ",") - tgtNm <- readFieldOrUndefined "tgtNm" - expectP (Punc ",") - tgtMergeObjs <- readFieldOrUndefined "tgtMergeObjs" - expectP (Punc ",") - tgtDllwrap <- readFieldOrUndefined "tgtDllwrap" - expectP (Punc ",") - tgtWindres <- readFieldOrUndefined "tgtWindres" - expectP (Punc "}") - return Target{..} - where - readFieldOrUndefined fieldName = do - expectP (Ident fieldName) - expectP (Punc "=") - ((reset (expectP (Ident "undefined")) >> return undefined) <++ reset readPrec) - {-# NOINLINE readFieldOrUndefined #-} - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d47c1d0fa19b758d1a5f8f3bdd02551a2b0c0d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d47c1d0fa19b758d1a5f8f3bdd02551a2b0c0d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 13:45:33 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 09:45:33 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Configure Host toolchain with dummy options, hope they aren't used Message-ID: <64ac0b7d82932_1926c04ebe32c27291@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5dce88bc by Rodrigo Mesquita at 2023-07-10T14:45:21+01:00 Configure Host toolchain with dummy options, hope they aren't used - - - - - 2 changed files: - default.host.target.in - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== default.host.target.in ===================================== @@ -1,40 +1,40 @@ Target -{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellTargetOs@} +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} , tgtVendor = @HostVendor_CPPMaybeStr@ , tgtLocallyExecutable = True -, tgtSupportsGnuNonexecStack = undefined -, tgtSupportsSubsectionsViaSymbols = undefined -, tgtSupportsIdentDirective = undefined -, tgtWordSize = undefined -, tgtEndianness = undefined -, tgtSymbolsHaveLeadingUnderscore = undefined -, tgtLlvmTarget = undefined -, tgtUnregisterised = undefined -, tgtTablesNextToCode = undefined -, tgtUseLibffiForAdjustors = undefined +, tgtSupportsGnuNonexecStack = False +, tgtSupportsSubsectionsViaSymbols = False +, tgtSupportsIdentDirective = False +, tgtWordSize = WS8 +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = False +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = False +, tgtTablesNextToCode = True +, tgtUseLibffiForAdjustors = True , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} , tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @SettingsHaskellCPPFlagsList@}} , tgtCCompilerLink = CcLink { ccLinkProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_GCC_LINKER_OPTS_STAGE0List@} -, ccLinkSupportsNoPie = undefined -, ccLinkSupportsCompactUnwind = undefined -, ccLinkSupportsFilelist = undefined -, ccLinkIsGnu = undefined +, ccLinkSupportsNoPie = False +, ccLinkSupportsCompactUnwind = False +, ccLinkSupportsFilelist = False +, ccLinkIsGnu = False } , tgtAr = Ar { arMkArchive = Program {prgPath = "@AR_STAGE0@", prgFlags = @AR_OPTS_STAGE0List@} -, arIsGnu = undefined +, arIsGnu = False , arSupportsAtFile = @ArSupportsAtFile_STAGE0Bool@ , arSupportsDashL = @ArSupportsDashL_STAGE0Bool@ -, arNeedsRanlib = undefined +, arNeedsRanlib = False } -, tgtRanlib = undefined -, tgtNm = undefined -, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = undefined}, mergeObjsSupportsResponseFiles = undefined}) +, tgtRanlib = Nothing +, tgtNm = Nm {nmProgram = Program {prgPath = "@NM@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False}) , tgtDllwrap = @DllWrapCmdMaybeProg@ , tgtWindres = @WindresCmdMaybeProg@ } ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -16,10 +16,6 @@ import GHC.Toolchain.Tools.Link import GHC.Toolchain.Tools.Nm import GHC.Toolchain.Tools.MergeObjs -import GHC.Read -import Text.ParserCombinators.ReadPrec (prec, reset, (<++)) -import Text.Read.Lex - data WordSize = WS4 | WS8 deriving (Show, Read, Eq, Ord) @@ -29,7 +25,7 @@ data Endianness = LittleEndian | BigEndian -- ROMES:TODO: A target might also need -- * Llc command -- * Opt command --- * DistroMinGW? +-- * DistroMinGW? -- no, this should be configured with existing flags to point to the bindist mingw -- * Install_name_tool -- * Touch cmd -- * otool command @@ -76,7 +72,7 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Eq, Ord) + deriving (Read, Eq, Ord) -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int @@ -93,11 +89,8 @@ targetPlatformTriple Target{tgtArchOs, tgtVendor} = Nothing -> archStr <> "-" <> osStr Just vendor -> archStr <> "-" <> vendor <> "-" <> osStr -{- - Handwritten Show and Read instances to have have better diffs and parse - toolchain targets generated by configure --} - +-- | Handwritten Show instance to have have better diffs against the toolchain +-- targets generated by configure instance Show Target where show Target{..} = unlines [ "Target" @@ -127,64 +120,3 @@ instance Show Target where , ", tgtWindres = " ++ show tgtDllwrap , "}" ] - -instance Read GHC.Toolchain.Target.Target where - readPrec = parens $ prec 11 $ do - expectP (Ident "Target") - expectP (Punc "{") - tgtArchOs <- readFieldOrUndefined "tgtArchOs" - expectP (Punc ",") - tgtVendor <- readFieldOrUndefined "tgtVendor" - expectP (Punc ",") - tgtLocallyExecutable <- readFieldOrUndefined "tgtLocallyExecutable" - expectP (Punc ",") - tgtSupportsGnuNonexecStack <- readFieldOrUndefined "tgtSupportsGnuNonexecStack" - expectP (Punc ",") - tgtSupportsSubsectionsViaSymbols <- readFieldOrUndefined "tgtSupportsSubsectionsViaSymbols" - expectP (Punc ",") - tgtSupportsIdentDirective <- readFieldOrUndefined "tgtSupportsIdentDirective" - expectP (Punc ",") - tgtWordSize <- readFieldOrUndefined "tgtWordSize" - expectP (Punc ",") - tgtEndianness <- readFieldOrUndefined "tgtEndianness" - expectP (Punc ",") - tgtSymbolsHaveLeadingUnderscore <- readFieldOrUndefined "tgtSymbolsHaveLeadingUnderscore" - expectP (Punc ",") - tgtLlvmTarget <- readFieldOrUndefined "tgtLlvmTarget" - expectP (Punc ",") - tgtUnregisterised <- readFieldOrUndefined "tgtUnregisterised" - expectP (Punc ",") - tgtTablesNextToCode <- readFieldOrUndefined "tgtTablesNextToCode" - expectP (Punc ",") - tgtUseLibffiForAdjustors <- readFieldOrUndefined "tgtUseLibffiForAdjustors" - expectP (Punc ",") - tgtCCompiler <- readFieldOrUndefined "tgtCCompiler" - expectP (Punc ",") - tgtCxxCompiler <- readFieldOrUndefined "tgtCxxCompiler" - expectP (Punc ",") - tgtCPreprocessor <- readFieldOrUndefined "tgtCPreprocessor" - expectP (Punc ",") - tgtHsCPreprocessor <- readFieldOrUndefined "tgtHsCPreprocessor" - expectP (Punc ",") - tgtCCompilerLink <- readFieldOrUndefined "tgtCCompilerLink" - expectP (Punc ",") - tgtAr <- readFieldOrUndefined "tgtAr" - expectP (Punc ",") - tgtRanlib <- readFieldOrUndefined "tgtRanlib" - expectP (Punc ",") - tgtNm <- readFieldOrUndefined "tgtNm" - expectP (Punc ",") - tgtMergeObjs <- readFieldOrUndefined "tgtMergeObjs" - expectP (Punc ",") - tgtDllwrap <- readFieldOrUndefined "tgtDllwrap" - expectP (Punc ",") - tgtWindres <- readFieldOrUndefined "tgtWindres" - expectP (Punc "}") - return Target{..} - where - readFieldOrUndefined fieldName = do - expectP (Ident fieldName) - expectP (Punc "=") - ((reset (expectP (Ident "undefined")) >> return undefined) <++ reset readPrec) - {-# NOINLINE readFieldOrUndefined #-} - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5dce88bcb2eb62294bee4c280b192af27a2740d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5dce88bcb2eb62294bee4c280b192af27a2740d9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 14:15:12 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 10 Jul 2023 10:15:12 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] Move adhoc reg format checks into a proper place Message-ID: <64ac1270b2736_1926c0b138c2805f1@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: 9aa354c2 by Andreas Klebinger at 2023-07-10T16:17:23+02:00 Move adhoc reg format checks into a proper place - - - - - 3 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -559,12 +559,13 @@ getRegister' config plat expr -> case lit of -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move. - CmmInt 0 W32 -> do - let format = intFormat W32 - return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) - CmmInt 0 W64 -> do - let format = intFormat W64 - return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) + -- TODO: Reenable after https://gitlab.haskell.org/ghc/ghc/-/issues/23632 is fixed. + -- CmmInt 0 W32 -> do + -- let format = intFormat W32 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) + -- CmmInt 0 W64 -> do + -- let format = intFormat W64 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) CmmInt i W16 | i >= 0 -> do ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -381,9 +381,8 @@ mkSpillInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) + mkIp0SpillAddr imm = ANN (text "Spill: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkStrSp imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) mkStrIp0 imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) @@ -408,9 +407,7 @@ mkLoadInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) mkIp0SpillAddr imm = ANN (text "Reload: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkLdrSp imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -147,6 +147,13 @@ classOfRealReg (RealRegSingle i) | i < 32 = RcInteger | otherwise = RcDouble +fmtOfRealReg :: RealReg -> Format +fmtOfRealReg real_reg = + case classOfRealReg real_reg of + RcInteger -> II64 + RcDouble -> FF64 + RcFloat -> panic "No float regs on arm" + regDotColor :: RealReg -> SDoc regDotColor reg = case classOfRealReg reg of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9aa354c2a8b771519dbc31d0e2f63306d8e7c91d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9aa354c2a8b771519dbc31d0e2f63306d8e7c91d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 14:49:18 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 10 Jul 2023 10:49:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T17521 Message-ID: <64ac1a6e1bee6_1926c04eaf3a4300133@gitlab.mail> Jaro Reinders pushed new branch wip/T17521 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T17521 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 15:06:44 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 10 Jul 2023 11:06:44 -0400 Subject: [Git][ghc/ghc][wip/T23567] 21 commits: JS: cleanup utils (#23314) Message-ID: <64ac1e847e8d2_1c29a5b16d4463d9@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23567 at Glasgow Haskell Compiler / GHC Commits: 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 0f51b879 by Krzysztof Gogolewski at 2023-07-10T17:04:59+02:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/TyThing/Ppr.hs - docs/users_guide/phases.rst - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/421278c808e763227bb3e93c08070b7e0b177b57...0f51b8791657816ec7095338d5d0a4b5421ff96e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/421278c808e763227bb3e93c08070b7e0b177b57...0f51b8791657816ec7095338d5d0a4b5421ff96e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 15:08:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 10 Jul 2023 11:08:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) Message-ID: <64ac1ef2546c_1c29a5b16c0498e1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fcca174a by jade at 2023-07-10T11:08:13-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 2b665a65 by sheaf at 2023-07-10T11:08:20-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - 2255afad by Alan Zimmerman at 2023-07-10T11:08:21-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - 3e588fd8 by Bodigrim at 2023-07-10T11:08:23-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - e3593014 by Matthew Pickering at 2023-07-10T11:08:24-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - 11 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/TyThing.hs - libraries/text - + testsuite/tests/module/T20007.hs - + testsuite/tests/module/T20007.stderr - testsuite/tests/module/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1953,7 +1953,9 @@ primop CompareByteArraysOp "compareByteArrays#" GenPrimOp specified ranges, but this is not checked. Returns an 'Int#' less than, equal to, or greater than zero if the range is found, respectively, to be byte-wise lexicographically less than, to - match, or be greater than the second range.} + match, or be greater than the second range. + + @since 0.5.2.0} with can_fail = True ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,14 +1026,14 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } - | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } - | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } @@ -1371,7 +1371,7 @@ inst_decl :: { LInstDecl GhcPs } , cid_tyfam_insts = ats , cid_overlap_mode = $2 , cid_datafam_insts = adts } - ; acsA (\cs -> L (comb3 $1 (reLoc $3) $4) + ; acsA (\cs -> L (comb3 $1 $3 $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid cs })) } } @@ -1498,7 +1498,7 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } at_decl_cls :: { LHsDecl GhcPs } : -- data family declarations, with optional 'family' keyword 'data' opt_family type opt_datafam_kind_sig - {% liftM mkTyClD (mkFamDecl (comb3 $1 (reLoc $3) $4) DataFamily NotTopLevel $3 + {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3 (snd $ unLoc $4) Nothing (mj AnnData $1:$2++(fst $ unLoc $4))) } @@ -1506,13 +1506,13 @@ at_decl_cls :: { LHsDecl GhcPs } -- (can't use opt_instance because you get shift/reduce errors | 'type' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $2) $3) OpenTypeFamily NotTopLevel $2 + (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2 (fst . snd $ unLoc $3) (snd . snd $ unLoc $3) (mj AnnType $1:(fst $ unLoc $3)) )} | 'type' 'family' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $3) $4) OpenTypeFamily NotTopLevel $3 + (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3 (fst . snd $ unLoc $4) (snd . snd $ unLoc $4) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))} @@ -1651,7 +1651,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } role_annot :: { LRoleAnnotDecl GhcPs } role_annot : 'type' 'role' oqtycon maybe_roles - {% mkRoleAnnotDecl (comb3N $1 $4 $3) $3 (reverse (unLoc $4)) + {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4)) [mj AnnType $1,mj AnnRole $2] } -- Reversed! @@ -2594,7 +2594,7 @@ decl :: { LHsDecl GhcPs } rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } : '=' exp wherebinds {% runPV (unECP $2) >>= \ $2 -> do { let L l (bs, csw) = adaptWhereBinds $3 - ; let loc = (comb3 $1 (reLoc $2) (L l bs)) + ; let loc = (comb3 $1 $2 (L l bs)) ; acs (\cs -> sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2) bs)) } } @@ -2907,7 +2907,7 @@ aexp :: { ECP } | 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) -> return $ ECP $ $4 >>= \ $4 -> - mkHsCasePV (comb3 $1 $3 (reLoc $4)) $2 $4 + mkHsCasePV (comb3 $1 $3 $4) $2 $4 (EpAnnHsCase (glAA $1) (glAA $3) []) } -- QualifiedDo. | DO stmtlist {% do @@ -4090,17 +4090,9 @@ stringLiteralToHsDocWst = lexStringLiteral parseIdentifier comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan comb2 a b = a `seq` b `seq` combineHasLocs a b -comb3 :: Located a -> Located b -> Located c -> SrcSpan +comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c)) - -comb3A :: Located a -> Located b -> LocatedAn t c -> SrcSpan -comb3A a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) - -comb3N :: Located a -> Located b -> LocatedN c -> SrcSpan -comb3N a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) + combineSrcSpans (getHasLoc a) (combineHasLocs b c) comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -2139,11 +2139,12 @@ badImportItemErr -> TcRn ImportLookupReason badImportItemErr iface decl_spec ie sub avails = do patsyns_enabled <- xoptM LangExt.PatternSynonyms - pure (ImportLookupBad importErrorKind iface decl_spec ie patsyns_enabled) + expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces + pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled) where - importErrorKind + importErrorKind expl_ns_enabled | any checkIfTyCon avails = case sub of - BadImportIsParent -> BadImportAvailTyCon + BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren | any checkIfVarName avails = BadImportAvailVar | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3108,7 +3108,9 @@ instance Diagnostic TcRnMessage where in case k of BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] BadImportNotExported -> noHints - BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] + BadImportAvailTyCon ex_ns -> + [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns] + ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints TcRnImportLookup{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5263,7 +5263,9 @@ data BadImportKind -- | Module does not export... = BadImportNotExported -- | Missing @type@ keyword when importing a type. - | BadImportAvailTyCon + -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+) + -- Then we want to suggest using `import TypeLits( type (+) )` + | BadImportAvailTyCon Bool -- ^ is ExplicitNamespaces enabled? -- | Trying to import a data constructor directly, e.g. -- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@ | BadImportAvailDataCon OccName ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -310,12 +310,12 @@ pprImportSuggestion occ_name (CouldUnhideFrom mods) | (mod,imv) <- NE.toList mods ]) pprImportSuggestion occ_name (CouldAddTypeKeyword mod) - = vcat [ text "Add the" <+> quotes (text "type") + = vcat [ text "Add the" <+> quotes (text "type") <+> text "keyword to the import statement:" - , nest 2 $ text "import" + , nest 2 $ text "import" <+> ppr mod <+> parens_sp (text "type" <+> pprPrefixOcc occ_name) - ] + ] where parens_sp d = parens (space <> d <> space) pprImportSuggestion occ_name (CouldRemoveTypeKeyword mod) ===================================== compiler/GHC/Types/TyThing.hs ===================================== @@ -28,6 +28,7 @@ where import GHC.Prelude +import GHC.Types.GREInfo import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.Var @@ -52,6 +53,11 @@ import Control.Monad ( liftM ) import Control.Monad.Trans.Reader import Control.Monad.Trans.Class +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import Data.List ( intersect ) + + {- Note [ATyCon for classes] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -301,15 +307,24 @@ tyThingLocalGREs ty_thing = | dc <- dcs , let con_info = conLikeConInfo (RealDataCon dc) ] AConLike con -> - let par = case con of - PatSynCon {} -> NoParent - -- NoParent for local pattern synonyms as per - -- Note [Parents] in GHC.Types.Name.Reader. - RealDataCon dc -> ParentIs $ tyConName $ dataConTyCon dc - in - myself par : - mkLocalFieldGREs par - [(conLikeConLikeName con, conLikeConInfo con)] + let (par, cons_flds) = case con of + PatSynCon {} -> + (NoParent, [(conLikeConLikeName con, conLikeConInfo con)]) + -- NB: NoParent for local pattern synonyms, as per + -- Note [Parents] in GHC.Types.Name.Reader. + RealDataCon dc1 -> + (ParentIs $ tyConName $ dataConTyCon dc1 + , [ (DataConName $ dataConName $ dc, ConHasRecordFields (fld :| flds)) + | dc <- tyConDataCons $ dataConTyCon dc1 + -- Go through all the data constructors of the parent TyCon, + -- to ensure that all the record fields have the correct set + -- of parent data constructors. See #23546. + , let con_info = conLikeConInfo (RealDataCon dc) + , ConHasRecordFields flds0 <- [con_info] + , let flds1 = NE.toList flds0 `intersect` dataConFieldLabels dc + , fld:flds <- [flds1] + ]) + in myself par : mkLocalFieldGREs par cons_flds AnId id | RecSelId { sel_tycon = RecSelData tc } <- idDetails id -> [ myself (ParentIs $ tyConName tc) ] ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f +Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e ===================================== testsuite/tests/module/T20007.hs ===================================== @@ -0,0 +1 @@ +import Data.Type.Equality ( (~) ) ===================================== testsuite/tests/module/T20007.stderr ===================================== @@ -0,0 +1,8 @@ + +T20007.hs:1:29: [GHC-56449] + In the import of ‘Data.Type.Equality’: + an item called ‘(~)’ is exported, but it is a type. + Suggested fixes: + Use ExplicitNamespaces + Add the ‘type’ keyword to the import statement: + import Data.Type.Equality ( type (~) ) ===================================== testsuite/tests/module/all.T ===================================== @@ -298,3 +298,4 @@ test('T21752', [extra_files(['T21752A.hs', 'T21752.hs'])], multimod_compile, ['T test('TupleTyConUserSyntax', [extra_files(['TupleTyConUserSyntaxA.hs', 'TupleTyConUserSyntax.hs'])], multimod_compile, ['TupleTyConUserSyntax', '-v0']) test('T21826', normal, compile_fail, ['']) +test('T20007', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfc584c64ab593a3a52af97badb25ebb6c5ab1f0...e3593014222e996d67390d56cb9118772de5eef0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bfc584c64ab593a3a52af97badb25ebb6c5ab1f0...e3593014222e996d67390d56cb9118772de5eef0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 15:11:02 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 11:11:02 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Configure Host toolchain with dummy options, hope they aren't used Message-ID: <64ac1f863563f_1c29a5b16d4620d9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7e33bddd by Rodrigo Mesquita at 2023-07-10T16:10:53+01:00 Configure Host toolchain with dummy options, hope they aren't used - - - - - 6 changed files: - default.host.target.in - hadrian/cfg/system.config.in - hadrian/src/Context.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Builders/Cabal.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== default.host.target.in ===================================== @@ -1,40 +1,40 @@ Target -{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellTargetOs@} +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} , tgtVendor = @HostVendor_CPPMaybeStr@ , tgtLocallyExecutable = True -, tgtSupportsGnuNonexecStack = undefined -, tgtSupportsSubsectionsViaSymbols = undefined -, tgtSupportsIdentDirective = undefined -, tgtWordSize = undefined -, tgtEndianness = undefined -, tgtSymbolsHaveLeadingUnderscore = undefined -, tgtLlvmTarget = undefined -, tgtUnregisterised = undefined -, tgtTablesNextToCode = undefined -, tgtUseLibffiForAdjustors = undefined +, tgtSupportsGnuNonexecStack = False +, tgtSupportsSubsectionsViaSymbols = False +, tgtSupportsIdentDirective = False +, tgtWordSize = WS8 +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = False +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = False +, tgtTablesNextToCode = True +, tgtUseLibffiForAdjustors = True , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} , tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @SettingsHaskellCPPFlagsList@}} , tgtCCompilerLink = CcLink { ccLinkProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_GCC_LINKER_OPTS_STAGE0List@} -, ccLinkSupportsNoPie = undefined -, ccLinkSupportsCompactUnwind = undefined -, ccLinkSupportsFilelist = undefined -, ccLinkIsGnu = undefined +, ccLinkSupportsNoPie = False +, ccLinkSupportsCompactUnwind = False +, ccLinkSupportsFilelist = False +, ccLinkIsGnu = False } , tgtAr = Ar { arMkArchive = Program {prgPath = "@AR_STAGE0@", prgFlags = @AR_OPTS_STAGE0List@} -, arIsGnu = undefined +, arIsGnu = False , arSupportsAtFile = @ArSupportsAtFile_STAGE0Bool@ , arSupportsDashL = @ArSupportsDashL_STAGE0Bool@ -, arNeedsRanlib = undefined +, arNeedsRanlib = False } -, tgtRanlib = undefined -, tgtNm = undefined -, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = undefined}, mergeObjsSupportsResponseFiles = undefined}) +, tgtRanlib = Nothing +, tgtNm = Nm {nmProgram = Program {prgPath = "@NM@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False}) , tgtDllwrap = @DllWrapCmdMaybeProg@ , tgtWindres = @WindresCmdMaybeProg@ } ===================================== hadrian/cfg/system.config.in ===================================== @@ -48,10 +48,6 @@ ghc-source-path = @hardtop@ # Q: What is TargetPlatformFull? target-platform-full = @TargetPlatformFull@ -# ROMES:TODO: Drop cross-compiling, when we configure all 3 targets based on configure flags -# the three targets are always the three targets to use, regardless of them being the same or not -cross-compiling = @CrossCompiling@ - dynamic-extension = @soext_target@ ghc-version = @GhcVersion@ @@ -78,9 +74,6 @@ project-git-commit-id = @ProjectGitCommitId@ # might become redundant. # See Note [tooldir: How GHC finds mingw on Windows] -# ROMES:TODO: Get rid of some of these settings completely? -# I think the only one which we might keep still is otool and install_name_tool -# and touch and target has libm? settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-touch-command = @SettingsTouchCommand@ ===================================== hadrian/src/Context.hs ===================================== @@ -65,9 +65,9 @@ libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib")) distDir :: Stage -> Action FilePath distDir st = do version <- ghcVersionStage st - hostOs <- cabalOsString . stringEncodeOS . archOS_OS . tgtArchOs <$> targetStage st - hostArch <- cabalArchString . stringEncodeArch . archOS_arch . tgtArchOs <$> targetStage st - return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version + targetOs <- cabalOsString . stringEncodeOS . archOS_OS . tgtArchOs <$> targetStage st + targetArch <- cabalArchString . stringEncodeArch . archOS_arch . tgtArchOs <$> targetStage st + return $ targetArch ++ "-" ++ targetOs ++ "-ghc-" ++ version pkgFileName :: Context -> Package -> String -> String -> Action FilePath pkgFileName context package prefix suffix = do ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -38,10 +38,7 @@ import GHC.Platform.ArchOS -- looks up the value of the setting and returns the string @"mingw32"@, -- tracking the result in the Shake database. -- --- ROMES:TODO: *Platform are passed to ghc-toolchain in --target --- We can reconstruct the *Platform information from the toolchain (targetPlatformTriple) --- --- * How to handle target-platform-full? +-- * ROMES:TODO: How to handle target-platform-full? data Setting = CursesIncludeDir | CursesLibDir | DynamicExtension @@ -82,8 +79,8 @@ data Setting = CursesIncludeDir -- This used to be defined by 'FP_SETTINGS' in aclocal.m4. -- -- TODO: We should be able to drop this completely, after moving all the toolchain settings to ghc-toolchain --- --- TODO: For the next person, move to ghc-toolchain and to the Target files generated by configure and ghc-toolchain +-- Move to ghc-toolchain and to the Target files generated by configure and ghc-toolchain +-- * First we will get rid of DistroMinGW when we fix the windows build data ToolchainSetting = ToolchainSetting_OtoolCommand | ToolchainSetting_InstallNameToolCommand @@ -94,8 +91,6 @@ data ToolchainSetting -- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the -- result. --- ROMES:TODO: Things that are gotten from the toolchain configs will no longer --- be part of settings, so they should be moved out. setting :: Setting -> Action String setting key = lookupSystemConfig $ case key of CursesIncludeDir -> "curses-include-dir" @@ -264,8 +259,8 @@ targetStage :: Stage -> Action Target -- TODO: We currently only support cross-compiling a stage1 compiler, -- but the cross compiler should really be stage2 (#19174) -- When we get there, we'll need to change the definition here. -targetStage (Stage0 {}) = getBuildTarget -targetStage (Stage1 {}) = getHostTarget -targetStage (Stage2 {}) = getTargetTarget -targetStage (Stage3 {}) = getTargetTarget +targetStage (Stage0 {}) = getHostTarget -- getBuildTarget +targetStage (Stage1 {}) = getTargetTarget -- getHostTarget +targetStage (Stage2 {}) = getTargetTarget -- getTargetTarget +targetStage (Stage3 {}) = getTargetTarget -- Would only be available for runnable stage2s? ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -175,7 +175,6 @@ configureStageArgs = do ] --- TODO: LD_OPTS? configureArgs :: Args -> Args -> Args configureArgs cFlags' ldFlags' = do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -16,10 +16,6 @@ import GHC.Toolchain.Tools.Link import GHC.Toolchain.Tools.Nm import GHC.Toolchain.Tools.MergeObjs -import GHC.Read -import Text.ParserCombinators.ReadPrec (prec, reset, (<++)) -import Text.Read.Lex - data WordSize = WS4 | WS8 deriving (Show, Read, Eq, Ord) @@ -29,7 +25,7 @@ data Endianness = LittleEndian | BigEndian -- ROMES:TODO: A target might also need -- * Llc command -- * Opt command --- * DistroMinGW? +-- * DistroMinGW? -- no, this should be configured with existing flags to point to the bindist mingw -- * Install_name_tool -- * Touch cmd -- * otool command @@ -76,7 +72,7 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Eq, Ord) + deriving (Read, Eq, Ord) -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int @@ -93,11 +89,8 @@ targetPlatformTriple Target{tgtArchOs, tgtVendor} = Nothing -> archStr <> "-" <> osStr Just vendor -> archStr <> "-" <> vendor <> "-" <> osStr -{- - Handwritten Show and Read instances to have have better diffs and parse - toolchain targets generated by configure --} - +-- | Handwritten Show instance to have have better diffs against the toolchain +-- targets generated by configure instance Show Target where show Target{..} = unlines [ "Target" @@ -127,64 +120,3 @@ instance Show Target where , ", tgtWindres = " ++ show tgtDllwrap , "}" ] - -instance Read GHC.Toolchain.Target.Target where - readPrec = parens $ prec 11 $ do - expectP (Ident "Target") - expectP (Punc "{") - tgtArchOs <- readFieldOrUndefined "tgtArchOs" - expectP (Punc ",") - tgtVendor <- readFieldOrUndefined "tgtVendor" - expectP (Punc ",") - tgtLocallyExecutable <- readFieldOrUndefined "tgtLocallyExecutable" - expectP (Punc ",") - tgtSupportsGnuNonexecStack <- readFieldOrUndefined "tgtSupportsGnuNonexecStack" - expectP (Punc ",") - tgtSupportsSubsectionsViaSymbols <- readFieldOrUndefined "tgtSupportsSubsectionsViaSymbols" - expectP (Punc ",") - tgtSupportsIdentDirective <- readFieldOrUndefined "tgtSupportsIdentDirective" - expectP (Punc ",") - tgtWordSize <- readFieldOrUndefined "tgtWordSize" - expectP (Punc ",") - tgtEndianness <- readFieldOrUndefined "tgtEndianness" - expectP (Punc ",") - tgtSymbolsHaveLeadingUnderscore <- readFieldOrUndefined "tgtSymbolsHaveLeadingUnderscore" - expectP (Punc ",") - tgtLlvmTarget <- readFieldOrUndefined "tgtLlvmTarget" - expectP (Punc ",") - tgtUnregisterised <- readFieldOrUndefined "tgtUnregisterised" - expectP (Punc ",") - tgtTablesNextToCode <- readFieldOrUndefined "tgtTablesNextToCode" - expectP (Punc ",") - tgtUseLibffiForAdjustors <- readFieldOrUndefined "tgtUseLibffiForAdjustors" - expectP (Punc ",") - tgtCCompiler <- readFieldOrUndefined "tgtCCompiler" - expectP (Punc ",") - tgtCxxCompiler <- readFieldOrUndefined "tgtCxxCompiler" - expectP (Punc ",") - tgtCPreprocessor <- readFieldOrUndefined "tgtCPreprocessor" - expectP (Punc ",") - tgtHsCPreprocessor <- readFieldOrUndefined "tgtHsCPreprocessor" - expectP (Punc ",") - tgtCCompilerLink <- readFieldOrUndefined "tgtCCompilerLink" - expectP (Punc ",") - tgtAr <- readFieldOrUndefined "tgtAr" - expectP (Punc ",") - tgtRanlib <- readFieldOrUndefined "tgtRanlib" - expectP (Punc ",") - tgtNm <- readFieldOrUndefined "tgtNm" - expectP (Punc ",") - tgtMergeObjs <- readFieldOrUndefined "tgtMergeObjs" - expectP (Punc ",") - tgtDllwrap <- readFieldOrUndefined "tgtDllwrap" - expectP (Punc ",") - tgtWindres <- readFieldOrUndefined "tgtWindres" - expectP (Punc "}") - return Target{..} - where - readFieldOrUndefined fieldName = do - expectP (Ident fieldName) - expectP (Punc "=") - ((reset (expectP (Ident "undefined")) >> return undefined) <++ reset readPrec) - {-# NOINLINE readFieldOrUndefined #-} - View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e33bddd38b703169525d9b46d16230ba838cd6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e33bddd38b703169525d9b46d16230ba838cd6e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 15:20:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 10 Jul 2023 11:20:46 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] Fix breakpoint Message-ID: <64ac21ceefd49_1c29a5b16d46494f@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: e8ed0c85 by Ben Gamari at 2023-07-10T11:20:25-04:00 Fix breakpoint - - - - - 1 changed file: - compiler/GHC/Core/Opt/SpecConstr.hs Changes: ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1543,9 +1543,9 @@ scExpr' env (Case scrut b ty alts) -- 'GHC.Opt.Specialise.specTickish'. scTickish :: ScEnv -> CoreTickish -> UniqSM (ScUsage, CoreTickish) scTickish env = \case - Breakpoint ext i fv modl -> do + Breakpoint ext i fv -> do (usg, fv') <- unzip <$> mapM (\ v -> scExpr env (Var v)) fv - pure (combineUsages usg, Breakpoint ext i [v | Var v <- fv'] modl) + pure (combineUsages usg, Breakpoint ext i [v | Var v <- fv']) t at ProfNote {} -> pure (nullUsage, t) t at HpcTick {} -> pure (nullUsage, t) t at SourceNote {} -> pure (nullUsage, t) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8ed0c85072b8f5aad730506e79f41c66705c4fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8ed0c85072b8f5aad730506e79f41c66705c4fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 16:14:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 10 Jul 2023 12:14:43 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: prettier comment Message-ID: <64ac2e736ddf8_1c29a5b165c78573@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: ada2d27e by Rodrigo Mesquita at 2023-07-10T16:29:39+01:00 prettier comment - - - - - 843e5842 by Rodrigo Mesquita at 2023-07-10T17:14:36+01:00 fixup! Configure Host toolchain with dummy options, hope they aren't used - - - - - 2 changed files: - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs Changes: ===================================== hadrian/cfg/system.config.in ===================================== @@ -48,6 +48,8 @@ ghc-source-path = @hardtop@ # Q: What is TargetPlatformFull? target-platform-full = @TargetPlatformFull@ +cross-compiling = @CrossCompiling@ + dynamic-extension = @soext_target@ ghc-version = @GhcVersion@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -256,11 +256,12 @@ libsuf st way return (suffix ++ "-ghc" ++ version ++ extension) targetStage :: Stage -> Action Target --- TODO: We currently only support cross-compiling a stage1 compiler, --- but the cross compiler should really be stage2 (#19174) +-- TODO(#19174): +-- We currently only support cross-compiling a stage1 compiler, +-- but the cross compiler should really be stage2 (#19174). -- When we get there, we'll need to change the definition here. -targetStage (Stage0 {}) = getHostTarget -- getBuildTarget -targetStage (Stage1 {}) = getTargetTarget -- getHostTarget -targetStage (Stage2 {}) = getTargetTarget -- getTargetTarget -targetStage (Stage3 {}) = getTargetTarget -- Would only be available for runnable stage2s? +targetStage (Stage0 {}) = getHostTarget +targetStage (Stage1 {}) = getTargetTarget +targetStage (Stage2 {}) = getTargetTarget -- the last two only make sense if the target can be executed locally +targetStage (Stage3 {}) = getTargetTarget View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e33bddd38b703169525d9b46d16230ba838cd6e...843e5842b0bdf6bf522795b06f746237e33a1664 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e33bddd38b703169525d9b46d16230ba838cd6e...843e5842b0bdf6bf522795b06f746237e33a1664 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 16:50:18 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 10 Jul 2023 12:50:18 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Wibbles... in progress...may not compile Message-ID: <64ac36cabe64_1c29a5b165c844f@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 04e69d62 by Simon Peyton Jones at 2023-07-10T17:50:00+01:00 Wibbles... in progress...may not compile - - - - - 4 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -964,39 +964,48 @@ once ~# is made to be homogeneous. -- | Make a Coercion from a tycovar, a kind coercion, and a body coercion. -- The kind of the tycovar should be the left-hand kind of the kind coercion. --- See Note [Unused coercion variable in ForAllCo] mkForAllCo :: HasDebugCallStack => TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> CoercionN -> Coercion -> Coercion +-- See Note [Unused coercion variable in ForAllCo] mkForAllCo v visL visR kind_co co = assertPpr (varType v `eqType` (coercionLKind kind_co)) (vcat [ ppr v <+> dcolon <+> ppr (varType v) , text "kind_co:" <+> ppr kind_co , text "lkind:" <+> ppr (coercionLKind kind_co) ]) $ - assert (isTyVar v || almostDevoidCoVarOfCo v co) $ + assertPpr (isTyVar v || (almostDevoidCoVarOfCo v co && + (v `elemVarSet` tyCoVarsOfCo co))) (ppr v $$ ppr co) $ mkNakedForAllCo v visL visR kind_co co -mkNakedForAllCo :: TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> CoercionN -> Coercion -> Coercion +mkNakedForAllCo :: TyVar -> ForAllTyFlag -> ForAllTyFlag -> CoercionN -> Coercion -> Coercion -- This version lacks the assertion checks. -- Used during type checking when the arguments may (legitimately) not be zonked -- and so the assertions might (bogusly) fail -mkNakedForAllCo v visL visR kind_co co - | Just (ty, r) <- isReflCo_maybe co +-- NB: since the coercions are un-zonked, we can't really deal with +-- Note [Unused coercion variable in ForAllCo]. Fortunately we don't have to: +-- this function is needed only for /type/ variables. +mkNakedForAllCo tv visL visR kind_co co + | assertPpr (isTyVar tv) (ppr tv) True + , Just (ty, r) <- isReflCo_maybe co , isGReflCo kind_co , visL `eqForAllVis` visR - = mkReflCo r (mkTyCoForAllTy v visL ty) + = mkReflCo r (mkForAllTy (Bndr tv visL) ty) | otherwise - = ForAllCo { fco_tcv = v, fco_visL = visL, fco_visR = visR + = ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR , fco_kind = kind_co, fco_body = co } --- | Like 'mkForAllCo', but the inner coercion shouldn't be an obvious --- reflexive coercion. For example, it is guaranteed in 'mkForAllCos'. +-- | Like 'mkForAllCo', but there is no need to check that the inner coercion isn't Refl; +-- the caller has done that. (For example, it is guaranteed in 'mkHomoForAllCos'.) -- The kind of the tycovar should be the left-hand kind of the kind coercion. mkForAllCo_NoRefl :: TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> CoercionN -> Coercion -> Coercion mkForAllCo_NoRefl v visL visR kind_co co | assert (varType v `eqType` (coercionLKind kind_co)) True , assert (not (isReflCo co)) True , isCoVar v + , assertPpr (visL == coreTyLamForAllTyFlag && visR == coreTyLamForAllTyFlag) + (ppr v <+> ppr visL <+> ppr visR) True , assert (almostDevoidCoVarOfCo v co) True , not (v `elemVarSet` tyCoVarsOfCo co) + -- We must test this to decide whether to build a FunCo or a ForAllCo + -- See Note [Unused coercion variable in ForAllCo] = mkFunCoNoFTF (coercionRole co) (multToCo ManyTy) kind_co co -- Functions from coercions are always unrestricted | otherwise ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1769,9 +1769,10 @@ mkTyCoForAllTy :: TyCoVar -> ForAllTyFlag -> Type -> Type mkTyCoForAllTy tv vis ty | isCoVar tv , not (tv `elemVarSet` tyCoVarsOfType ty) + -- See Note [Unused coercion variable in ForAllCo] in GHC.Core.TyCo.Rep = mkVisFunTyMany (varType tv) ty | otherwise - = ForAllTy (Bndr tv vis) ty + = ForAllTy (mkForAllTyBinder tv vis) ty -- | Make a dependent forall over a TyCoVar mkTyCoForAllTys :: [ForAllTyBinder] -> Type -> Type ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -174,7 +174,8 @@ mkLamType v body_ty | isCoVar v , v `elemVarSet` tyCoVarsOfType body_ty - = mkForAllTy (Bndr v Required) body_ty + -- See Note [Unused coercion variable in ForAllTy] in GHC.Core.TyCo.Rep + = mkForAllTy (Bndr v coreTyLamForAllTyFlag) body_ty | otherwise = mkFunctionType (varMult v) (varType v) body_ty ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -752,7 +752,8 @@ isTyVarBinder (Bndr tcv _) = isTyVar tcv -- | Make a named binder mkForAllTyBinder :: vis -> TyCoVar -> VarBndr TyCoVar vis -mkForAllTyBinder vis var = Bndr var vis +mkForAllTyBinder vis var = assertPpr (isTyVar var || vis == coreTyLamForAllTyFlag) + Bndr var vis -- | Make a named binder -- 'var' should be a type variable View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04e69d6255545ea93bb576957c0f80de3a8f68a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04e69d6255545ea93bb576957c0f80de3a8f68a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 17:52:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 10 Jul 2023 13:52:09 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] 31 commits: Improve the situation with the stimes cycle Message-ID: <64ac454953936_1c29a5b1670957a8@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 01c43d80 by Ben Gamari at 2023-07-10T13:50:38-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - 818c5bb0 by Ben Gamari at 2023-07-10T13:50:49-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 29 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b68b981494d140bab48b523146a892217bc94c3f...818c5bb0f914c71bf5fb6c800fc4898326feeb9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b68b981494d140bab48b523146a892217bc94c3f...818c5bb0f914c71bf5fb6c800fc4898326feeb9b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 18:34:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 10 Jul 2023 14:34:43 -0400 Subject: [Git][ghc/ghc][wip/orig-thunk-info] compiler: Record original thunk info tables on stack Message-ID: <64ac4f4336c5e_1c29a5b164898710@gitlab.mail> Ben Gamari pushed to branch wip/orig-thunk-info at Glasgow Haskell Compiler / GHC Commits: d1c258db by Ben Gamari at 2023-07-10T14:34:34-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 15 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - docs/users_guide/debugging.rst - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_run/OrigThunkInfo.hs - + testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout - testsuite/tests/codeGen/should_run/all.T - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -41,6 +41,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -338,6 +338,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -576,6 +577,7 @@ codeGenFlags = EnumSet.fromList -- Flags that affect debugging information , Opt_DistinctConstructorTables , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2347,6 +2347,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -50,6 +50,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== docs/users_guide/debugging.rst ===================================== @@ -1115,6 +1115,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== rts/RtsSymbols.c ===================================== @@ -870,7 +870,8 @@ extern char **environ; SymI_HasDataProto(stg_unpack_cstring_utf8_info) \ SymI_HasDataProto(stg_upd_frame_info) \ SymI_HasDataProto(stg_bh_upd_frame_info) \ - SymI_HasProto(suspendThread) \ + SymI_HasDataProto(stg_orig_thunk_info_frame_info) \ + SymI_HasProto(suspendThread) \ SymI_HasDataProto(stg_takeMVarzh) \ SymI_HasDataProto(stg_readMVarzh) \ SymI_HasDataProto(stg_threadStatuszh) \ @@ -878,7 +879,7 @@ extern char **environ; SymI_HasDataProto(stg_tryTakeMVarzh) \ SymI_HasDataProto(stg_tryReadMVarzh) \ SymI_HasDataProto(stg_unmaskAsyncExceptionszh) \ - SymI_HasProto(unloadObj) \ + SymI_HasProto(unloadObj) \ SymI_HasDataProto(stg_unsafeThawArrayzh) \ SymI_HasDataProto(stg_waitReadzh) \ SymI_HasDataProto(stg_waitWritezh) \ @@ -892,7 +893,7 @@ extern char **environ; SymI_NeedsProto(stg_interp_constr5_entry) \ SymI_NeedsProto(stg_interp_constr6_entry) \ SymI_NeedsProto(stg_interp_constr7_entry) \ - SymI_HasDataProto(stg_arg_bitmaps) \ + SymI_HasDataProto(stg_arg_bitmaps) \ SymI_HasProto(large_alloc_lim) \ SymI_HasProto(g0) \ SymI_HasProto(allocate) \ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -52,6 +52,7 @@ RTS_RET(stg_upd_frame); RTS_RET(stg_bh_upd_frame); RTS_RET(stg_marked_upd_frame); RTS_RET(stg_noupd_frame); +RTS_RET(stg_orig_thunk_info_frame); RTS_RET(stg_catch_frame); RTS_RET(stg_catch_retry_frame); RTS_RET(stg_atomically_frame); ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.hs ===================================== @@ -0,0 +1,4 @@ +module Main where +xs = iterate (+1) 0 +ten = xs !! 10 +main = print ten ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout ===================================== @@ -0,0 +1,2 @@ +10 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,4 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) +test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1c258db65eb752a6981750a59f33a3410389356 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1c258db65eb752a6981750a59f33a3410389356 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 20:46:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 10 Jul 2023 16:46:32 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 18 commits: rts: Work around missing prototypes errors Message-ID: <64ac6e28ea4f0_1c29a5b16e8116662@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 242ec490 by Ben Gamari at 2023-07-10T16:46:08-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. (cherry picked from commit 5b6612bc4f6b0a7ecc9868750bee1c359ffca871) - - - - - 7985f647 by Ben Gamari at 2023-07-10T16:46:08-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files (cherry picked from commit 8b35e8caafeeccbf06b7faa70e807028a3f0ff43) - - - - - 55421d97 by Ben Gamari at 2023-07-10T16:46:08-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. (cherry picked from commit d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8) - - - - - d8f068c7 by Ben Gamari at 2023-07-10T16:46:08-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. (cherry picked from commit 7c7d1f66d35f73a2faa898a33aa80cd276159dc2) - - - - - 809a56d5 by Ben Gamari at 2023-07-10T16:46:08-04:00 rts: Various warnings fixes (cherry picked from commit cb92051e3d85575ff6abd753c9b135930cc50cf8) - - - - - 99feb974 by Ben Gamari at 2023-07-10T16:46:08-04:00 hadrian: Ignore warnings in unix and semaphore-compat (cherry picked from commit dec81dd1fd0475dde4929baae625d155387300bb) - - - - - e6856716 by Matthew Pickering at 2023-07-10T16:46:08-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 (cherry picked from commit d7f6448aa06bbf26173a06ee5c624f5b734786c5) - - - - - ca23ac73 by Ben Gamari at 2023-07-10T16:46:08-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. (cherry picked from commit fd8c57694a00f6359bd66365f1284388c869ac60) - - - - - b2547b7b by Luite Stegeman at 2023-07-10T16:46:08-04:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 (cherry picked from commit 564164ef323a9f2cdeb8c69dcb2cf6df6382de4e) - - - - - e9d60ded by Torsten Schmits at 2023-07-10T16:46:08-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 (cherry picked from commit 40f4ef7c40e747dfea491d297475458d2ccaf860) - - - - - ac34de33 by Torsten Schmits at 2023-07-10T16:46:08-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 (cherry picked from commit 6fdcf969db85f3fe64123ba150e9226a0d2995cd) - - - - - 51192fc9 by Ben Bellick at 2023-07-10T16:46:08-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure (cherry picked from commit 03f941f45607a5ee52ca53a358333bbb41ddb1bc) - - - - - 2f5f8714 by aadaa_fgtaa at 2023-07-10T16:46:08-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts (cherry picked from commit b3e1436f968c0c36a27ea0339ee2554970b329fe) - - - - - a5ac7bde by Moisés Ackerman at 2023-07-10T16:46:08-04:00 Add failing test case for #23492 (cherry picked from commit 6074cc3cda9b9836c784942a1aa7f766fb142787) - - - - - f5e42371 by Moisés Ackerman at 2023-07-10T16:46:08-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. (cherry picked from commit 356a269258a50bf67811fe0edb193fc9f82dfad1) - - - - - d1314153 by Moisés Ackerman at 2023-07-10T16:46:08-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils (cherry picked from commit 3efe7f399a53ec7930c8a333ad2c114d956f0c2a) - - - - - ec90f619 by Moisés Ackerman at 2023-07-10T16:46:08-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors (cherry picked from commit dd782343f131cfd983a7fb2431d9d4a9ae497551) - - - - - 1c1d7a9f by Ben Gamari at 2023-07-10T16:46:08-04:00 Fix breakpoint - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - hadrian/src/Flavour.hs - hadrian/src/Rules/Documentation.hs - libraries/base/include/HsBase.h - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - libraries/ghci/GHCi/FFI.hsc - rts/Disassembler.c - rts/Interpreter.c - rts/Linker.c - rts/LinkerInternals.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8ed0c85072b8f5aad730506e79f41c66705c4fe...1c1d7a9f003ed2a9e85b83722c52de1d0c40f096 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8ed0c85072b8f5aad730506e79f41c66705c4fe...1c1d7a9f003ed2a9e85b83722c52de1d0c40f096 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 20:59:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 10 Jul 2023 16:59:07 -0400 Subject: [Git][ghc/ghc][master] Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) Message-ID: <64ac711b6a67b_1c29a5b16d41208a9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 7 changed files: - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint/Ppr.hs - + testsuite/tests/module/T20007.hs - + testsuite/tests/module/T20007.stderr - testsuite/tests/module/all.T Changes: ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -2139,11 +2139,12 @@ badImportItemErr -> TcRn ImportLookupReason badImportItemErr iface decl_spec ie sub avails = do patsyns_enabled <- xoptM LangExt.PatternSynonyms - pure (ImportLookupBad importErrorKind iface decl_spec ie patsyns_enabled) + expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces + pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled) where - importErrorKind + importErrorKind expl_ns_enabled | any checkIfTyCon avails = case sub of - BadImportIsParent -> BadImportAvailTyCon + BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren | any checkIfVarName avails = BadImportAvailVar | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3108,7 +3108,9 @@ instance Diagnostic TcRnMessage where in case k of BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] BadImportNotExported -> noHints - BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] + BadImportAvailTyCon ex_ns -> + [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns] + ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints TcRnImportLookup{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5263,7 +5263,9 @@ data BadImportKind -- | Module does not export... = BadImportNotExported -- | Missing @type@ keyword when importing a type. - | BadImportAvailTyCon + -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+) + -- Then we want to suggest using `import TypeLits( type (+) )` + | BadImportAvailTyCon Bool -- ^ is ExplicitNamespaces enabled? -- | Trying to import a data constructor directly, e.g. -- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@ | BadImportAvailDataCon OccName ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -310,12 +310,12 @@ pprImportSuggestion occ_name (CouldUnhideFrom mods) | (mod,imv) <- NE.toList mods ]) pprImportSuggestion occ_name (CouldAddTypeKeyword mod) - = vcat [ text "Add the" <+> quotes (text "type") + = vcat [ text "Add the" <+> quotes (text "type") <+> text "keyword to the import statement:" - , nest 2 $ text "import" + , nest 2 $ text "import" <+> ppr mod <+> parens_sp (text "type" <+> pprPrefixOcc occ_name) - ] + ] where parens_sp d = parens (space <> d <> space) pprImportSuggestion occ_name (CouldRemoveTypeKeyword mod) ===================================== testsuite/tests/module/T20007.hs ===================================== @@ -0,0 +1 @@ +import Data.Type.Equality ( (~) ) ===================================== testsuite/tests/module/T20007.stderr ===================================== @@ -0,0 +1,8 @@ + +T20007.hs:1:29: [GHC-56449] + In the import of ‘Data.Type.Equality’: + an item called ‘(~)’ is exported, but it is a type. + Suggested fixes: + Use ExplicitNamespaces + Add the ‘type’ keyword to the import statement: + import Data.Type.Equality ( type (~) ) ===================================== testsuite/tests/module/all.T ===================================== @@ -298,3 +298,4 @@ test('T21752', [extra_files(['T21752A.hs', 'T21752.hs'])], multimod_compile, ['T test('TupleTyConUserSyntax', [extra_files(['TupleTyConUserSyntaxA.hs', 'TupleTyConUserSyntax.hs'])], multimod_compile, ['TupleTyConUserSyntax', '-v0']) test('T21826', normal, compile_fail, ['']) +test('T20007', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e11630ec9669414b0b37a3097fb509d60702b0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e11630ec9669414b0b37a3097fb509d60702b0a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 20:59:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 10 Jul 2023 16:59:53 -0400 Subject: [Git][ghc/ghc][master] tyThingLocalGREs: include all DataCons for RecFlds Message-ID: <64ac7149d2419_1c29a5b16981262cf@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - 1 changed file: - compiler/GHC/Types/TyThing.hs Changes: ===================================== compiler/GHC/Types/TyThing.hs ===================================== @@ -28,6 +28,7 @@ where import GHC.Prelude +import GHC.Types.GREInfo import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.Var @@ -52,6 +53,11 @@ import Control.Monad ( liftM ) import Control.Monad.Trans.Reader import Control.Monad.Trans.Class +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import Data.List ( intersect ) + + {- Note [ATyCon for classes] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -301,15 +307,24 @@ tyThingLocalGREs ty_thing = | dc <- dcs , let con_info = conLikeConInfo (RealDataCon dc) ] AConLike con -> - let par = case con of - PatSynCon {} -> NoParent - -- NoParent for local pattern synonyms as per - -- Note [Parents] in GHC.Types.Name.Reader. - RealDataCon dc -> ParentIs $ tyConName $ dataConTyCon dc - in - myself par : - mkLocalFieldGREs par - [(conLikeConLikeName con, conLikeConInfo con)] + let (par, cons_flds) = case con of + PatSynCon {} -> + (NoParent, [(conLikeConLikeName con, conLikeConInfo con)]) + -- NB: NoParent for local pattern synonyms, as per + -- Note [Parents] in GHC.Types.Name.Reader. + RealDataCon dc1 -> + (ParentIs $ tyConName $ dataConTyCon dc1 + , [ (DataConName $ dataConName $ dc, ConHasRecordFields (fld :| flds)) + | dc <- tyConDataCons $ dataConTyCon dc1 + -- Go through all the data constructors of the parent TyCon, + -- to ensure that all the record fields have the correct set + -- of parent data constructors. See #23546. + , let con_info = conLikeConInfo (RealDataCon dc) + , ConHasRecordFields flds0 <- [con_info] + , let flds1 = NE.toList flds0 `intersect` dataConFieldLabels dc + , fld:flds <- [flds1] + ]) + in myself par : mkLocalFieldGREs par cons_flds AnId id | RecSelId { sel_tycon = RecSelData tc } <- idDetails id -> [ myself (ParentIs $ tyConName tc) ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61b1932eb7d529263330dcab404909997610dd43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61b1932eb7d529263330dcab404909997610dd43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 21:00:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 10 Jul 2023 17:00:29 -0400 Subject: [Git][ghc/ghc][master] EPA: Simplify GHC/Parser.y comb3 Message-ID: <64ac716d57857_1c29a5b1648129977@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,14 +1026,14 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } - | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } - | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } @@ -1371,7 +1371,7 @@ inst_decl :: { LInstDecl GhcPs } , cid_tyfam_insts = ats , cid_overlap_mode = $2 , cid_datafam_insts = adts } - ; acsA (\cs -> L (comb3 $1 (reLoc $3) $4) + ; acsA (\cs -> L (comb3 $1 $3 $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid cs })) } } @@ -1498,7 +1498,7 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } at_decl_cls :: { LHsDecl GhcPs } : -- data family declarations, with optional 'family' keyword 'data' opt_family type opt_datafam_kind_sig - {% liftM mkTyClD (mkFamDecl (comb3 $1 (reLoc $3) $4) DataFamily NotTopLevel $3 + {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3 (snd $ unLoc $4) Nothing (mj AnnData $1:$2++(fst $ unLoc $4))) } @@ -1506,13 +1506,13 @@ at_decl_cls :: { LHsDecl GhcPs } -- (can't use opt_instance because you get shift/reduce errors | 'type' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $2) $3) OpenTypeFamily NotTopLevel $2 + (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2 (fst . snd $ unLoc $3) (snd . snd $ unLoc $3) (mj AnnType $1:(fst $ unLoc $3)) )} | 'type' 'family' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $3) $4) OpenTypeFamily NotTopLevel $3 + (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3 (fst . snd $ unLoc $4) (snd . snd $ unLoc $4) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))} @@ -1651,7 +1651,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } role_annot :: { LRoleAnnotDecl GhcPs } role_annot : 'type' 'role' oqtycon maybe_roles - {% mkRoleAnnotDecl (comb3N $1 $4 $3) $3 (reverse (unLoc $4)) + {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4)) [mj AnnType $1,mj AnnRole $2] } -- Reversed! @@ -2594,7 +2594,7 @@ decl :: { LHsDecl GhcPs } rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } : '=' exp wherebinds {% runPV (unECP $2) >>= \ $2 -> do { let L l (bs, csw) = adaptWhereBinds $3 - ; let loc = (comb3 $1 (reLoc $2) (L l bs)) + ; let loc = (comb3 $1 $2 (L l bs)) ; acs (\cs -> sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2) bs)) } } @@ -2907,7 +2907,7 @@ aexp :: { ECP } | 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) -> return $ ECP $ $4 >>= \ $4 -> - mkHsCasePV (comb3 $1 $3 (reLoc $4)) $2 $4 + mkHsCasePV (comb3 $1 $3 $4) $2 $4 (EpAnnHsCase (glAA $1) (glAA $3) []) } -- QualifiedDo. | DO stmtlist {% do @@ -4090,17 +4090,9 @@ stringLiteralToHsDocWst = lexStringLiteral parseIdentifier comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan comb2 a b = a `seq` b `seq` combineHasLocs a b -comb3 :: Located a -> Located b -> Located c -> SrcSpan +comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c)) - -comb3A :: Located a -> Located b -> LocatedAn t c -> SrcSpan -comb3A a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) - -comb3N :: Located a -> Located b -> LocatedN c -> SrcSpan -comb3N a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) + combineSrcSpans (getHasLoc a) (combineHasLocs b c) comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6627cbd4bcf37553d625af5224fc1f54c8df4cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6627cbd4bcf37553d625af5224fc1f54c8df4cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 21:01:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 10 Jul 2023 17:01:30 -0400 Subject: [Git][ghc/ghc][master] Document that compareByteArrays# is available since ghc-prim-0.5.2.0 Message-ID: <64ac71aa96b48_1c29a5b16341332e0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 1 changed file: - compiler/GHC/Builtin/primops.txt.pp Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1953,7 +1953,9 @@ primop CompareByteArraysOp "compareByteArrays#" GenPrimOp specified ranges, but this is not checked. Returns an 'Int#' less than, equal to, or greater than zero if the range is found, respectively, to be byte-wise lexicographically less than, to - match, or be greater than the second range.} + match, or be greater than the second range. + + @since 0.5.2.0} with can_fail = True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee20da340e5a9082637d05f4d72a5f64e3863316 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee20da340e5a9082637d05f4d72a5f64e3863316 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 21:02:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 10 Jul 2023 17:02:05 -0400 Subject: [Git][ghc/ghc][master] Revert "Bump text submodule" Message-ID: <64ac71cdc3eb7_1c29a5b1634136614@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - 1 changed file: - libraries/text Changes: ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f +Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4926af7b018212356e9966685717c24a8da04030 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4926af7b018212356e9966685717c24a8da04030 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 21:29:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 10 Jul 2023 17:29:33 -0400 Subject: [Git][ghc/ghc][wip/T22011] rts: Add generator for RtsSymbols from libgcc Message-ID: <64ac783d6f9f_1c29a5b16341406b6@gitlab.mail> Ben Gamari pushed to branch wip/T22011 at Glasgow Haskell Compiler / GHC Commits: 2aae49ae by Ben Gamari at 2023-07-10T17:29:25-04:00 rts: Add generator for RtsSymbols from libgcc - - - - - 5 changed files: - hadrian/src/Flavour.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - rts/RtsSymbols.c - + rts/gen_libgcc_symbols.py Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -142,6 +142,8 @@ werror = [ arg "-optc-Werror" -- clang complains about #pragma GCC pragmas , arg "-optc-Wno-error=unknown-pragmas" + -- RtsSymbols.c ascribes the wrong type to some builtins + , arg "-optc-Wno-error=builtin-declaration-mismatch" -- rejected inlinings are highly dependent upon toolchain and way , arg "-optc-Wno-error=inline" ] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -59,21 +59,26 @@ rtsDependencies = do jsTarget <- expr isJsTarget useSystemFfi <- expr (flag UseSystemFfi) - let -- headers common to native and JS RTS + let in_include file = rtsPath -/- "include" -/- file + + -- headers common to native and JS RTS common_headers = + map in_include [ "ghcautoconf.h", "ghcplatform.h" , "DerivedConstants.h" ] -- headers specific to the native RTS native_headers = + map in_include [ "rts" -/- "EventTypes.h" , "rts" -/- "EventLogConstants.h" ] - ++ (if useSystemFfi then [] else libffiHeaderFiles) + ++ (if useSystemFfi then [] else map in_include libffiHeaderFiles) + ++ [ in_include $ rtsPath -/- "LibgccSymbols.h" ] headers | jsTarget = common_headers | otherwise = common_headers ++ native_headers - pure $ ((rtsPath -/- "include") -/-) <$> headers + pure headers genapplyDependencies :: Expr [FilePath] genapplyDependencies = do @@ -166,7 +171,7 @@ generatePackageCode context@(Context stage pkg _ _) = do [accessOpsSource, "addr-access-ops", file] [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] + need [primopsSource, ba_ops_txt, addr_ops_txt] -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] @@ -180,13 +185,37 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "include/DerivedConstants.h" %> genPlatformConstantsHeader context root -/- "**" -/- dir -/- "include/rts/EventLogConstants.h" %> genEventTypes "--event-types-defines" root -/- "**" -/- dir -/- "include/rts/EventTypes.h" %> genEventTypes "--event-types-array" + root -/- "**" -/- dir -/- "LibgccSymbols.h" %> genLibgccSymbols context + +genLibgccSymbols :: Context -> FilePath -> Action () +genLibgccSymbols (Context stage _ _ _) outFile = do + libgcc <- getLibgccPath + need [script] + runBuilder Python [script, libgcc, "-o", outFile] [] [] + where + script = "rts" -/- "gen_libgcc_symbols.py" + + getLibgccPath :: Action FilePath + getLibgccPath = do + let builder = Cc CompileC stage + needBuilders [builder] + path <- builderPath builder + StdoutTrim libgcc <- quietly $ cmd [path] ["-print-libgcc-file-name"] + + -- Annoyingly, Apple's toolchain returns the non-existent + -- libclang_rt.builtins-aarch64.a when asked to -print-libgcc-file-name. + -- However, the file is actually called libclang_rt.osx.a + osx <- isOsxTarget + pure $ if osx + then replaceFileName libgcc "libclang_rt.osx.a" + else libgcc genEventTypes :: String -> FilePath -> Action () genEventTypes flag file = do - need ["rts" -/- "gen_event_types.py"] - runBuilder Python - ["rts" -/- "gen_event_types.py", flag, file] - [] [] + need [script] + runBuilder Python [script, flag, file] [] [] + where + script = "rts" -/- "gen_event_types.py" genPrimopCode :: Context -> FilePath -> Action () genPrimopCode context@(Context stage _pkg _ _) file = do ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -212,6 +212,7 @@ buildConfInplace rs context at Context {..} _conf = do , path -/- "include/ghcplatform.h" , path -/- "include/rts/EventLogConstants.h" , path -/- "include/rts/EventTypes.h" + , path -/- "LibgccSymbols.h" ] -- we need to generate this file for GMP ===================================== rts/RtsSymbols.c ===================================== @@ -947,26 +947,6 @@ extern char **environ; RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS -// 64-bit support functions in libgcc.a -#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32) -#define RTS_LIBGCC_SYMBOLS \ - SymI_NeedsProto(__divdi3) \ - SymI_NeedsProto(__udivdi3) \ - SymI_NeedsProto(__moddi3) \ - SymI_NeedsProto(__umoddi3) \ - SymI_NeedsProto(__muldi3) \ - SymI_NeedsProto(__ashldi3) \ - SymI_NeedsProto(__ashrdi3) \ - SymI_NeedsProto(__lshrdi3) \ - SymI_NeedsProto(__fixunsdfdi) -#elif defined(__GNUC__) && SIZEOF_VOID_P == 8 -#define RTS_LIBGCC_SYMBOLS \ - SymI_NeedsProto(__udivti3) \ - SymI_NeedsProto(__umodti3) -#else -#define RTS_LIBGCC_SYMBOLS -#endif - // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -983,6 +963,10 @@ extern char **environ; #define RTS_FINI_ARRAY_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt. This file is generated by +// gen_libgcc_symbols.py. +#include "LibgccSymbols.h" + /* entirely bogus claims about types of these symbols */ #define SymI_NeedsProto(vvv) extern void vvv(void); #define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; @@ -1055,9 +1039,6 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS -#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) -#include "AArch64Symbols.h" -#endif SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, ===================================== rts/gen_libgcc_symbols.py ===================================== @@ -0,0 +1,33 @@ +#!/usr/bin/env python3 + +import sys +import subprocess +import argparse +from typing import Set +from pathlib import Path + +def list_symbols(lib: Path) -> Set[str]: + out = subprocess.check_output([ + 'nm', '--format=posix', '--extern-only', '--defined-only', lib + ], encoding='ASCII') + syms = set() + for l in out.split('\n'): + parts = l.split(' ') + if len(parts) == 4: + syms.add(parts[0]) + + return syms + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('libgcc', type=Path, help='path to libgcc') + parser.add_argument('-o', '--output', default=sys.stdout, type=argparse.FileType('w'), help='output file name') + args = parser.parse_args() + + syms = list_symbols(args.libgcc) + lines = [ '#define RTS_LIBGCC_SYMBOLS' ] + lines += [ f' SymE_NeedsProto({sym})' for sym in sorted(syms) ] + print(' \\\n'.join(lines), file=args.output) + +if __name__ == '__main__': + main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2aae49ae630af5cab90712d8d1da6af150dfda85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2aae49ae630af5cab90712d8d1da6af150dfda85 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 21:37:40 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 10 Jul 2023 17:37:40 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 102 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64ac7a248f019_1c29a5b16ac1442b3@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - d62c36e1 by Matthew Craven at 2023-07-10T19:54:41+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 14a4b8c8 by Simon Peyton Jones at 2023-07-10T19:54:41+01:00 Fix to eta expansion See new function GHC.Core.Opt.Arity.mkEtaForAllMCo. - - - - - 9e9f606f by Simon Peyton Jones at 2023-07-10T20:14:33+01:00 Wibbles... in progress...may not compile - - - - - 93ae5f58 by Simon Peyton Jones at 2023-07-10T22:36:32+01:00 Tidy up handing of ForAllCo over a coercion variable ..following a conversation with Richard - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/MachOp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04e69d6255545ea93bb576957c0f80de3a8f68a9...93ae5f58e2ac2283e3856b4f35f2b6d1b3059d2b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04e69d6255545ea93bb576957c0f80de3a8f68a9...93ae5f58e2ac2283e3856b4f35f2b6d1b3059d2b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 10 22:05:11 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Mon, 10 Jul 2023 18:05:11 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-sll] 32 commits: Substitute free variables captured by breakpoints in SpecConstr Message-ID: <64ac809740295_1c29a5b16ac15082f@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-sll at Glasgow Haskell Compiler / GHC Commits: 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - c87df532 by Alan Zimmerman at 2023-07-10T22:54:58+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Linker/Linker.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57d22fd582386fa7a9a1a39a89d7108f1cb94ffa...c87df5325fbc4382bbe5a02446d27a60802b815f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57d22fd582386fa7a9a1a39a89d7108f1cb94ffa...c87df5325fbc4382bbe5a02446d27a60802b815f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 07:37:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 11 Jul 2023 03:37:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) Message-ID: <64ad06a85efb9_1c29a5b16701815bc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - 03a6d5aa by Ben Gamari at 2023-07-11T03:36:54-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - a5473949 by Ben Gamari at 2023-07-11T03:36:54-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - e96c949e by Jaro Reinders at 2023-07-11T03:36:55-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 28 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/TyThing.hs - compiler/cbits/genSym.c - docs/users_guide/debugging.rst - libraries/text - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_run/OrigThunkInfo.hs - + testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/module/T20007.hs - + testsuite/tests/module/T20007.stderr - testsuite/tests/module/all.T - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1953,7 +1953,9 @@ primop CompareByteArraysOp "compareByteArrays#" GenPrimOp specified ranges, but this is not checked. Returns an 'Int#' less than, equal to, or greater than zero if the range is found, respectively, to be byte-wise lexicographically less than, to - match, or be greater than the second range.} + match, or be greater than the second range. + + @since 0.5.2.0} with can_fail = True ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -41,6 +41,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -5,6 +5,7 @@ module GHC.Driver.Flags , GeneralFlag(..) , Language(..) , optimisationFlags + , codeGenFlags -- * Warnings , WarningGroup(..) @@ -337,6 +338,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -484,15 +486,11 @@ data GeneralFlag | Opt_G_NoOptCoercion deriving (Eq, Show, Enum) --- Check whether a flag should be considered an "optimisation flag" --- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is --- not a guarantee that the flag has no other effect. We could, and --- perhaps should, separate out the flags that have some minor impact on --- program semantics and/or error behavior (e.g., assertions), but --- then we'd need to go to extra trouble (and an additional flag) --- to allow users to ignore the optimisation level even though that --- means ignoring some change. +-- | The set of flags which affect optimisation for the purposes of +-- recompilation avoidance. Specifically, these include flags which +-- affect code generation but not the semantics of the program. +-- +-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags) optimisationFlags :: EnumSet GeneralFlag optimisationFlags = EnumSet.fromList [ Opt_CallArity @@ -524,16 +522,12 @@ optimisationFlags = EnumSet.fromList , Opt_EnableRewriteRules , Opt_RegsGraph , Opt_RegsIterative - , Opt_PedanticBottoms , Opt_LlvmTBAA - , Opt_LlvmFillUndefWithGarbage , Opt_IrrefutableTuples , Opt_CmmSink , Opt_CmmElimCommonBlocks , Opt_AsmShortcutting - , Opt_OmitYields , Opt_FunToThunk - , Opt_DictsStrict , Opt_DmdTxDictSel , Opt_Loopification , Opt_CfgBlocklayout @@ -542,8 +536,48 @@ optimisationFlags = EnumSet.fromList , Opt_WorkerWrapper , Opt_WorkerWrapperUnlift , Opt_SolveConstantDicts + ] + +-- | The set of flags which affect code generation and can change a program's +-- runtime behavior (other than performance). These include flags which affect: +-- +-- * user visible debugging information (e.g. info table provenance) +-- * the ability to catch runtime errors (e.g. -fignore-asserts) +-- * the runtime result of the program (e.g. -fomit-yields) +-- * which code or interface file declarations are emitted +-- +-- We also considered placing flags which affect asympototic space behavior +-- (e.g. -ffull-laziness) however this would mean that changing optimisation +-- levels would trigger recompilation even with -fignore-optim-changes, +-- regressing #13604. +-- +-- Also, arguably Opt_IgnoreAsserts should be here as well; however, we place +-- it instead in 'optimisationFlags' since it is implied by @-O[12]@ and +-- therefore would also break #13604. +-- +-- See #23369. +codeGenFlags :: EnumSet GeneralFlag +codeGenFlags = EnumSet.fromList + [ -- Flags that affect runtime result + Opt_EagerBlackHoling + , Opt_ExcessPrecision + , Opt_DictsStrict + , Opt_PedanticBottoms + , Opt_OmitYields + + -- Flags that affect generated code + , Opt_ExposeAllUnfoldings + , Opt_NoTypeableBinds + + -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases - , Opt_IgnoreAsserts + , Opt_LlvmFillUndefWithGarbage + , Opt_DoTagInferenceChecks + + -- Flags that affect debugging information + , Opt_DistinctConstructorTables + , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Driver.Session ( makeDynFlagsConsistent, positionIndependent, optimisationFlags, + codeGenFlags, setFlagsFromEnvFile, pprDynFlagsDiff, flagSpecOf, @@ -2346,6 +2347,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Other flags which affect code generation + codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,14 +1026,14 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } - | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> ; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } - | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 (comb3 . reLoc) $1) $2 (reLoc $>) + | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } @@ -1371,7 +1371,7 @@ inst_decl :: { LInstDecl GhcPs } , cid_tyfam_insts = ats , cid_overlap_mode = $2 , cid_datafam_insts = adts } - ; acsA (\cs -> L (comb3 $1 (reLoc $3) $4) + ; acsA (\cs -> L (comb3 $1 $3 $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid cs })) } } @@ -1498,7 +1498,7 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } at_decl_cls :: { LHsDecl GhcPs } : -- data family declarations, with optional 'family' keyword 'data' opt_family type opt_datafam_kind_sig - {% liftM mkTyClD (mkFamDecl (comb3 $1 (reLoc $3) $4) DataFamily NotTopLevel $3 + {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3 (snd $ unLoc $4) Nothing (mj AnnData $1:$2++(fst $ unLoc $4))) } @@ -1506,13 +1506,13 @@ at_decl_cls :: { LHsDecl GhcPs } -- (can't use opt_instance because you get shift/reduce errors | 'type' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $2) $3) OpenTypeFamily NotTopLevel $2 + (mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2 (fst . snd $ unLoc $3) (snd . snd $ unLoc $3) (mj AnnType $1:(fst $ unLoc $3)) )} | 'type' 'family' type opt_at_kind_inj_sig {% liftM mkTyClD - (mkFamDecl (comb3 $1 (reLoc $3) $4) OpenTypeFamily NotTopLevel $3 + (mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3 (fst . snd $ unLoc $4) (snd . snd $ unLoc $4) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))} @@ -1651,7 +1651,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } role_annot :: { LRoleAnnotDecl GhcPs } role_annot : 'type' 'role' oqtycon maybe_roles - {% mkRoleAnnotDecl (comb3N $1 $4 $3) $3 (reverse (unLoc $4)) + {% mkRoleAnnotDecl (comb3 $1 $4 $3) $3 (reverse (unLoc $4)) [mj AnnType $1,mj AnnRole $2] } -- Reversed! @@ -2594,7 +2594,7 @@ decl :: { LHsDecl GhcPs } rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } : '=' exp wherebinds {% runPV (unECP $2) >>= \ $2 -> do { let L l (bs, csw) = adaptWhereBinds $3 - ; let loc = (comb3 $1 (reLoc $2) (L l bs)) + ; let loc = (comb3 $1 $2 (L l bs)) ; acs (\cs -> sL loc (GRHSs csw (unguardedRHS (EpAnn (anc $ rs loc) (GrhsAnn Nothing (mj AnnEqual $1)) cs) loc $2) bs)) } } @@ -2907,7 +2907,7 @@ aexp :: { ECP } | 'case' exp 'of' altslist(pats1) {% runPV (unECP $2) >>= \ ($2 :: LHsExpr GhcPs) -> return $ ECP $ $4 >>= \ $4 -> - mkHsCasePV (comb3 $1 $3 (reLoc $4)) $2 $4 + mkHsCasePV (comb3 $1 $3 $4) $2 $4 (EpAnnHsCase (glAA $1) (glAA $3) []) } -- QualifiedDo. | DO stmtlist {% do @@ -4090,17 +4090,9 @@ stringLiteralToHsDocWst = lexStringLiteral parseIdentifier comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan comb2 a b = a `seq` b `seq` combineHasLocs a b -comb3 :: Located a -> Located b -> Located c -> SrcSpan +comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c)) - -comb3A :: Located a -> Located b -> LocatedAn t c -> SrcSpan -comb3A a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) - -comb3N :: Located a -> Located b -> LocatedN c -> SrcSpan -comb3N a b c = a `seq` b `seq` c `seq` - combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLocA c)) + combineSrcSpans (getHasLoc a) (combineHasLocs b c) comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -2139,11 +2139,12 @@ badImportItemErr -> TcRn ImportLookupReason badImportItemErr iface decl_spec ie sub avails = do patsyns_enabled <- xoptM LangExt.PatternSynonyms - pure (ImportLookupBad importErrorKind iface decl_spec ie patsyns_enabled) + expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces + pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled) where - importErrorKind + importErrorKind expl_ns_enabled | any checkIfTyCon avails = case sub of - BadImportIsParent -> BadImportAvailTyCon + BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren | any checkIfVarName avails = BadImportAvailVar | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -50,6 +50,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3108,7 +3108,9 @@ instance Diagnostic TcRnMessage where in case k of BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] BadImportNotExported -> noHints - BadImportAvailTyCon -> [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] + BadImportAvailTyCon ex_ns -> + [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns] + ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints TcRnImportLookup{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5263,7 +5263,9 @@ data BadImportKind -- | Module does not export... = BadImportNotExported -- | Missing @type@ keyword when importing a type. - | BadImportAvailTyCon + -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+) + -- Then we want to suggest using `import TypeLits( type (+) )` + | BadImportAvailTyCon Bool -- ^ is ExplicitNamespaces enabled? -- | Trying to import a data constructor directly, e.g. -- @import Data.Maybe (Just)@ instead of @import Data.Maybe (Maybe(Just))@ | BadImportAvailDataCon OccName ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -310,12 +310,12 @@ pprImportSuggestion occ_name (CouldUnhideFrom mods) | (mod,imv) <- NE.toList mods ]) pprImportSuggestion occ_name (CouldAddTypeKeyword mod) - = vcat [ text "Add the" <+> quotes (text "type") + = vcat [ text "Add the" <+> quotes (text "type") <+> text "keyword to the import statement:" - , nest 2 $ text "import" + , nest 2 $ text "import" <+> ppr mod <+> parens_sp (text "type" <+> pprPrefixOcc occ_name) - ] + ] where parens_sp d = parens (space <> d <> space) pprImportSuggestion occ_name (CouldRemoveTypeKeyword mod) ===================================== compiler/GHC/Types/TyThing.hs ===================================== @@ -28,6 +28,7 @@ where import GHC.Prelude +import GHC.Types.GREInfo import GHC.Types.Name import GHC.Types.Name.Reader import GHC.Types.Var @@ -52,6 +53,11 @@ import Control.Monad ( liftM ) import Control.Monad.Trans.Reader import Control.Monad.Trans.Class +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import Data.List ( intersect ) + + {- Note [ATyCon for classes] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -301,15 +307,24 @@ tyThingLocalGREs ty_thing = | dc <- dcs , let con_info = conLikeConInfo (RealDataCon dc) ] AConLike con -> - let par = case con of - PatSynCon {} -> NoParent - -- NoParent for local pattern synonyms as per - -- Note [Parents] in GHC.Types.Name.Reader. - RealDataCon dc -> ParentIs $ tyConName $ dataConTyCon dc - in - myself par : - mkLocalFieldGREs par - [(conLikeConLikeName con, conLikeConInfo con)] + let (par, cons_flds) = case con of + PatSynCon {} -> + (NoParent, [(conLikeConLikeName con, conLikeConInfo con)]) + -- NB: NoParent for local pattern synonyms, as per + -- Note [Parents] in GHC.Types.Name.Reader. + RealDataCon dc1 -> + (ParentIs $ tyConName $ dataConTyCon dc1 + , [ (DataConName $ dataConName $ dc, ConHasRecordFields (fld :| flds)) + | dc <- tyConDataCons $ dataConTyCon dc1 + -- Go through all the data constructors of the parent TyCon, + -- to ensure that all the record fields have the correct set + -- of parent data constructors. See #23546. + , let con_info = conLikeConInfo (RealDataCon dc) + , ConHasRecordFields flds0 <- [con_info] + , let flds1 = NE.toList flds0 `intersect` dataConFieldLabels dc + , fld:flds <- [flds1] + ]) + in myself par : mkLocalFieldGREs par cons_flds AnId id | RecSelId { sel_tycon = RecSelData tc } <- idDetails id -> [ myself (ParentIs $ tyConName tc) ] ===================================== compiler/cbits/genSym.c ===================================== @@ -9,7 +9,7 @@ // // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) HsWord64 ghc_unique_counter64 = 0; #endif #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) @@ -18,7 +18,7 @@ HsInt ghc_unique_inc = 1; // This function has been added to the RTS. Here we pessimistically assume // that a threaded RTS is used. This function is only used for bootstrapping. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr) { ===================================== docs/users_guide/debugging.rst ===================================== @@ -1115,6 +1115,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit a961985e63105e3c50035e7e8dab1d218332dd0f +Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e ===================================== rts/RtsSymbols.c ===================================== @@ -870,7 +870,8 @@ extern char **environ; SymI_HasDataProto(stg_unpack_cstring_utf8_info) \ SymI_HasDataProto(stg_upd_frame_info) \ SymI_HasDataProto(stg_bh_upd_frame_info) \ - SymI_HasProto(suspendThread) \ + SymI_HasDataProto(stg_orig_thunk_info_frame_info) \ + SymI_HasProto(suspendThread) \ SymI_HasDataProto(stg_takeMVarzh) \ SymI_HasDataProto(stg_readMVarzh) \ SymI_HasDataProto(stg_threadStatuszh) \ @@ -878,7 +879,7 @@ extern char **environ; SymI_HasDataProto(stg_tryTakeMVarzh) \ SymI_HasDataProto(stg_tryReadMVarzh) \ SymI_HasDataProto(stg_unmaskAsyncExceptionszh) \ - SymI_HasProto(unloadObj) \ + SymI_HasProto(unloadObj) \ SymI_HasDataProto(stg_unsafeThawArrayzh) \ SymI_HasDataProto(stg_waitReadzh) \ SymI_HasDataProto(stg_waitWritezh) \ @@ -892,7 +893,7 @@ extern char **environ; SymI_NeedsProto(stg_interp_constr5_entry) \ SymI_NeedsProto(stg_interp_constr6_entry) \ SymI_NeedsProto(stg_interp_constr7_entry) \ - SymI_HasDataProto(stg_arg_bitmaps) \ + SymI_HasDataProto(stg_arg_bitmaps) \ SymI_HasProto(large_alloc_lim) \ SymI_HasProto(g0) \ SymI_HasProto(allocate) \ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -52,6 +52,7 @@ RTS_RET(stg_upd_frame); RTS_RET(stg_bh_upd_frame); RTS_RET(stg_marked_upd_frame); RTS_RET(stg_noupd_frame); +RTS_RET(stg_orig_thunk_info_frame); RTS_RET(stg_catch_frame); RTS_RET(stg_catch_retry_frame); RTS_RET(stg_atomically_frame); ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.hs ===================================== @@ -0,0 +1,4 @@ +module Main where +xs = iterate (+1) 0 +ten = xs !! 10 +main = print ten ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout ===================================== @@ -0,0 +1,2 @@ +10 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,4 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) +test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) ===================================== testsuite/tests/module/T20007.hs ===================================== @@ -0,0 +1 @@ +import Data.Type.Equality ( (~) ) ===================================== testsuite/tests/module/T20007.stderr ===================================== @@ -0,0 +1,8 @@ + +T20007.hs:1:29: [GHC-56449] + In the import of ‘Data.Type.Equality’: + an item called ‘(~)’ is exported, but it is a type. + Suggested fixes: + Use ExplicitNamespaces + Add the ‘type’ keyword to the import statement: + import Data.Type.Equality ( type (~) ) ===================================== testsuite/tests/module/all.T ===================================== @@ -298,3 +298,4 @@ test('T21752', [extra_files(['T21752A.hs', 'T21752.hs'])], multimod_compile, ['T test('TupleTyConUserSyntax', [extra_files(['TupleTyConUserSyntaxA.hs', 'TupleTyConUserSyntax.hs'])], multimod_compile, ['TupleTyConUserSyntax', '-v0']) test('T21826', normal, compile_fail, ['']) +test('T20007', normal, compile_fail, ['']) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3593014222e996d67390d56cb9118772de5eef0...e96c949e48b373a2f235b33955884e64e9825a18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3593014222e996d67390d56cb9118772de5eef0...e96c949e48b373a2f235b33955884e64e9825a18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 07:38:53 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 11 Jul 2023 03:38:53 -0400 Subject: [Git][ghc/ghc][wip/T17521] Allow nested floating Message-ID: <64ad070d28661_1c29a5b16c01865f7@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: fa383daf by Jaro Reinders at 2023-07-11T09:38:46+02:00 Allow nested floating - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2032,8 +2032,10 @@ exprIsTickedString = isJust . exprIsTickedString_maybe -- | Check if the expression is an constructor possibly applied to trivial arguments. exprIsTrivialConApp :: CoreExpr -> Bool exprIsTrivialConApp x + | exprIsTrivial x + = True | (Var v, xs) <- collectArgs x - = isDataConWorkId v && all exprIsTrivial xs + = isDataConWorkId v && all exprIsTrivialConApp xs exprIsTrivialConApp _ = False -- | Extract a literal string from an expression that is zero or more Ticks View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa383daf696bbffdb8351da26abd15caeb61f335 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa383daf696bbffdb8351da26abd15caeb61f335 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 08:16:59 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 11 Jul 2023 04:16:59 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] 20 commits: Drop circle-ci-job.sh Message-ID: <64ad0ffb7f6e8_1c29a5b16341915b8@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - ffa60be2 by Matthew Pickering at 2023-07-11T09:16:17+01:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/TyThing.hs - compiler/GHC/Types/TyThing/Ppr.hs - docs/users_guide/phases.rst - docs/users_guide/using.rst - hadrian/src/Packages.hs - hadrian/src/Rules/Dependencies.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c1b7d3cf08da47f205044b1b9c96031c6431813...ffa60be2beb23551a36ed2bc9e773f6fba951afa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1c1b7d3cf08da47f205044b1b9c96031c6431813...ffa60be2beb23551a36ed2bc9e773f6fba951afa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 08:35:31 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 11 Jul 2023 04:35:31 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Wibbles Message-ID: <64ad14533413f_1c29a5b16ac197535@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 275cafcb by Simon Peyton Jones at 2023-07-11T08:32:51+01:00 Wibbles - - - - - 3 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/TyCo/Rep.hs - docs/core-spec/core-spec.mng Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2255,9 +2255,13 @@ lintCoercion co@(ForAllCo { fco_tcv = tcv, fco_visL = visL, fco_visR = visR ; lintForAllBody tcv' rty ; when (isCoVar tcv) $ - lintL (almostDevoidCoVarOfCo tcv body_co) $ - text "Covar can only appear in Refl and GRefl: " <+> ppr co - -- See (FC6) in Note [ForAllCo] in GHC.Core.TyCo.Rep + do { lintL (visL == coreTyLamForAllTyFlag && visR == coreTyLamForAllTyFlag) $ + text "Invalid visibility flags in CoVar ForAllCo" <+> ppr co + -- See (FC7) in Note [ForAllCo] in GHC.Core.TyCo.Rep + ; lintL (almostDevoidCoVarOfCo tcv body_co) $ + text "Covar can only appear in Refl and GRefl: " <+> ppr co + -- See (FC6) in Note [ForAllCo] in GHC.Core.TyCo.Rep + } ; when (body_role == Nominal) $ lintL (visL `eqForAllVis` visR) $ ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -878,7 +878,7 @@ data Coercion { fco_tcv :: TyCoVar , fco_visL :: !ForAllTyFlag -- Vvisibility of coercionLKind , fco_visR :: !ForAllTyFlag -- Visibility of coercionRKind - -- See (FC7) of Note [ForallCo] + -- See (FC7) of Note [ForAllCo] , fco_kind :: KindCoercion , fco_body :: Coercion } -- ForAllCo :: _ -> N -> e -> e @@ -1260,10 +1260,10 @@ Several things to note here * Even if cv occurs in body_co, it is possible that cv does not occur in the kind of body_co. Therefore the check in coercionKind is inevitable. -(FC6) Consider (ForAllCo cv kind_co body_co) where `cv` is a coercion variable. - We insist that `cv` appears only in positions that are erased. In fact we use +(FC6) Invariant: in a ForAllCo where fco_tcv is a coercion variable, `cv`, + we insist that `cv` appears only in positions that are erased. In fact we use a conservative approximation of this: we require that - (almostDevoidCoVarOfCo cv body_co) + (almostDevoidCoVarOfCo cv fco_body) holds. This function checks that `cv` appers only within the type in a Refl node and under a GRefl node (including in the Coercion stored in a GRefl). It's possible other places are OK, too, but this is a safe approximation. @@ -1282,7 +1282,7 @@ Several things to note here proved that the problem does not occur with homogeneous equality, so this check can be dropped once ~# is made to be homogeneous. -(FC7) In a ForAllCo, if fco_tcv is a CoVar, then +(FC7) Invariant: in a ForAllCo, if fco_tcv is a CoVar, then fco_visL = fco_visR = coreTyLamForAllTyFlag c.f. (FT2) in Note [ForAllTy] ===================================== docs/core-spec/core-spec.mng ===================================== @@ -223,8 +223,8 @@ be a type function. the payload in a \texttt{Refl} must not be built with \texttt{CoercionTy}. \item If $[[forall z: h .g]]$ is a polymorphic coercion over a coercion variable (i.e. $[[z]]$ is a coercion variable), then $[[z]]$ can only appear in - \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{Note [Unused coercion - variable in ForAllCo] in \ghcfile{GHC.Core.Coercion}}. + \texttt{Refl} and \texttt{GRefl} in $[[g]]$. See \texttt{(FC6) in Note [ForAllCo] + in \ghcfile{GHC.Core.TyCon.Rep}}. \item Prefer $[[g1 ->_R g2]]$ over $[[(->)_R g1 g2]]$; that is, we use \ctor{FunCo}, never \ctor{TyConAppCo}, for coercions over saturated uses of $[[->]]$. \end{itemize} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/275cafcb4f0045dde91c5ca1d0d564baf426afc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/275cafcb4f0045dde91c5ca1d0d564baf426afc4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 08:36:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 04:36:43 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fixes Message-ID: <64ad149b33d88_1c29a5b16e81984f2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 44ec49e2 by Rodrigo Mesquita at 2023-07-11T09:36:38+01:00 Fixes - - - - - 4 changed files: - TODO - default.host.target.in - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== TODO ===================================== @@ -4,3 +4,4 @@ Things that might get done on this or another MR [ ] Readelf is only used to find cc link, that OK? [ ] In hadrian/src/Rules/Generate.hs, generateGhcPlatformH, factor out the query into an argument to chooseSetting, to deduplicate it [ ] Get rid of all the ToolchainSettings in Hadrian still (e.g. settings-clang-command) +[ ] Write Note about dummy values in default.host.target ===================================== default.host.target.in ===================================== @@ -29,12 +29,12 @@ Target , arIsGnu = False , arSupportsAtFile = @ArSupportsAtFile_STAGE0Bool@ , arSupportsDashL = @ArSupportsDashL_STAGE0Bool@ -, arNeedsRanlib = False +, arNeedsRanlib = True } , tgtRanlib = Nothing -, tgtNm = Nm {nmProgram = Program {prgPath = "@NM@", prgFlags = []}} +, tgtNm = Nm {nmProgram = Program {prgPath = "", prgFlags = []}} , tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False}) -, tgtDllwrap = @DllWrapCmdMaybeProg@ -, tgtWindres = @WindresCmdMaybeProg@ +, tgtDllwrap = Nothing +, tgtWindres = Nothing } ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -101,7 +101,8 @@ checkCcSupportsExtraViaCFlags cc = checking "whether cc supports extra via-c fla test_c = test_o -<.> "c" writeFile test_c "int main() { return 0; }" (code, out, err) <- readProgram (ccProgram cc) - [ "-fwrapv", "-fno-builtin" + [ "-c" + , "-fwrapv", "-fno-builtin" , "-Werror", "-x", "c" , "-o", test_o, test_c] when (not (isSuccess code) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -24,7 +24,7 @@ newtype HsCpp = HsCpp { hsCppProgram :: Program findHsCpp :: ProgOpt -> Cc -> M HsCpp findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do -- Use the specified HS CPP or try to find one (candidate is the c compiler) - foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [prgPath $ ccProgram cc] + foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [takeFileName $ prgPath $ ccProgram cc] case poFlags progOpt of -- If the user specified HS CPP flags don't second-guess them Just _ -> return HsCpp{hsCppProgram=foundHsCppProg} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44ec49e257116f2e716d44736f99b5b7982b4d2f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44ec49e257116f2e716d44736f99b5b7982b4d2f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 08:39:39 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 11 Jul 2023 04:39:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/remove-build-mk Message-ID: <64ad154ba8951_1c29a5b16d4200738@gitlab.mail> Matthew Pickering pushed new branch wip/remove-build-mk at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/remove-build-mk You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 08:50:45 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 11 Jul 2023 04:50:45 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Wibble Message-ID: <64ad17e51d5c_1c29a5b16342177e7@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: f9541e0a by Simon Peyton Jones at 2023-07-11T09:50:33+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Coercion/Opt.hs Changes: ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -290,7 +290,8 @@ opt_co4 env sym rep r (AppCo co1 co2) = mkAppCo (opt_co4_wrap env sym rep r co1) (opt_co4_wrap env sym False Nominal co2) -opt_co4 env sym rep r (ForAllCo tv visL visR k_co co) +opt_co4 env sym rep r (ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR + , fco_kind = k_co, fco_body = co }) = case optForAllCoBndr env sym tv k_co of (env', tv', k_co') -> mkForAllCo tv' visL' visR' k_co' $ opt_co4_wrap env' sym rep r co View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9541e0a363de6ca0200991e7ee1d1c7d8415924 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9541e0a363de6ca0200991e7ee1d1c7d8415924 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 09:24:20 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 11 Jul 2023 05:24:20 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] wip Message-ID: <64ad1fc458c5d_1c29a5b16702426c@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: b1058ad9 by Andreas Klebinger at 2023-07-11T11:26:24+02:00 wip - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -656,7 +656,6 @@ getRegister' config plat expr (op, imm_code) <- litToImm' lit let rep = cmmLitType plat lit format = cmmTypeFormat rep - -- width = typeWidth rep return (Any format (\dst -> imm_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op)) CmmLabelOff lbl off -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1058ad980f98714db9354f9d94bb36f3ae4262d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1058ad980f98714db9354f9d94bb36f3ae4262d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 10:26:05 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 11 Jul 2023 06:26:05 -0400 Subject: [Git][ghc/ghc][wip/T17521] Fixes Message-ID: <64ad2e3dd2cbb_1c29a5b16ac2757a5@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 672b8a2f by Jaro Reinders at 2023-07-11T12:25:58+02:00 Fixes - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2022,21 +2022,28 @@ exprIsTopLevelBindable expr ty -- consequently we must use 'mightBeUnliftedType' rather than 'isUnliftedType', -- as the latter would panic. || exprIsTickedString expr - || exprIsTrivialConApp expr + || isBoxedType ty && exprIsNestedTrivialConApp expr -- | Check if the expression is zero or more Ticks wrapped around a literal -- string. exprIsTickedString :: CoreExpr -> Bool exprIsTickedString = isJust . exprIsTickedString_maybe --- | Check if the expression is an constructor possibly applied to trivial arguments. -exprIsTrivialConApp :: CoreExpr -> Bool -exprIsTrivialConApp x - | exprIsTrivial x - = True +-- | Check if the expression is trivial or a constructor application and +-- continue checking all arguments of that constructor recursively. +exprIsNestedTrivialConApp :: CoreExpr -> Bool +exprIsNestedTrivialConApp x | (Var v, xs) <- collectArgs x - = isDataConWorkId v && all exprIsTrivialConApp xs -exprIsTrivialConApp _ = False + = isDataConWorkId v && all go xs + where + go x + | exprIsTrivial x + = True + | (Var v, xs) <- collectArgs x + = isDataConWorkId v && all go xs + | otherwise + = False +exprIsNestedTrivialConApp _ = False -- | Extract a literal string from an expression that is zero or more Ticks -- wrapped around a literal string. Returns Nothing if the expression has a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/672b8a2f518babd8bce054500a961353470efabf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/672b8a2f518babd8bce054500a961353470efabf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 10:35:15 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 06:35:15 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Windows builtin toolchain Message-ID: <64ad3063591b9_1c29a5b1698276571@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f8689c72 by Rodrigo Mesquita at 2023-07-11T11:34:52+01:00 Windows builtin toolchain - - - - - 10 changed files: - default.host.target.in - default.target.in - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - + utils/ghc-toolchain/test - + utils/ghc-toolchain/test.c - + utils/ghc-toolchain/test.wasm Changes: ===================================== default.host.target.in ===================================== @@ -15,7 +15,7 @@ Target , tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} , tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} , tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} -, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @SettingsHaskellCPPFlagsList@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @HaskellCPPArgsList@}} , tgtCCompilerLink = CcLink { ccLinkProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_GCC_LINKER_OPTS_STAGE0List@} , ccLinkSupportsNoPie = False ===================================== default.target.in ===================================== @@ -12,29 +12,29 @@ Target , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ -, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} -, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} -, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@SettingsCPPCommand@", prgFlags = @SettingsCPPFlagsList@}} -, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@SettingsHaskellCPPCommand@", prgFlags = @SettingsHaskellCPPFlagsList@}} +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC@", prgFlags = @CONF_CC_OPTS_STAGE2List@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CXX@", prgFlags = @CONF_CXX_OPTS_STAGE2List@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE2List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}} , tgtCCompilerLink = CcLink -{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} -, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +{ ccLinkProgram = Program {prgPath = "@CC@", prgFlags = @CONF_GCC_LINKER_OPTS_STAGE2List@} +, ccLinkSupportsNoPie = @CONF_GCC_SUPPORTS_NO_PIEBool@ , ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ , ccLinkSupportsFilelist = @LdHasFilelistBool@ , ccLinkIsGnu = @LdIsGNULdBool@ } , tgtAr = Ar -{ arMkArchive = Program {prgPath = "@SettingsArCommand@", prgFlags = @ArArgsList@} +{ arMkArchive = Program {prgPath = "@ArCmd@", prgFlags = @ArArgsList@} , arIsGnu = @ArIsGNUArBool@ , arSupportsAtFile = @ArSupportsAtFileBool@ , arSupportsDashL = @ArSupportsDashLBool@ , arNeedsRanlib = @ArNeedsRanLibBool@ } -, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@SettingsRanlibCommand@", prgFlags = []}}) +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@RanlibCmd@", prgFlags = []}}) , tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} -, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}, mergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFilesBool@}) +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@MergeObjsCmd@", prgFlags = @MergeObjsArgsList@}, mergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFilesBool@}) , tgtDllwrap = @DllWrapCmdMaybeProg@ , tgtWindres = @WindresCmdMaybeProg@ } ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -6,6 +6,7 @@ module Rules.Generate ( ) where import qualified Data.Set as Set +import qualified Data.Text as T import Base import qualified Context import Expression @@ -448,45 +449,45 @@ generateSettings :: Expr String generateSettings = do ctx <- getContext settings <- traverse sequence $ - [ ("C compiler command", queryTarget ccPath) - , ("C compiler flags", queryTarget ccFlags) - , ("C++ compiler command", queryTarget cxxPath) - , ("C++ compiler flags", queryTarget cxxFlags) - , ("C compiler link flags", queryTarget clinkFlags) - , ("C compiler supports -no-pie", queryTarget linkSupportsNoPie) - , ("CPP command", queryTarget cppPath) - , ("CPP flags", queryTarget cppFlags) - , ("Haskell CPP command", queryTarget hsCppPath) - , ("Haskell CPP flags", queryTarget hsCppFlags) - , ("ld supports compact unwind", queryTarget linkSupportsCompactUnwind) - , ("ld supports filelist", queryTarget linkSupportsFilelist) - , ("ld is GNU ld", queryTarget linkIsGnu) - , ("Merge objects command", queryTarget mergeObjsPath) - , ("Merge objects flags", queryTarget mergeObjsFlags) - , ("Merge objects supports response files", queryTarget mergeObjsSupportsResponseFiles') - , ("ar command", queryTarget arPath) - , ("ar flags", queryTarget arFlags) - , ("ar supports at file", queryTarget arSupportsAtFile') - , ("ar supports -L", queryTarget arSupportsDashL') - , ("ranlib command", queryTarget ranlibPath) + [ ("C compiler command", queryTarget' ccPath) + , ("C compiler flags", queryTarget' ccFlags) + , ("C++ compiler command", queryTarget' cxxPath) + , ("C++ compiler flags", queryTarget' cxxFlags) + , ("C compiler link flags", queryTarget' clinkFlags) + , ("C compiler supports -no-pie", queryTarget' linkSupportsNoPie) + , ("CPP command", queryTarget' cppPath) + , ("CPP flags", queryTarget' cppFlags) + , ("Haskell CPP command", queryTarget' hsCppPath) + , ("Haskell CPP flags", queryTarget' hsCppFlags) + , ("ld supports compact unwind", queryTarget' linkSupportsCompactUnwind) + , ("ld supports filelist", queryTarget' linkSupportsFilelist) + , ("ld is GNU ld", queryTarget' linkIsGnu) + , ("Merge objects command", queryTarget' mergeObjsPath) + , ("Merge objects flags", queryTarget' mergeObjsFlags) + , ("Merge objects supports response files", queryTarget' mergeObjsSupportsResponseFiles') + , ("ar command", queryTarget' arPath) + , ("ar flags", queryTarget' arFlags) + , ("ar supports at file", queryTarget' arSupportsAtFile') + , ("ar supports -L", queryTarget' arSupportsDashL') + , ("ranlib command", queryTarget' ranlibPath) , ("otool command", expr $ settingsFileSetting ToolchainSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting ToolchainSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting ToolchainSetting_TouchCommand) - , ("dllwrap command", queryTarget (maybe "/bin/false" prgPath . tgtDllwrap)) -- ROMES:TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch - , ("windres command", queryTarget (maybe "/bin/false" prgPath . tgtWindres)) + , ("dllwrap command", queryTarget' (maybe "/bin/false" prgPath . tgtDllwrap)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me. + , ("windres command", queryTarget' (maybe "/bin/false" prgPath . tgtWindres)) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) - , ("target platform string", queryTarget targetPlatformTriple) - , ("target os", queryTarget (show . archOS_OS . tgtArchOs)) - , ("target arch", queryTarget (show . archOS_arch . tgtArchOs)) - , ("target word size", queryTarget wordSize) - , ("target word big endian", queryTarget isBigEndian) - , ("target has GNU nonexec stack", queryTarget (yesNo . Toolchain.tgtSupportsGnuNonexecStack)) - , ("target has .ident directive", queryTarget (yesNo . Toolchain.tgtSupportsIdentDirective)) - , ("target has subsections via symbols", queryTarget (yesNo . Toolchain.tgtSupportsSubsectionsViaSymbols)) + , ("target platform string", queryTarget' targetPlatformTriple) + , ("target os", queryTarget' (show . archOS_OS . tgtArchOs)) + , ("target arch", queryTarget' (show . archOS_arch . tgtArchOs)) + , ("target word size", queryTarget' wordSize) + , ("target word big endian", queryTarget' isBigEndian) + , ("target has GNU nonexec stack", queryTarget' (yesNo . Toolchain.tgtSupportsGnuNonexecStack)) + , ("target has .ident directive", queryTarget' (yesNo . Toolchain.tgtSupportsIdentDirective)) + , ("target has subsections via symbols", queryTarget' (yesNo . Toolchain.tgtSupportsSubsectionsViaSymbols)) , ("target has libm", expr $ lookupSystemConfig "target-has-libm") - , ("Unregisterised", queryTarget (yesNo . tgtUnregisterised)) - , ("LLVM target", queryTarget tgtLlvmTarget) + , ("Unregisterised", queryTarget' (yesNo . tgtUnregisterised)) + , ("LLVM target", queryTarget' tgtLlvmTarget) , ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand) , ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand) , ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW) @@ -494,8 +495,8 @@ generateSettings = do , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter) , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) , ("RTS ways", unwords . map show . Set.toList <$> getRtsWays) - , ("Tables next to code", queryTarget (yesNo . tgtTablesNextToCode)) - , ("Leading underscore", queryTarget (yesNo . tgtSymbolsHaveLeadingUnderscore)) + , ("Tables next to code", queryTarget' (yesNo . tgtTablesNextToCode)) + , ("Leading underscore", queryTarget' (yesNo . tgtSymbolsHaveLeadingUnderscore)) , ("Use LibFFI", expr $ yesNo <$> useLibffiForAdjustors) , ("RTS expects libdw", yesNo <$> getFlag UseLibdw) ] @@ -531,6 +532,19 @@ generateSettings = do wordSize = show . wordSize2Bytes . tgtWordSize mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) . tgtMergeObjs + -- Like @'queryTarget'@ specialized to String, but replace occurrences of + -- @topDirectory inplace/mingw@ with @$$tooldir/mingw@ in the resulting string + queryTarget' :: (Toolchain.Target -> String) -> Expr String + queryTarget' f = do + topdir <- expr $ topDirectory + queryTarget (\t -> substTooldir topdir (archOS_OS $ tgtArchOs t) (f t)) + where + substTooldir :: String -> OS -> String -> String + substTooldir topdir OSMinGW32 s + = T.unpack $ + T.replace (T.pack $ topdir "inplace" "mingw") (T.pack "$$tooldir/mingw") (T.pack s) + substTooldir _ _ s = s + -- | Generate @Config.hs@ files. generateConfigHs :: Expr String ===================================== m4/fp_settings.m4 ===================================== @@ -1,3 +1,14 @@ +# SUBST_TOOLDIR +# ---------------------------------- +# $1 - the variable where to search for occurrences of the path to the +# distributed mingw, and update by substituting said occurrences by +# the literal '$$tooldir/mingw' +AC_DEFUN([SUBST_TOOLDIR], +[ + dnl See Note [tooldir: How GHC finds mingw on Windows] + $1=`echo $1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` +]) + # FP_SETTINGS # ---------------------------------- # Set the variables used in the settings file @@ -5,74 +16,69 @@ AC_DEFUN([FP_SETTINGS], [ SettingsUseDistroMINGW="$EnableDistroToolchain" - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then - # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN. - # See Note [tooldir: How GHC finds mingw on Windows] - mingw_bin_prefix='$$tooldir/mingw/bin/' - SettingsCCompilerCommand="${mingw_bin_prefix}clang.exe" - SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2 -I\$\$tooldir/mingw/include" - SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" - SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" - SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" - SettingsCPPCommand="${mingw_bin_prefix}clang.exe" - SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" - SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" - SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" - # LLD does not support object merging (#21068) - SettingsMergeObjectsCommand="" - SettingsMergeObjectsFlags="" - SettingsArCommand="${mingw_bin_prefix}llvm-ar.exe" - SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" - SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" - SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' + SettingsCCompilerCommand="$CC" + SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" + SettingsCxxCompilerCommand="$CXX" + SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" + SettingsHaskellCPPCommand="$HaskellCPPCmd" + SettingsHaskellCPPFlags="$HaskellCPPArgs" + SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" + SettingsArCommand="$ArCmd" + SettingsRanlibCommand="$RanlibCmd" + SettingsMergeObjectsCommand="$MergeObjsCmd" + SettingsMergeObjectsFlags="$MergeObjsArgs" + if test -z "$DllWrapCmd"; then + SettingsDllWrapCommand="/bin/false" else - # This case handles the "normal" platforms (e.g. not Windows) where we - # don't provide the toolchain. - - SettingsCCompilerCommand="$CC" - SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" - SettingsCxxCompilerCommand="$CXX" - SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" - SettingsCPPCommand="$CPPCmd" - SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" - SettingsHaskellCPPCommand="$HaskellCPPCmd" - SettingsHaskellCPPFlags="$HaskellCPPArgs" - SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsArCommand="$ArCmd" - SettingsRanlibCommand="$RanlibCmd" - SettingsMergeObjectsCommand="$MergeObjsCmd" - SettingsMergeObjectsFlags="$MergeObjsArgs" + SettingsDllWrapCommand="$DllWrapCmd" + fi + if test -z "$WindresCmd"; then + SettingsWindresCommand="/bin/false" + else + SettingsWindresCommand="$WindresCmd" + fi - if test -z "$DllWrapCmd"; then - SettingsDllWrapCommand="/bin/false" - else - SettingsDllWrapCommand="$DllWrapCmd" - fi - if test -z "$WindresCmd"; then - SettingsWindresCommand="/bin/false" - else - SettingsWindresCommand="$WindresCmd" - fi + if test "$HostOS" = "mingw32"; then + SettingsTouchCommand='$$topdir/bin/touchy.exe' + else + SettingsTouchCommand='touch' + fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi + if test "$EnableDistroToolchain" = "YES"; then + # If the user specified --enable-distro-toolchain then we just use the + # executable names, not paths. + SettingsCCompilerCommand="$(basename $SettingsCCompilerCommand)" + SettingsHaskellCPPCommand="$(basename $SettingsHaskellCPPCommand)" + SettingsLdCommand="$(basename $SettingsLdCommand)" + SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" + SettingsArCommand="$(basename $SettingsArCommand)" + SettingsDllWrapCommand="$(basename $SettingsDllWrapCommand)" + SettingsWindresCommand="$(basename $SettingsWindresCommand)" + fi - if test "$EnableDistroToolchain" = "YES"; then - # If the user specified --enable-distro-toolchain then we just use the - # executable names, not paths. - SettingsCCompilerCommand="$(basename $SettingsCCompilerCommand)" - SettingsHaskellCPPCommand="$(basename $SettingsHaskellCPPCommand)" - SettingsLdCommand="$(basename $SettingsLdCommand)" - SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" - SettingsArCommand="$(basename $SettingsArCommand)" - SettingsDllWrapCommand="$(basename $SettingsDllWrapCommand)" - SettingsWindresCommand="$(basename $SettingsWindresCommand)" - fi + if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then + # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN. + # We need to issue a substitution to use $$tooldir, + # See Note [tooldir: How GHC finds mingw on Windows] + SUBST_TOOLDIR([SettingsCCompilerCommand]) + SUBST_TOOLDIR([SettingsCCompilerFlags]) + SUBST_TOOLDIR([SettingsCxxCompilerCommand]) + SUBST_TOOLDIR([SettingsCxxCompilerFlags]) + SUBST_TOOLDIR([SettingsCCompilerLinkFlags]) + SUBST_TOOLDIR([SettingsCPPCommand]) + SUBST_TOOLDIR([SettingsCPPFlags]) + SUBST_TOOLDIR([SettingsHaskellCPPCommand]) + SUBST_TOOLDIR([SettingsHaskellCPPFlags]) + SUBST_TOOLDIR([SettingsMergeObjectsCommand]) + SUBST_TOOLDIR([SettingsMergeObjectsFlags]) + SUBST_TOOLDIR([SettingsArCommand]) + SUBST_TOOLDIR([SettingsRanlibCommand]) + SUBST_TOOLDIR([SettingsDllWrapCommand]) + SUBST_TOOLDIR([SettingsWindresCommand]) + SettingsTouchCommand='$$topdir/bin/touchy.exe' fi # LLVM backend tools ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -72,13 +72,17 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ set_up_tarballs # N.B. The parameters which get plopped in the `settings` file used by the - # resulting compiler are computed in `FP_SETTINGS`. + # resulting compiler are computed in `FP_SETTINGS`. Specifically, we use + # $$topdir-relative paths instead of fullpaths to the toolchain, by replacing + # occurrences of $hardtop/inplace/mingw with $$tooldir/mingw # Our Windows toolchain is based around Clang and LLD. We use compiler-rt # for the runtime, libc++ and libc++abi for the C++ standard library # implementation, and libunwind for C++ unwinding. mingwbin="$hardtop/inplace/mingw/bin/" - mingwlib="$hardtop/inplace/mingw/lib/" # Seems to be unused + mingwlib="$hardtop/inplace/mingw/lib" + mingwinclude="$hardtop/inplace/mingw/include" + mingwpath="$hardtop/inplace/mingw" CC="${mingwbin}clang.exe" CXX="${mingwbin}clang++.exe" @@ -87,17 +91,22 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ # necessary to ensure correct behavior when MinGW-w64 headers are in the # header include path (#22159). cflags="--rtlib=compiler-rt -D_UCRT" - CFLAGS="$cflags" - CONF_CC_OPTS_STAGE1="$cflags" - CONF_CC_OPTS_STAGE2="$cflags" + CFLAGS="$cflags -I$mingwinclude" + CONF_CC_OPTS_STAGE1="$cflags -I$mingwinclude" + CONF_CC_OPTS_STAGE2="$cflags -I$mingwinclude" cxxflags="" - CXXFLAGS="$cxxflags" - CONF_CXX_OPTS_STAGE1="$cxxflags" - CONF_CXX_OPTS_STAGE2="$cxxflags" + CXXFLAGS="$cxxflags -I$mingwinclude" + CONF_CXX_OPTS_STAGE1="$cxxflags -I$mingwinclude" + CONF_CXX_OPTS_STAGE2="$cxxflags -I$mingwinclude" - CONF_GCC_LINKER_OPTS_STAGE1="-fuse-ld=lld $cflags" - CONF_GCC_LINKER_OPTS_STAGE2="-fuse-ld=lld $cflags" + CONF_CPP_OPTS_STAGE1="$CONF_CPP_OPTS_STAGE1 -I$mingwinclude" + CONF_CPP_OPTS_STAGE2="$CONF_CPP_OPTS_STAGE2 -I$mingwinclude" + + HaskellCPPArgs="$HaskellCPPArgs -I$mingwinclude" + + CONF_GCC_LINKER_OPTS_STAGE1="-fuse-ld=lld $cflags -L$mingwlib -L$hardtop/inplace/mingw/x86_64-w64-mingw32/lib" + CONF_GCC_LINKER_OPTS_STAGE2="-fuse-ld=lld $cflags -L$mingwlib -L$hardtop/inplace/mingw/x86_64-w64-mingw32/lib" # N.BOn Windows we can't easily dynamically-link against libc++ since there is # no RPATH support, meaning that the loader will have no way of finding our ===================================== m4/prep_target_file.m4 ===================================== @@ -107,13 +107,15 @@ AC_DEFUN([PREP_LIST],[ # Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE # Prepares required substitutions to generate the target file AC_DEFUN([PREP_TARGET_FILE],[ + + dnl Target target PREP_BOOLEAN([MergeObjsSupportsResponseFiles]) PREP_BOOLEAN([TargetHasGnuNonexecStack]) PREP_BOOLEAN([LeadingUnderscore]) PREP_BOOLEAN([ArSupportsAtFile]) PREP_BOOLEAN([ArSupportsDashL]) PREP_BOOLEAN([TargetHasIdentDirective]) - PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([CONF_GCC_SUPPORTS_NO_PIE]) PREP_BOOLEAN([LdHasFilelist]) PREP_BOOLEAN([LdIsGNULd]) PREP_BOOLEAN([LdHasNoCompactUnwind]) @@ -124,19 +126,19 @@ AC_DEFUN([PREP_TARGET_FILE],[ PREP_BOOLEAN([ArIsGNUAr]) PREP_BOOLEAN([ArNeedsRanLib]) PREP_NOT_BOOLEAN([CrossCompiling]) - PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([MergeObjsArgs]) PREP_LIST([ArArgs]) - PREP_LIST([SettingsCCompilerLinkFlags]) - PREP_LIST([SettingsHaskellCPPFlags]) + PREP_LIST([CONF_GCC_LINKER_OPTS_STAGE2]) + PREP_LIST([HaskellCPPArgs]) PREP_MAYBE_SIMPLE_PROGRAM([DllWrapCmd]) PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) PREP_MAYBE_STRING([TargetVendor_CPP]) PREP_MAYBE_STRING([HostVendor_CPP]) - PREP_LIST([SettingsCPPFlags]) - PREP_LIST([SettingsCxxCompilerFlags]) - PREP_LIST([SettingsCCompilerFlags]) + PREP_LIST([CONF_CPP_OPTS_STAGE2]) + PREP_LIST([CONF_CXX_OPTS_STAGE2]) + PREP_LIST([CONF_CC_OPTS_STAGE2]) - dnl Host-target + dnl Host target PREP_BOOLEAN([ArSupportsAtFile_STAGE0]) PREP_BOOLEAN([ArSupportsDashL_STAGE0]) PREP_LIST([AR_OPTS_STAGE0]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -39,7 +39,7 @@ findCc llvmTarget progOpt = checking "for C compiler" $ do -- there's a more optimal one ccProgram' <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] - -- we inline the windows check here because we need Cc to call parseTriple + -- we inline the is-windows check here because we need Cc to call parseTriple let ccProgram = if "mingw32" `isInfixOf` llvmTarget && takeBaseName (prgPath ccProgram') == "clang" then -- Signal that we are linking against UCRT with the _UCRT macro. This is ===================================== utils/ghc-toolchain/test ===================================== @@ -0,0 +1,1672 @@ +// include: shell.js +// The Module object: Our interface to the outside world. We import +// and export values on it. There are various ways Module can be used: +// 1. Not defined. We create it here +// 2. A function parameter, function(Module) { ..generated code.. } +// 3. pre-run appended it, var Module = {}; ..generated code.. +// 4. External script tag defines var Module. +// We need to check if Module already exists (e.g. case 3 above). +// Substitution will be replaced with actual code on later stage of the build, +// this way Closure Compiler will not mangle it (e.g. case 4. above). +// Note that if you want to run closure, and also to use Module +// after the generated code, you will need to define var Module = {}; +// before the code. Then that object will be used in the code, and you +// can continue to use Module afterwards as well. +var Module = typeof Module != 'undefined' ? Module : {}; + +// --pre-jses are emitted after the Module integration code, so that they can +// refer to Module (if they choose; they can also define Module) + + +// Sometimes an existing Module object exists with properties +// meant to overwrite the default module functionality. Here +// we collect those properties and reapply _after_ we configure +// the current environment's defaults to avoid having to be so +// defensive during initialization. +var moduleOverrides = Object.assign({}, Module); + +var arguments_ = []; +var thisProgram = './this.program'; +var quit_ = (status, toThrow) => { + throw toThrow; +}; + +// Determine the runtime environment we are in. You can customize this by +// setting the ENVIRONMENT setting at compile time (see settings.js). + +// Attempt to auto-detect the environment +var ENVIRONMENT_IS_WEB = typeof window == 'object'; +var ENVIRONMENT_IS_WORKER = typeof importScripts == 'function'; +// N.b. Electron.js environment is simultaneously a NODE-environment, but +// also a web environment. +var ENVIRONMENT_IS_NODE = typeof process == 'object' && typeof process.versions == 'object' && typeof process.versions.node == 'string'; +var ENVIRONMENT_IS_SHELL = !ENVIRONMENT_IS_WEB && !ENVIRONMENT_IS_NODE && !ENVIRONMENT_IS_WORKER; + +if (Module['ENVIRONMENT']) { + throw new Error('Module.ENVIRONMENT has been deprecated. To force the environment, use the ENVIRONMENT compile-time option (for example, -sENVIRONMENT=web or -sENVIRONMENT=node)'); +} + +// `/` should be present at the end if `scriptDirectory` is not empty +var scriptDirectory = ''; +function locateFile(path) { + if (Module['locateFile']) { + return Module['locateFile'](path, scriptDirectory); + } + return scriptDirectory + path; +} + +// Hooks that are implemented differently in different runtime environments. +var read_, + readAsync, + readBinary, + setWindowTitle; + +if (ENVIRONMENT_IS_NODE) { + if (typeof process == 'undefined' || !process.release || process.release.name !== 'node') throw new Error('not compiled for this environment (did you build to HTML and try to run it not on the web, or set ENVIRONMENT to something - like node - and run it someplace else - like on the web?)'); + + var nodeVersion = process.versions.node; + var numericVersion = nodeVersion.split('.').slice(0, 3); + numericVersion = (numericVersion[0] * 10000) + (numericVersion[1] * 100) + (numericVersion[2].split('-')[0] * 1); + var minVersion = 160000; + if (numericVersion < 160000) { + throw new Error('This emscripten-generated code requires node v16.0.0 (detected v' + nodeVersion + ')'); + } + + // `require()` is no-op in an ESM module, use `createRequire()` to construct + // the require()` function. This is only necessary for multi-environment + // builds, `-sENVIRONMENT=node` emits a static import declaration instead. + // TODO: Swap all `require()`'s with `import()`'s? + // These modules will usually be used on Node.js. Load them eagerly to avoid + // the complexity of lazy-loading. + var fs = require('fs'); + var nodePath = require('path'); + + if (ENVIRONMENT_IS_WORKER) { + scriptDirectory = nodePath.dirname(scriptDirectory) + '/'; + } else { + scriptDirectory = __dirname + '/'; + } + +// include: node_shell_read.js +read_ = (filename, binary) => { + // We need to re-wrap `file://` strings to URLs. Normalizing isn't + // necessary in that case, the path should already be absolute. + filename = isFileURI(filename) ? new URL(filename) : nodePath.normalize(filename); + return fs.readFileSync(filename, binary ? undefined : 'utf8'); +}; + +readBinary = (filename) => { + var ret = read_(filename, true); + if (!ret.buffer) { + ret = new Uint8Array(ret); + } + assert(ret.buffer); + return ret; +}; + +readAsync = (filename, onload, onerror, binary = true) => { + // See the comment in the `read_` function. + filename = isFileURI(filename) ? new URL(filename) : nodePath.normalize(filename); + fs.readFile(filename, binary ? undefined : 'utf8', (err, data) => { + if (err) onerror(err); + else onload(binary ? data.buffer : data); + }); +}; +// end include: node_shell_read.js + if (!Module['thisProgram'] && process.argv.length > 1) { + thisProgram = process.argv[1].replace(/\\/g, '/'); + } + + arguments_ = process.argv.slice(2); + + if (typeof module != 'undefined') { + module['exports'] = Module; + } + + process.on('uncaughtException', (ex) => { + // suppress ExitStatus exceptions from showing an error + if (ex !== 'unwind' && !(ex instanceof ExitStatus) && !(ex.context instanceof ExitStatus)) { + throw ex; + } + }); + + quit_ = (status, toThrow) => { + process.exitCode = status; + throw toThrow; + }; + + Module['inspect'] = () => '[Emscripten Module object]'; + +} else +if (ENVIRONMENT_IS_SHELL) { + + if ((typeof process == 'object' && typeof require === 'function') || typeof window == 'object' || typeof importScripts == 'function') throw new Error('not compiled for this environment (did you build to HTML and try to run it not on the web, or set ENVIRONMENT to something - like node - and run it someplace else - like on the web?)'); + + if (typeof read != 'undefined') { + read_ = (f) => { + return read(f); + }; + } + + readBinary = (f) => { + let data; + if (typeof readbuffer == 'function') { + return new Uint8Array(readbuffer(f)); + } + data = read(f, 'binary'); + assert(typeof data == 'object'); + return data; + }; + + readAsync = (f, onload, onerror) => { + setTimeout(() => onload(readBinary(f))); + }; + + if (typeof clearTimeout == 'undefined') { + globalThis.clearTimeout = (id) => {}; + } + + if (typeof setTimeout == 'undefined') { + // spidermonkey lacks setTimeout but we use it above in readAsync. + globalThis.setTimeout = (f) => (typeof f == 'function') ? f() : abort(); + } + + if (typeof scriptArgs != 'undefined') { + arguments_ = scriptArgs; + } else if (typeof arguments != 'undefined') { + arguments_ = arguments; + } + + if (typeof quit == 'function') { + quit_ = (status, toThrow) => { + // Unlike node which has process.exitCode, d8 has no such mechanism. So we + // have no way to set the exit code and then let the program exit with + // that code when it naturally stops running (say, when all setTimeouts + // have completed). For that reason, we must call `quit` - the only way to + // set the exit code - but quit also halts immediately. To increase + // consistency with node (and the web) we schedule the actual quit call + // using a setTimeout to give the current stack and any exception handlers + // a chance to run. This enables features such as addOnPostRun (which + // expected to be able to run code after main returns). + setTimeout(() => { + if (!(toThrow instanceof ExitStatus)) { + let toLog = toThrow; + if (toThrow && typeof toThrow == 'object' && toThrow.stack) { + toLog = [toThrow, toThrow.stack]; + } + err(`exiting due to exception: ${toLog}`); + } + quit(status); + }); + throw toThrow; + }; + } + + if (typeof print != 'undefined') { + // Prefer to use print/printErr where they exist, as they usually work better. + if (typeof console == 'undefined') console = /** @type{!Console} */({}); + console.log = /** @type{!function(this:Console, ...*): undefined} */ (print); + console.warn = console.error = /** @type{!function(this:Console, ...*): undefined} */ (typeof printErr != 'undefined' ? printErr : print); + } + +} else + +// Note that this includes Node.js workers when relevant (pthreads is enabled). +// Node.js workers are detected as a combination of ENVIRONMENT_IS_WORKER and +// ENVIRONMENT_IS_NODE. +if (ENVIRONMENT_IS_WEB || ENVIRONMENT_IS_WORKER) { + if (ENVIRONMENT_IS_WORKER) { // Check worker, not web, since window could be polyfilled + scriptDirectory = self.location.href; + } else if (typeof document != 'undefined' && document.currentScript) { // web + scriptDirectory = document.currentScript.src; + } + // blob urls look like blob:http://site.com/etc/etc and we cannot infer anything from them. + // otherwise, slice off the final part of the url to find the script directory. + // if scriptDirectory does not contain a slash, lastIndexOf will return -1, + // and scriptDirectory will correctly be replaced with an empty string. + // If scriptDirectory contains a query (starting with ?) or a fragment (starting with #), + // they are removed because they could contain a slash. + if (scriptDirectory.indexOf('blob:') !== 0) { + scriptDirectory = scriptDirectory.substr(0, scriptDirectory.replace(/[?#].*/, "").lastIndexOf('/')+1); + } else { + scriptDirectory = ''; + } + + if (!(typeof window == 'object' || typeof importScripts == 'function')) throw new Error('not compiled for this environment (did you build to HTML and try to run it not on the web, or set ENVIRONMENT to something - like node - and run it someplace else - like on the web?)'); + + // Differentiate the Web Worker from the Node Worker case, as reading must + // be done differently. + { +// include: web_or_worker_shell_read.js +read_ = (url) => { + var xhr = new XMLHttpRequest(); + xhr.open('GET', url, false); + xhr.send(null); + return xhr.responseText; + } + + if (ENVIRONMENT_IS_WORKER) { + readBinary = (url) => { + var xhr = new XMLHttpRequest(); + xhr.open('GET', url, false); + xhr.responseType = 'arraybuffer'; + xhr.send(null); + return new Uint8Array(/** @type{!ArrayBuffer} */(xhr.response)); + }; + } + + readAsync = (url, onload, onerror) => { + var xhr = new XMLHttpRequest(); + xhr.open('GET', url, true); + xhr.responseType = 'arraybuffer'; + xhr.onload = () => { + if (xhr.status == 200 || (xhr.status == 0 && xhr.response)) { // file URLs can return 0 + onload(xhr.response); + return; + } + onerror(); + }; + xhr.onerror = onerror; + xhr.send(null); + } + +// end include: web_or_worker_shell_read.js + } + + setWindowTitle = (title) => document.title = title; +} else +{ + throw new Error('environment detection error'); +} + +var out = Module['print'] || console.log.bind(console); +var err = Module['printErr'] || console.error.bind(console); + +// Merge back in the overrides +Object.assign(Module, moduleOverrides); +// Free the object hierarchy contained in the overrides, this lets the GC +// reclaim data used e.g. in memoryInitializerRequest, which is a large typed array. +moduleOverrides = null; +checkIncomingModuleAPI(); + +// Emit code to handle expected values on the Module object. This applies Module.x +// to the proper local x. This has two benefits: first, we only emit it if it is +// expected to arrive, and second, by using a local everywhere else that can be +// minified. + +if (Module['arguments']) arguments_ = Module['arguments'];legacyModuleProp('arguments', 'arguments_'); + +if (Module['thisProgram']) thisProgram = Module['thisProgram'];legacyModuleProp('thisProgram', 'thisProgram'); + +if (Module['quit']) quit_ = Module['quit'];legacyModuleProp('quit', 'quit_'); + +// perform assertions in shell.js after we set up out() and err(), as otherwise if an assertion fails it cannot print the message +// Assertions on removed incoming Module JS APIs. +assert(typeof Module['memoryInitializerPrefixURL'] == 'undefined', 'Module.memoryInitializerPrefixURL option was removed, use Module.locateFile instead'); +assert(typeof Module['pthreadMainPrefixURL'] == 'undefined', 'Module.pthreadMainPrefixURL option was removed, use Module.locateFile instead'); +assert(typeof Module['cdInitializerPrefixURL'] == 'undefined', 'Module.cdInitializerPrefixURL option was removed, use Module.locateFile instead'); +assert(typeof Module['filePackagePrefixURL'] == 'undefined', 'Module.filePackagePrefixURL option was removed, use Module.locateFile instead'); +assert(typeof Module['read'] == 'undefined', 'Module.read option was removed (modify read_ in JS)'); +assert(typeof Module['readAsync'] == 'undefined', 'Module.readAsync option was removed (modify readAsync in JS)'); +assert(typeof Module['readBinary'] == 'undefined', 'Module.readBinary option was removed (modify readBinary in JS)'); +assert(typeof Module['setWindowTitle'] == 'undefined', 'Module.setWindowTitle option was removed (modify setWindowTitle in JS)'); +assert(typeof Module['TOTAL_MEMORY'] == 'undefined', 'Module.TOTAL_MEMORY has been renamed Module.INITIAL_MEMORY'); +legacyModuleProp('read', 'read_'); +legacyModuleProp('readAsync', 'readAsync'); +legacyModuleProp('readBinary', 'readBinary'); +legacyModuleProp('setWindowTitle', 'setWindowTitle'); +var IDBFS = 'IDBFS is no longer included by default; build with -lidbfs.js'; +var PROXYFS = 'PROXYFS is no longer included by default; build with -lproxyfs.js'; +var WORKERFS = 'WORKERFS is no longer included by default; build with -lworkerfs.js'; +var NODEFS = 'NODEFS is no longer included by default; build with -lnodefs.js'; + +assert(!ENVIRONMENT_IS_SHELL, "shell environment detected but not enabled at build time. Add 'shell' to `-sENVIRONMENT` to enable."); + + +// end include: shell.js +// include: preamble.js +// === Preamble library stuff === + +// Documentation for the public APIs defined in this file must be updated in: +// site/source/docs/api_reference/preamble.js.rst +// A prebuilt local version of the documentation is available at: +// site/build/text/docs/api_reference/preamble.js.txt +// You can also build docs locally as HTML or other formats in site/ +// An online HTML version (which may be of a different version of Emscripten) +// is up at http://kripken.github.io/emscripten-site/docs/api_reference/preamble.js.html + +var wasmBinary; +if (Module['wasmBinary']) wasmBinary = Module['wasmBinary'];legacyModuleProp('wasmBinary', 'wasmBinary'); +var noExitRuntime = Module['noExitRuntime'] || true;legacyModuleProp('noExitRuntime', 'noExitRuntime'); + +if (typeof WebAssembly != 'object') { + abort('no native wasm support detected'); +} + +// Wasm globals + +var wasmMemory; + +//======================================== +// Runtime essentials +//======================================== + +// whether we are quitting the application. no code should run after this. +// set in exit() and abort() +var ABORT = false; + +// set by exit() and abort(). Passed to 'onExit' handler. +// NOTE: This is also used as the process return code code in shell environments +// but only when noExitRuntime is false. +var EXITSTATUS; + +/** @type {function(*, string=)} */ +function assert(condition, text) { + if (!condition) { + abort('Assertion failed' + (text ? ': ' + text : '')); + } +} + +// We used to include malloc/free by default in the past. Show a helpful error in +// builds with assertions. +function _malloc() { + abort("malloc() called but not included in the build - add '_malloc' to EXPORTED_FUNCTIONS"); +} +function _free() { + // Show a helpful error since we used to include free by default in the past. + abort("free() called but not included in the build - add '_free' to EXPORTED_FUNCTIONS"); +} + +// Memory management + +var HEAP, +/** @type {!Int8Array} */ + HEAP8, +/** @type {!Uint8Array} */ + HEAPU8, +/** @type {!Int16Array} */ + HEAP16, +/** @type {!Uint16Array} */ + HEAPU16, +/** @type {!Int32Array} */ + HEAP32, +/** @type {!Uint32Array} */ + HEAPU32, +/** @type {!Float32Array} */ + HEAPF32, +/** @type {!Float64Array} */ + HEAPF64; + +function updateMemoryViews() { + var b = wasmMemory.buffer; + Module['HEAP8'] = HEAP8 = new Int8Array(b); + Module['HEAP16'] = HEAP16 = new Int16Array(b); + Module['HEAP32'] = HEAP32 = new Int32Array(b); + Module['HEAPU8'] = HEAPU8 = new Uint8Array(b); + Module['HEAPU16'] = HEAPU16 = new Uint16Array(b); + Module['HEAPU32'] = HEAPU32 = new Uint32Array(b); + Module['HEAPF32'] = HEAPF32 = new Float32Array(b); + Module['HEAPF64'] = HEAPF64 = new Float64Array(b); +} + +assert(!Module['STACK_SIZE'], 'STACK_SIZE can no longer be set at runtime. Use -sSTACK_SIZE at link time') + +assert(typeof Int32Array != 'undefined' && typeof Float64Array !== 'undefined' && Int32Array.prototype.subarray != undefined && Int32Array.prototype.set != undefined, + 'JS engine does not provide full typed array support'); + +// If memory is defined in wasm, the user can't provide it, or set INITIAL_MEMORY +assert(!Module['wasmMemory'], 'Use of `wasmMemory` detected. Use -sIMPORTED_MEMORY to define wasmMemory externally'); +assert(!Module['INITIAL_MEMORY'], 'Detected runtime INITIAL_MEMORY setting. Use -sIMPORTED_MEMORY to define wasmMemory dynamically'); + +// include: runtime_init_table.js +// In regular non-RELOCATABLE mode the table is exported +// from the wasm module and this will be assigned once +// the exports are available. +var wasmTable; +// end include: runtime_init_table.js +// include: runtime_stack_check.js +// Initializes the stack cookie. Called at the startup of main and at the startup of each thread in pthreads mode. +function writeStackCookie() { + var max = _emscripten_stack_get_end(); + assert((max & 3) == 0); + // If the stack ends at address zero we write our cookies 4 bytes into the + // stack. This prevents interference with SAFE_HEAP and ASAN which also + // monitor writes to address zero. + if (max == 0) { + max += 4; + } + // The stack grow downwards towards _emscripten_stack_get_end. + // We write cookies to the final two words in the stack and detect if they are + // ever overwritten. + HEAPU32[((max)>>2)] = 0x02135467; + HEAPU32[(((max)+(4))>>2)] = 0x89BACDFE; + // Also test the global address 0 for integrity. + HEAPU32[((0)>>2)] = 1668509029; +} + +function checkStackCookie() { + if (ABORT) return; + var max = _emscripten_stack_get_end(); + // See writeStackCookie(). + if (max == 0) { + max += 4; + } + var cookie1 = HEAPU32[((max)>>2)]; + var cookie2 = HEAPU32[(((max)+(4))>>2)]; + if (cookie1 != 0x02135467 || cookie2 != 0x89BACDFE) { + abort(`Stack overflow! Stack cookie has been overwritten at ${ptrToString(max)}, expected hex dwords 0x89BACDFE and 0x2135467, but received ${ptrToString(cookie2)} ${ptrToString(cookie1)}`); + } + // Also test the global address 0 for integrity. + if (HEAPU32[((0)>>2)] != 0x63736d65 /* 'emsc' */) { + abort('Runtime error: The application has corrupted its heap memory area (address zero)!'); + } +} +// end include: runtime_stack_check.js +// include: runtime_assertions.js +// Endianness check +(function() { + var h16 = new Int16Array(1); + var h8 = new Int8Array(h16.buffer); + h16[0] = 0x6373; + if (h8[0] !== 0x73 || h8[1] !== 0x63) throw 'Runtime error: expected the system to be little-endian! (Run with -sSUPPORT_BIG_ENDIAN to bypass)'; +})(); + +// end include: runtime_assertions.js +var __ATPRERUN__ = []; // functions called before the runtime is initialized +var __ATINIT__ = []; // functions called during startup +var __ATMAIN__ = []; // functions called when main() is to be run +var __ATEXIT__ = []; // functions called during shutdown +var __ATPOSTRUN__ = []; // functions called after the main() is called + +var runtimeInitialized = false; + +var runtimeKeepaliveCounter = 0; + +function keepRuntimeAlive() { + return noExitRuntime || runtimeKeepaliveCounter > 0; +} + +function preRun() { + if (Module['preRun']) { + if (typeof Module['preRun'] == 'function') Module['preRun'] = [Module['preRun']]; + while (Module['preRun'].length) { + addOnPreRun(Module['preRun'].shift()); + } + } + callRuntimeCallbacks(__ATPRERUN__); +} + +function initRuntime() { + assert(!runtimeInitialized); + runtimeInitialized = true; + + checkStackCookie(); + + + callRuntimeCallbacks(__ATINIT__); +} + +function preMain() { + checkStackCookie(); + + callRuntimeCallbacks(__ATMAIN__); +} + +function postRun() { + checkStackCookie(); + + if (Module['postRun']) { + if (typeof Module['postRun'] == 'function') Module['postRun'] = [Module['postRun']]; + while (Module['postRun'].length) { + addOnPostRun(Module['postRun'].shift()); + } + } + + callRuntimeCallbacks(__ATPOSTRUN__); +} + +function addOnPreRun(cb) { + __ATPRERUN__.unshift(cb); +} + +function addOnInit(cb) { + __ATINIT__.unshift(cb); +} + +function addOnPreMain(cb) { + __ATMAIN__.unshift(cb); +} + +function addOnExit(cb) { +} + +function addOnPostRun(cb) { + __ATPOSTRUN__.unshift(cb); +} + +// include: runtime_math.js +// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/imul + +// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/fround + +// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/clz32 + +// https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Math/trunc + +assert(Math.imul, 'This browser does not support Math.imul(), build with LEGACY_VM_SUPPORT or POLYFILL_OLD_MATH_FUNCTIONS to add in a polyfill'); +assert(Math.fround, 'This browser does not support Math.fround(), build with LEGACY_VM_SUPPORT or POLYFILL_OLD_MATH_FUNCTIONS to add in a polyfill'); +assert(Math.clz32, 'This browser does not support Math.clz32(), build with LEGACY_VM_SUPPORT or POLYFILL_OLD_MATH_FUNCTIONS to add in a polyfill'); +assert(Math.trunc, 'This browser does not support Math.trunc(), build with LEGACY_VM_SUPPORT or POLYFILL_OLD_MATH_FUNCTIONS to add in a polyfill'); +// end include: runtime_math.js +// A counter of dependencies for calling run(). If we need to +// do asynchronous work before running, increment this and +// decrement it. Incrementing must happen in a place like +// Module.preRun (used by emcc to add file preloading). +// Note that you can add dependencies in preRun, even though +// it happens right before run - run will be postponed until +// the dependencies are met. +var runDependencies = 0; +var runDependencyWatcher = null; +var dependenciesFulfilled = null; // overridden to take different actions when all run dependencies are fulfilled +var runDependencyTracking = {}; + +function getUniqueRunDependency(id) { + var orig = id; + while (1) { + if (!runDependencyTracking[id]) return id; + id = orig + Math.random(); + } +} + +function addRunDependency(id) { + runDependencies++; + + if (Module['monitorRunDependencies']) { + Module['monitorRunDependencies'](runDependencies); + } + + if (id) { + assert(!runDependencyTracking[id]); + runDependencyTracking[id] = 1; + if (runDependencyWatcher === null && typeof setInterval != 'undefined') { + // Check for missing dependencies every few seconds + runDependencyWatcher = setInterval(() => { + if (ABORT) { + clearInterval(runDependencyWatcher); + runDependencyWatcher = null; + return; + } + var shown = false; + for (var dep in runDependencyTracking) { + if (!shown) { + shown = true; + err('still waiting on run dependencies:'); + } + err('dependency: ' + dep); + } + if (shown) { + err('(end of list)'); + } + }, 10000); + } + } else { + err('warning: run dependency added without ID'); + } +} + +function removeRunDependency(id) { + runDependencies--; + + if (Module['monitorRunDependencies']) { + Module['monitorRunDependencies'](runDependencies); + } + + if (id) { + assert(runDependencyTracking[id]); + delete runDependencyTracking[id]; + } else { + err('warning: run dependency removed without ID'); + } + if (runDependencies == 0) { + if (runDependencyWatcher !== null) { + clearInterval(runDependencyWatcher); + runDependencyWatcher = null; + } + if (dependenciesFulfilled) { + var callback = dependenciesFulfilled; + dependenciesFulfilled = null; + callback(); // can add another dependenciesFulfilled + } + } +} + +/** @param {string|number=} what */ +function abort(what) { + if (Module['onAbort']) { + Module['onAbort'](what); + } + + what = 'Aborted(' + what + ')'; + // TODO(sbc): Should we remove printing and leave it up to whoever + // catches the exception? + err(what); + + ABORT = true; + EXITSTATUS = 1; + + // Use a wasm runtime error, because a JS error might be seen as a foreign + // exception, which means we'd run destructors on it. We need the error to + // simply make the program stop. + // FIXME This approach does not work in Wasm EH because it currently does not assume + // all RuntimeErrors are from traps; it decides whether a RuntimeError is from + // a trap or not based on a hidden field within the object. So at the moment + // we don't have a way of throwing a wasm trap from JS. TODO Make a JS API that + // allows this in the wasm spec. + + // Suppress closure compiler warning here. Closure compiler's builtin extern + // defintion for WebAssembly.RuntimeError claims it takes no arguments even + // though it can. + // TODO(https://github.com/google/closure-compiler/pull/3913): Remove if/when upstream closure gets fixed. + /** @suppress {checkTypes} */ + var e = new WebAssembly.RuntimeError(what); + + // Throw the error whether or not MODULARIZE is set because abort is used + // in code paths apart from instantiation where an exception is expected + // to be thrown when abort is called. + throw e; +} + +// include: memoryprofiler.js +// end include: memoryprofiler.js +// show errors on likely calls to FS when it was not included +var FS = { + error: function() { + abort('Filesystem support (FS) was not included. The problem is that you are using files from JS, but files were not used from C/C++, so filesystem support was not auto-included. You can force-include filesystem support with -sFORCE_FILESYSTEM'); + }, + init: function() { FS.error() }, + createDataFile: function() { FS.error() }, + createPreloadedFile: function() { FS.error() }, + createLazyFile: function() { FS.error() }, + open: function() { FS.error() }, + mkdev: function() { FS.error() }, + registerDevice: function() { FS.error() }, + analyzePath: function() { FS.error() }, + + ErrnoError: function ErrnoError() { FS.error() }, +}; +Module['FS_createDataFile'] = FS.createDataFile; +Module['FS_createPreloadedFile'] = FS.createPreloadedFile; + +// include: URIUtils.js +// Prefix of data URIs emitted by SINGLE_FILE and related options. +var dataURIPrefix = 'data:application/octet-stream;base64,'; + +// Indicates whether filename is a base64 data URI. +function isDataURI(filename) { + // Prefix of data URIs emitted by SINGLE_FILE and related options. + return filename.startsWith(dataURIPrefix); +} + +// Indicates whether filename is delivered via file protocol (as opposed to http/https) +function isFileURI(filename) { + return filename.startsWith('file://'); +} +// end include: URIUtils.js +/** @param {boolean=} fixedasm */ +function createExportWrapper(name, fixedasm) { + return function() { + var displayName = name; + var asm = fixedasm; + if (!fixedasm) { + asm = Module['asm']; + } + assert(runtimeInitialized, 'native function `' + displayName + '` called before runtime initialization'); + if (!asm[name]) { + assert(asm[name], 'exported native function `' + displayName + '` not found'); + } + return asm[name].apply(null, arguments); + }; +} + +// include: runtime_exceptions.js +// end include: runtime_exceptions.js +var wasmBinaryFile; + wasmBinaryFile = 'test.wasm'; + if (!isDataURI(wasmBinaryFile)) { + wasmBinaryFile = locateFile(wasmBinaryFile); + } + +function getBinary(file) { + try { + if (file == wasmBinaryFile && wasmBinary) { + return new Uint8Array(wasmBinary); + } + if (readBinary) { + return readBinary(file); + } + throw "both async and sync fetching of the wasm failed"; + } + catch (err) { + abort(err); + } +} + +function getBinaryPromise(binaryFile) { + // If we don't have the binary yet, try to load it asynchronously. + // Fetch has some additional restrictions over XHR, like it can't be used on a file:// url. + // See https://github.com/github/fetch/pull/92#issuecomment-140665932 + // Cordova or Electron apps are typically loaded from a file:// url. + // So use fetch if it is available and the url is not a file, otherwise fall back to XHR. + if (!wasmBinary && (ENVIRONMENT_IS_WEB || ENVIRONMENT_IS_WORKER)) { + if (typeof fetch == 'function' + && !isFileURI(binaryFile) + ) { + return fetch(binaryFile, { credentials: 'same-origin' }).then((response) => { + if (!response['ok']) { + throw "failed to load wasm binary file at '" + binaryFile + "'"; + } + return response['arrayBuffer'](); + }).catch(() => getBinary(binaryFile)); + } + else { + if (readAsync) { + // fetch is not available or url is file => try XHR (readAsync uses XHR internally) + return new Promise((resolve, reject) => { + readAsync(binaryFile, (response) => resolve(new Uint8Array(/** @type{!ArrayBuffer} */(response))), reject) + }); + } + } + } + + // Otherwise, getBinary should be able to get it synchronously + return Promise.resolve().then(() => getBinary(binaryFile)); +} + +function instantiateArrayBuffer(binaryFile, imports, receiver) { + return getBinaryPromise(binaryFile).then((binary) => { + return WebAssembly.instantiate(binary, imports); + }).then((instance) => { + return instance; + }).then(receiver, (reason) => { + err('failed to asynchronously prepare wasm: ' + reason); + + // Warn on some common problems. + if (isFileURI(wasmBinaryFile)) { + err('warning: Loading from a file URI (' + wasmBinaryFile + ') is not supported in most browsers. See https://emscripten.org/docs/getting_started/FAQ.html#how-do-i-run-a-local-webserver-for-testing-why-does-my-program-stall-in-downloading-or-preparing'); + } + abort(reason); + }); +} + +function instantiateAsync(binary, binaryFile, imports, callback) { + if (!binary && + typeof WebAssembly.instantiateStreaming == 'function' && + !isDataURI(binaryFile) && + // Don't use streaming for file:// delivered objects in a webview, fetch them synchronously. + !isFileURI(binaryFile) && + // Avoid instantiateStreaming() on Node.js environment for now, as while + // Node.js v18.1.0 implements it, it does not have a full fetch() + // implementation yet. + // + // Reference: + // https://github.com/emscripten-core/emscripten/pull/16917 + !ENVIRONMENT_IS_NODE && + typeof fetch == 'function') { + return fetch(binaryFile, { credentials: 'same-origin' }).then((response) => { + // Suppress closure warning here since the upstream definition for + // instantiateStreaming only allows Promise rather than + // an actual Response. + // TODO(https://github.com/google/closure-compiler/pull/3913): Remove if/when upstream closure is fixed. + /** @suppress {checkTypes} */ + var result = WebAssembly.instantiateStreaming(response, imports); + + return result.then( + callback, + function(reason) { + // We expect the most common failure cause to be a bad MIME type for the binary, + // in which case falling back to ArrayBuffer instantiation should work. + err('wasm streaming compile failed: ' + reason); + err('falling back to ArrayBuffer instantiation'); + return instantiateArrayBuffer(binaryFile, imports, callback); + }); + }); + } else { + return instantiateArrayBuffer(binaryFile, imports, callback); + } +} + +// Create the wasm instance. +// Receives the wasm imports, returns the exports. +function createWasm() { + // prepare imports + var info = { + 'env': wasmImports, + 'wasi_snapshot_preview1': wasmImports, + }; + // Load the wasm module and create an instance of using native support in the JS engine. + // handle a generated wasm instance, receiving its exports and + // performing other necessary setup + /** @param {WebAssembly.Module=} module*/ + function receiveInstance(instance, module) { + var exports = instance.exports; + + Module['asm'] = exports; + + wasmMemory = Module['asm']['memory']; + assert(wasmMemory, "memory not found in wasm exports"); + // This assertion doesn't hold when emscripten is run in --post-link + // mode. + // TODO(sbc): Read INITIAL_MEMORY out of the wasm file in post-link mode. + //assert(wasmMemory.buffer.byteLength === 16777216); + updateMemoryViews(); + + wasmTable = Module['asm']['__indirect_function_table']; + assert(wasmTable, "table not found in wasm exports"); + + addOnInit(Module['asm']['__wasm_call_ctors']); + + removeRunDependency('wasm-instantiate'); + return exports; + } + // wait for the pthread pool (if any) + addRunDependency('wasm-instantiate'); + + // Prefer streaming instantiation if available. + // Async compilation can be confusing when an error on the page overwrites Module + // (for example, if the order of elements is wrong, and the one defining Module is + // later), so we save Module and check it later. + var trueModule = Module; + function receiveInstantiationResult(result) { + // 'result' is a ResultObject object which has both the module and instance. + // receiveInstance() will swap in the exports (to Module.asm) so they can be called + assert(Module === trueModule, 'the Module object should not be replaced during async compilation - perhaps the order of HTML elements is wrong?'); + trueModule = null; + // TODO: Due to Closure regression https://github.com/google/closure-compiler/issues/3193, the above line no longer optimizes out down to the following line. + // When the regression is fixed, can restore the above PTHREADS-enabled path. + receiveInstance(result['instance']); + } + + // User shell pages can write their own Module.instantiateWasm = function(imports, successCallback) callback + // to manually instantiate the Wasm module themselves. This allows pages to + // run the instantiation parallel to any other async startup actions they are + // performing. + // Also pthreads and wasm workers initialize the wasm instance through this + // path. + if (Module['instantiateWasm']) { + + try { + return Module['instantiateWasm'](info, receiveInstance); + } catch(e) { + err('Module.instantiateWasm callback failed with error: ' + e); + return false; + } + } + + instantiateAsync(wasmBinary, wasmBinaryFile, info, receiveInstantiationResult); + return {}; // no exports yet; we'll fill them in later +} + +// Globals used by JS i64 conversions (see makeSetValue) +var tempDouble; +var tempI64; + +// include: runtime_debug.js +function legacyModuleProp(prop, newName) { + if (!Object.getOwnPropertyDescriptor(Module, prop)) { + Object.defineProperty(Module, prop, { + configurable: true, + get: function() { + abort('Module.' + prop + ' has been replaced with plain ' + newName + ' (the initial value can be provided on Module, but after startup the value is only looked for on a local variable of that name)'); + } + }); + } +} + +function ignoredModuleProp(prop) { + if (Object.getOwnPropertyDescriptor(Module, prop)) { + abort('`Module.' + prop + '` was supplied but `' + prop + '` not included in INCOMING_MODULE_JS_API'); + } +} + +// forcing the filesystem exports a few things by default +function isExportedByForceFilesystem(name) { + return name === 'FS_createPath' || + name === 'FS_createDataFile' || + name === 'FS_createPreloadedFile' || + name === 'FS_unlink' || + name === 'addRunDependency' || + // The old FS has some functionality that WasmFS lacks. + name === 'FS_createLazyFile' || + name === 'FS_createDevice' || + name === 'removeRunDependency'; +} + +function missingGlobal(sym, msg) { + if (typeof globalThis !== 'undefined') { + Object.defineProperty(globalThis, sym, { + configurable: true, + get: function() { + warnOnce('`' + sym + '` is not longer defined by emscripten. ' + msg); + return undefined; + } + }); + } +} + +missingGlobal('buffer', 'Please use HEAP8.buffer or wasmMemory.buffer'); + +function missingLibrarySymbol(sym) { + if (typeof globalThis !== 'undefined' && !Object.getOwnPropertyDescriptor(globalThis, sym)) { + Object.defineProperty(globalThis, sym, { + configurable: true, + get: function() { + // Can't `abort()` here because it would break code that does runtime + // checks. e.g. `if (typeof SDL === 'undefined')`. + var msg = '`' + sym + '` is a library symbol and not included by default; add it to your library.js __deps or to DEFAULT_LIBRARY_FUNCS_TO_INCLUDE on the command line'; + // DEFAULT_LIBRARY_FUNCS_TO_INCLUDE requires the name as it appears in + // library.js, which means $name for a JS name with no prefix, or name + // for a JS name like _name. + var librarySymbol = sym; + if (!librarySymbol.startsWith('_')) { + librarySymbol = '$' + sym; + } + msg += " (e.g. -sDEFAULT_LIBRARY_FUNCS_TO_INCLUDE='" + librarySymbol + "')"; + if (isExportedByForceFilesystem(sym)) { + msg += '. Alternatively, forcing filesystem support (-sFORCE_FILESYSTEM) can export this for you'; + } + warnOnce(msg); + return undefined; + } + }); + } + // Any symbol that is not included from the JS libary is also (by definition) + // not exported on the Module object. + unexportedRuntimeSymbol(sym); +} + +function unexportedRuntimeSymbol(sym) { + if (!Object.getOwnPropertyDescriptor(Module, sym)) { + Object.defineProperty(Module, sym, { + configurable: true, + get: function() { + var msg = "'" + sym + "' was not exported. add it to EXPORTED_RUNTIME_METHODS (see the FAQ)"; + if (isExportedByForceFilesystem(sym)) { + msg += '. Alternatively, forcing filesystem support (-sFORCE_FILESYSTEM) can export this for you'; + } + abort(msg); + } + }); + } +} + +// Used by XXXXX_DEBUG settings to output debug messages. +function dbg(text) { + // TODO(sbc): Make this configurable somehow. Its not always convenient for + // logging to show up as warnings. + console.warn.apply(console, arguments); +} +// end include: runtime_debug.js +// === Body === + +// end include: preamble.js + + /** @constructor */ + function ExitStatus(status) { + this.name = 'ExitStatus'; + this.message = `Program terminated with exit(${status})`; + this.status = status; + } + + var callRuntimeCallbacks = (callbacks) => { + while (callbacks.length > 0) { + // Pass the module as the first argument. + callbacks.shift()(Module); + } + }; + + + /** + * @param {number} ptr + * @param {string} type + */ + function getValue(ptr, type = 'i8') { + if (type.endsWith('*')) type = '*'; + switch (type) { + case 'i1': return HEAP8[((ptr)>>0)]; + case 'i8': return HEAP8[((ptr)>>0)]; + case 'i16': return HEAP16[((ptr)>>1)]; + case 'i32': return HEAP32[((ptr)>>2)]; + case 'i64': abort('to do getValue(i64) use WASM_BIGINT'); + case 'float': return HEAPF32[((ptr)>>2)]; + case 'double': return HEAPF64[((ptr)>>3)]; + case '*': return HEAPU32[((ptr)>>2)]; + default: abort(`invalid type for getValue: ${type}`); + } + } + + var ptrToString = (ptr) => { + assert(typeof ptr === 'number'); + return '0x' + ptr.toString(16).padStart(8, '0'); + }; + + + /** + * @param {number} ptr + * @param {number} value + * @param {string} type + */ + function setValue(ptr, value, type = 'i8') { + if (type.endsWith('*')) type = '*'; + switch (type) { + case 'i1': HEAP8[((ptr)>>0)] = value; break; + case 'i8': HEAP8[((ptr)>>0)] = value; break; + case 'i16': HEAP16[((ptr)>>1)] = value; break; + case 'i32': HEAP32[((ptr)>>2)] = value; break; + case 'i64': abort('to do setValue(i64) use WASM_BIGINT'); + case 'float': HEAPF32[((ptr)>>2)] = value; break; + case 'double': HEAPF64[((ptr)>>3)] = value; break; + case '*': HEAPU32[((ptr)>>2)] = value; break; + default: abort(`invalid type for setValue: ${type}`); + } + } + + var warnOnce = (text) => { + if (!warnOnce.shown) warnOnce.shown = {}; + if (!warnOnce.shown[text]) { + warnOnce.shown[text] = 1; + if (ENVIRONMENT_IS_NODE) text = 'warning: ' + text; + err(text); + } + }; + + + var UTF8Decoder = typeof TextDecoder != 'undefined' ? new TextDecoder('utf8') : undefined; + + /** + * Given a pointer 'idx' to a null-terminated UTF8-encoded string in the given + * array that contains uint8 values, returns a copy of that string as a + * Javascript String object. + * heapOrArray is either a regular array, or a JavaScript typed array view. + * @param {number} idx + * @param {number=} maxBytesToRead + * @return {string} + */ + var UTF8ArrayToString = (heapOrArray, idx, maxBytesToRead) => { + var endIdx = idx + maxBytesToRead; + var endPtr = idx; + // TextDecoder needs to know the byte length in advance, it doesn't stop on + // null terminator by itself. Also, use the length info to avoid running tiny + // strings through TextDecoder, since .subarray() allocates garbage. + // (As a tiny code save trick, compare endPtr against endIdx using a negation, + // so that undefined means Infinity) + while (heapOrArray[endPtr] && !(endPtr >= endIdx)) ++endPtr; + + if (endPtr - idx > 16 && heapOrArray.buffer && UTF8Decoder) { + return UTF8Decoder.decode(heapOrArray.subarray(idx, endPtr)); + } + var str = ''; + // If building with TextDecoder, we have already computed the string length + // above, so test loop end condition against that + while (idx < endPtr) { + // For UTF8 byte structure, see: + // http://en.wikipedia.org/wiki/UTF-8#Description + // https://www.ietf.org/rfc/rfc2279.txt + // https://tools.ietf.org/html/rfc3629 + var u0 = heapOrArray[idx++]; + if (!(u0 & 0x80)) { str += String.fromCharCode(u0); continue; } + var u1 = heapOrArray[idx++] & 63; + if ((u0 & 0xE0) == 0xC0) { str += String.fromCharCode(((u0 & 31) << 6) | u1); continue; } + var u2 = heapOrArray[idx++] & 63; + if ((u0 & 0xF0) == 0xE0) { + u0 = ((u0 & 15) << 12) | (u1 << 6) | u2; + } else { + if ((u0 & 0xF8) != 0xF0) warnOnce('Invalid UTF-8 leading byte ' + ptrToString(u0) + ' encountered when deserializing a UTF-8 string in wasm memory to a JS string!'); + u0 = ((u0 & 7) << 18) | (u1 << 12) | (u2 << 6) | (heapOrArray[idx++] & 63); + } + + if (u0 < 0x10000) { + str += String.fromCharCode(u0); + } else { + var ch = u0 - 0x10000; + str += String.fromCharCode(0xD800 | (ch >> 10), 0xDC00 | (ch & 0x3FF)); + } + } + return str; + }; + + /** + * Given a pointer 'ptr' to a null-terminated UTF8-encoded string in the + * emscripten HEAP, returns a copy of that string as a Javascript String object. + * + * @param {number} ptr + * @param {number=} maxBytesToRead - An optional length that specifies the + * maximum number of bytes to read. You can omit this parameter to scan the + * string until the first 0 byte. If maxBytesToRead is passed, and the string + * at [ptr, ptr+maxBytesToReadr[ contains a null byte in the middle, then the + * string will cut short at that byte index (i.e. maxBytesToRead will not + * produce a string of exact length [ptr, ptr+maxBytesToRead[) N.B. mixing + * frequent uses of UTF8ToString() with and without maxBytesToRead may throw + * JS JIT optimizations off, so it is worth to consider consistently using one + * @return {string} + */ + var UTF8ToString = (ptr, maxBytesToRead) => { + assert(typeof ptr == 'number'); + return ptr ? UTF8ArrayToString(HEAPU8, ptr, maxBytesToRead) : ''; + }; + var SYSCALLS = {varargs:undefined,get:function() { + assert(SYSCALLS.varargs != undefined); + SYSCALLS.varargs += 4; + var ret = HEAP32[(((SYSCALLS.varargs)-(4))>>2)]; + return ret; + },getStr:function(ptr) { + var ret = UTF8ToString(ptr); + return ret; + }}; + var _proc_exit = (code) => { + EXITSTATUS = code; + if (!keepRuntimeAlive()) { + if (Module['onExit']) Module['onExit'](code); + ABORT = true; + } + quit_(code, new ExitStatus(code)); + }; + /** @param {boolean|number=} implicit */ + var exitJS = (status, implicit) => { + EXITSTATUS = status; + + checkUnflushedContent(); + + // if exit() was called explicitly, warn the user if the runtime isn't actually being shut down + if (keepRuntimeAlive() && !implicit) { + var msg = `program exited (with status: ${status}), but keepRuntimeAlive() is set (counter=${runtimeKeepaliveCounter}) due to an async operation, so halting execution but not exiting the runtime or preventing further async execution (you can use emscripten_force_exit, if you want to force a true shutdown)`; + err(msg); + } + + _proc_exit(status); + }; + + var handleException = (e) => { + // Certain exception types we do not treat as errors since they are used for + // internal control flow. + // 1. ExitStatus, which is thrown by exit() + // 2. "unwind", which is thrown by emscripten_unwind_to_js_event_loop() and others + // that wish to return to JS event loop. + if (e instanceof ExitStatus || e == 'unwind') { + return EXITSTATUS; + } + checkStackCookie(); + if (e instanceof WebAssembly.RuntimeError) { + if (_emscripten_stack_get_current() <= 0) { + err('Stack overflow detected. You can try increasing -sSTACK_SIZE (currently set to 65536)'); + } + } + quit_(1, e); + }; +function checkIncomingModuleAPI() { + ignoredModuleProp('fetchSettings'); +} +var wasmImports = { + +}; +var asm = createWasm(); +/** @type {function(...*):?} */ +var ___wasm_call_ctors = createExportWrapper("__wasm_call_ctors"); +/** @type {function(...*):?} */ +var _main = Module["_main"] = createExportWrapper("main"); +/** @type {function(...*):?} */ +var ___errno_location = createExportWrapper("__errno_location"); +/** @type {function(...*):?} */ +var _fflush = Module["_fflush"] = createExportWrapper("fflush"); +/** @type {function(...*):?} */ +var _emscripten_stack_init = function() { + return (_emscripten_stack_init = Module["asm"]["emscripten_stack_init"]).apply(null, arguments); +}; + +/** @type {function(...*):?} */ +var _emscripten_stack_get_free = function() { + return (_emscripten_stack_get_free = Module["asm"]["emscripten_stack_get_free"]).apply(null, arguments); +}; + +/** @type {function(...*):?} */ +var _emscripten_stack_get_base = function() { + return (_emscripten_stack_get_base = Module["asm"]["emscripten_stack_get_base"]).apply(null, arguments); +}; + +/** @type {function(...*):?} */ +var _emscripten_stack_get_end = function() { + return (_emscripten_stack_get_end = Module["asm"]["emscripten_stack_get_end"]).apply(null, arguments); +}; + +/** @type {function(...*):?} */ +var stackSave = createExportWrapper("stackSave"); +/** @type {function(...*):?} */ +var stackRestore = createExportWrapper("stackRestore"); +/** @type {function(...*):?} */ +var stackAlloc = createExportWrapper("stackAlloc"); +/** @type {function(...*):?} */ +var _emscripten_stack_get_current = function() { + return (_emscripten_stack_get_current = Module["asm"]["emscripten_stack_get_current"]).apply(null, arguments); +}; + + + +// include: postamble.js +// === Auto-generated postamble setup entry stuff === + +var missingLibrarySymbols = [ + 'zeroMemory', + 'getHeapMax', + 'abortOnCannotGrowMemory', + 'growMemory', + 'isLeapYear', + 'ydayFromDate', + 'arraySum', + 'addDays', + 'setErrNo', + 'inetPton4', + 'inetNtop4', + 'inetPton6', + 'inetNtop6', + 'readSockaddr', + 'writeSockaddr', + 'getHostByName', + 'initRandomFill', + 'randomFill', + 'traverseStack', + 'getCallstack', + 'emscriptenLog', + 'convertPCtoSourceLocation', + 'readEmAsmArgs', + 'jstoi_q', + 'jstoi_s', + 'getExecutableName', + 'listenOnce', + 'autoResumeAudioContext', + 'dynCallLegacy', + 'getDynCaller', + 'dynCall', + 'runtimeKeepalivePush', + 'runtimeKeepalivePop', + 'callUserCallback', + 'maybeExit', + 'safeSetTimeout', + 'asmjsMangle', + 'asyncLoad', + 'alignMemory', + 'mmapAlloc', + 'HandleAllocator', + 'getNativeTypeSize', + 'STACK_SIZE', + 'STACK_ALIGN', + 'POINTER_SIZE', + 'ASSERTIONS', + 'writeI53ToI64', + 'writeI53ToI64Clamped', + 'writeI53ToI64Signaling', + 'writeI53ToU64Clamped', + 'writeI53ToU64Signaling', + 'readI53FromI64', + 'readI53FromU64', + 'convertI32PairToI53', + 'convertI32PairToI53Checked', + 'convertU32PairToI53', + 'getCFunc', + 'ccall', + 'cwrap', + 'uleb128Encode', + 'sigToWasmTypes', + 'generateFuncType', + 'convertJsFunctionToWasm', + 'getEmptyTableSlot', + 'updateTableMap', + 'getFunctionAddress', + 'addFunction', + 'removeFunction', + 'reallyNegative', + 'unSign', + 'strLen', + 'reSign', + 'formatString', + 'stringToUTF8Array', + 'stringToUTF8', + 'lengthBytesUTF8', + 'intArrayFromString', + 'intArrayToString', + 'AsciiToString', + 'stringToAscii', + 'UTF16ToString', + 'stringToUTF16', + 'lengthBytesUTF16', + 'UTF32ToString', + 'stringToUTF32', + 'lengthBytesUTF32', + 'stringToNewUTF8', + 'stringToUTF8OnStack', + 'writeArrayToMemory', + 'registerKeyEventCallback', + 'maybeCStringToJsString', + 'findEventTarget', + 'findCanvasEventTarget', + 'getBoundingClientRect', + 'fillMouseEventData', + 'registerMouseEventCallback', + 'registerWheelEventCallback', + 'registerUiEventCallback', + 'registerFocusEventCallback', + 'fillDeviceOrientationEventData', + 'registerDeviceOrientationEventCallback', + 'fillDeviceMotionEventData', + 'registerDeviceMotionEventCallback', + 'screenOrientation', + 'fillOrientationChangeEventData', + 'registerOrientationChangeEventCallback', + 'fillFullscreenChangeEventData', + 'registerFullscreenChangeEventCallback', + 'JSEvents_requestFullscreen', + 'JSEvents_resizeCanvasForFullscreen', + 'registerRestoreOldStyle', + 'hideEverythingExceptGivenElement', + 'restoreHiddenElements', + 'setLetterbox', + 'softFullscreenResizeWebGLRenderTarget', + 'doRequestFullscreen', + 'fillPointerlockChangeEventData', + 'registerPointerlockChangeEventCallback', + 'registerPointerlockErrorEventCallback', + 'requestPointerLock', + 'fillVisibilityChangeEventData', + 'registerVisibilityChangeEventCallback', + 'registerTouchEventCallback', + 'fillGamepadEventData', + 'registerGamepadEventCallback', + 'registerBeforeUnloadEventCallback', + 'fillBatteryEventData', + 'battery', + 'registerBatteryEventCallback', + 'setCanvasElementSize', + 'getCanvasElementSize', + 'demangle', + 'demangleAll', + 'jsStackTrace', + 'stackTrace', + 'getEnvStrings', + 'checkWasiClock', + 'flush_NO_FILESYSTEM', + 'wasiRightsToMuslOFlags', + 'wasiOFlagsToMuslOFlags', + 'createDyncallWrapper', + 'setImmediateWrapped', + 'clearImmediateWrapped', + 'polyfillSetImmediate', + 'getPromise', + 'makePromise', + 'idsToPromises', + 'makePromiseCallback', + 'ExceptionInfo', + 'setMainLoop', + 'getSocketFromFD', + 'getSocketAddress', + 'FS_createPreloadedFile', + 'FS_modeStringToFlags', + 'FS_getMode', + '_setNetworkCallback', + 'heapObjectForWebGLType', + 'heapAccessShiftForWebGLHeap', + 'webgl_enable_ANGLE_instanced_arrays', + 'webgl_enable_OES_vertex_array_object', + 'webgl_enable_WEBGL_draw_buffers', + 'webgl_enable_WEBGL_multi_draw', + 'emscriptenWebGLGet', + 'computeUnpackAlignedImageSize', + 'colorChannelsInGlTextureFormat', + 'emscriptenWebGLGetTexPixelData', + '__glGenObject', + 'emscriptenWebGLGetUniform', + 'webglGetUniformLocation', + 'webglPrepareUniformLocationsBeforeFirstUse', + 'webglGetLeftBracePos', + 'emscriptenWebGLGetVertexAttrib', + '__glGetActiveAttribOrUniform', + 'writeGLArray', + 'registerWebGlEventCallback', + 'runAndAbortIfError', + 'SDL_unicode', + 'SDL_ttfContext', + 'SDL_audio', + 'GLFW_Window', + 'ALLOC_NORMAL', + 'ALLOC_STACK', + 'allocate', + 'writeStringToMemory', + 'writeAsciiToMemory', +]; +missingLibrarySymbols.forEach(missingLibrarySymbol) + +var unexportedSymbols = [ + 'run', + 'addOnPreRun', + 'addOnInit', + 'addOnPreMain', + 'addOnExit', + 'addOnPostRun', + 'addRunDependency', + 'removeRunDependency', + 'FS_createFolder', + 'FS_createPath', + 'FS_createDataFile', + 'FS_createLazyFile', + 'FS_createLink', + 'FS_createDevice', + 'FS_unlink', + 'out', + 'err', + 'callMain', + 'abort', + 'keepRuntimeAlive', + 'wasmMemory', + 'stackAlloc', + 'stackSave', + 'stackRestore', + 'getTempRet0', + 'setTempRet0', + 'writeStackCookie', + 'checkStackCookie', + 'ptrToString', + 'exitJS', + 'ENV', + 'MONTH_DAYS_REGULAR', + 'MONTH_DAYS_LEAP', + 'MONTH_DAYS_REGULAR_CUMULATIVE', + 'MONTH_DAYS_LEAP_CUMULATIVE', + 'ERRNO_CODES', + 'ERRNO_MESSAGES', + 'DNS', + 'Protocols', + 'Sockets', + 'timers', + 'warnOnce', + 'UNWIND_CACHE', + 'readEmAsmArgsArray', + 'handleException', + 'freeTableIndexes', + 'functionsInTableMap', + 'setValue', + 'getValue', + 'PATH', + 'PATH_FS', + 'UTF8Decoder', + 'UTF8ArrayToString', + 'UTF8ToString', + 'UTF16Decoder', + 'JSEvents', + 'specialHTMLTargets', + 'currentFullscreenStrategy', + 'restoreOldWindowedStyle', + 'ExitStatus', + 'promiseMap', + 'uncaughtExceptionCount', + 'exceptionLast', + 'exceptionCaught', + 'Browser', + 'wget', + 'SYSCALLS', + 'preloadPlugins', + 'FS', + 'MEMFS', + 'TTY', + 'PIPEFS', + 'SOCKFS', + 'tempFixedLengthArray', + 'miniTempWebGLFloatBuffers', + 'miniTempWebGLIntBuffers', + 'GL', + 'emscripten_webgl_power_preferences', + 'AL', + 'GLUT', + 'EGL', + 'GLEW', + 'IDBStore', + 'SDL', + 'SDL_gfx', + 'GLFW', + 'allocateUTF8', + 'allocateUTF8OnStack', +]; +unexportedSymbols.forEach(unexportedRuntimeSymbol); + + + +var calledRun; + +dependenciesFulfilled = function runCaller() { + // If run has never been called, and we should call run (INVOKE_RUN is true, and Module.noInitialRun is not false) + if (!calledRun) run(); + if (!calledRun) dependenciesFulfilled = runCaller; // try this again later, after new deps are fulfilled +}; + +function callMain() { + assert(runDependencies == 0, 'cannot call main when async dependencies remain! (listen on Module["onRuntimeInitialized"])'); + assert(__ATPRERUN__.length == 0, 'cannot call main when preRun functions remain to be called'); + + var entryFunction = _main; + + var argc = 0; + var argv = 0; + + try { + + var ret = entryFunction(argc, argv); + + // if we're not running an evented main loop, it's time to exit + exitJS(ret, /* implicit = */ true); + return ret; + } + catch (e) { + return handleException(e); + } +} + +function stackCheckInit() { + // This is normally called automatically during __wasm_call_ctors but need to + // get these values before even running any of the ctors so we call it redundantly + // here. + _emscripten_stack_init(); + // TODO(sbc): Move writeStackCookie to native to to avoid this. + writeStackCookie(); +} + +function run() { + + if (runDependencies > 0) { + return; + } + + stackCheckInit(); + + preRun(); + + // a preRun added a dependency, run will be called later + if (runDependencies > 0) { + return; + } + + function doRun() { + // run may have just been called through dependencies being fulfilled just in this very frame, + // or while the async setStatus time below was happening + if (calledRun) return; + calledRun = true; + Module['calledRun'] = true; + + if (ABORT) return; + + initRuntime(); + + preMain(); + + if (Module['onRuntimeInitialized']) Module['onRuntimeInitialized'](); + + if (shouldRunNow) callMain(); + + postRun(); + } + + if (Module['setStatus']) { + Module['setStatus']('Running...'); + setTimeout(function() { + setTimeout(function() { + Module['setStatus'](''); + }, 1); + doRun(); + }, 1); + } else + { + doRun(); + } + checkStackCookie(); +} + +function checkUnflushedContent() { + // Compiler settings do not allow exiting the runtime, so flushing + // the streams is not possible. but in ASSERTIONS mode we check + // if there was something to flush, and if so tell the user they + // should request that the runtime be exitable. + // Normally we would not even include flush() at all, but in ASSERTIONS + // builds we do so just for this check, and here we see if there is any + // content to flush, that is, we check if there would have been + // something a non-ASSERTIONS build would have not seen. + // How we flush the streams depends on whether we are in SYSCALLS_REQUIRE_FILESYSTEM=0 + // mode (which has its own special function for this; otherwise, all + // the code is inside libc) + var oldOut = out; + var oldErr = err; + var has = false; + out = err = (x) => { + has = true; + } + try { // it doesn't matter if it fails + _fflush(0); + } catch(e) {} + out = oldOut; + err = oldErr; + if (has) { + warnOnce('stdio streams had content in them that was not flushed. you should set EXIT_RUNTIME to 1 (see the FAQ), or make sure to emit a newline when you printf etc.'); + warnOnce('(this may also be due to not including full filesystem support - try building with -sFORCE_FILESYSTEM)'); + } +} + +if (Module['preInit']) { + if (typeof Module['preInit'] == 'function') Module['preInit'] = [Module['preInit']]; + while (Module['preInit'].length > 0) { + Module['preInit'].pop()(); + } +} + +// shouldRunNow refers to calling main(), not run(). +var shouldRunNow = true; + +if (Module['noInitialRun']) shouldRunNow = false; + +run(); + + +// end include: postamble.js ===================================== utils/ghc-toolchain/test.c ===================================== @@ -0,0 +1 @@ +int f() {return 0;} ===================================== utils/ghc-toolchain/test.wasm ===================================== Binary files /dev/null and b/utils/ghc-toolchain/test.wasm differ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8689c726a54aa1831c93ae8d195757d14a2946a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8689c726a54aa1831c93ae8d195757d14a2946a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 10:37:24 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 11 Jul 2023 06:37:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23625 Message-ID: <64ad30e4b146e_1c29a5b16d427701b@gitlab.mail> Matthew Pickering pushed new branch wip/t23625 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23625 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 11:00:28 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 07:00:28 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: dont validate ghc-toolchain host Message-ID: <64ad364c53024_1c29a5b165c2883c1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c8e21124 by Rodrigo Mesquita at 2023-07-11T11:42:15+01:00 dont validate ghc-toolchain host - - - - - a78b4dcd by Rodrigo Mesquita at 2023-07-11T12:00:19+01:00 fixup! Windows builtin toolchain - - - - - 4 changed files: - configure.ac - distrib/configure.ac.in - m4/fp_settings.m4 - m4/ghc_toolchain.m4 Changes: ===================================== configure.ac ===================================== @@ -1299,6 +1299,17 @@ For more information on how to configure your GHC build, see https://gitlab.haskell.org/ghc/ghc/wikis/building "] -VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.ghc-toolchain.host.target]) +# Currently we don't validate the /host/ GHC toolchain because configure +# doesn't configure flags and properties for most of the host toolchain +# +# In fact, most values in default.host.target are dummy values since they are +# never used (see default.host.target.in) +# +# When we move to configure toolchains by means of ghc-toolchain only, we'll +# have a correct complete /host/ toolchain rather than an incomplete one, which +# might further unlock things like canadian cross-compilation +# +# VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.ghc-toolchain.host.target]) + VALIDATE_GHC_TOOLCHAIN([default.target],[default.ghc-toolchain.target]) ===================================== distrib/configure.ac.in ===================================== @@ -313,7 +313,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE FIND_GHC_TOOLCHAIN -VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.ghc-toolchain.host.target]) + VALIDATE_GHC_TOOLCHAIN([default.target],[default.ghc-toolchain.target]) echo "****************************************************" ===================================== m4/fp_settings.m4 ===================================== @@ -6,7 +6,7 @@ AC_DEFUN([SUBST_TOOLDIR], [ dnl See Note [tooldir: How GHC finds mingw on Windows] - $1=`echo $1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` + $1=`echo $$1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` ]) # FP_SETTINGS ===================================== m4/ghc_toolchain.m4 ===================================== @@ -94,7 +94,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--ar=$AR" >> acargs echo "--ranlib=$RANLIB" >> acargs echo "--nm=$NM" >> acargs - echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs + echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs echo "--dllwrap=$DllWrapCmd" >> acargs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8689c726a54aa1831c93ae8d195757d14a2946a...a78b4dcdd9715acfc15ae96b07e764c29c6a22af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8689c726a54aa1831c93ae8d195757d14a2946a...a78b4dcdd9715acfc15ae96b07e764c29c6a22af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 12:07:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 11 Jul 2023 08:07:41 -0400 Subject: [Git][ghc/ghc][master] 2 commits: compiler: Fingerprint more code generation flags Message-ID: <64ad460d1d703_1c29a5b1670317224@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 16 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - docs/users_guide/debugging.rst - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_run/OrigThunkInfo.hs - + testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout - testsuite/tests/codeGen/should_run/all.T - utils/deriveConstants/Main.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -41,6 +41,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -5,6 +5,7 @@ module GHC.Driver.Flags , GeneralFlag(..) , Language(..) , optimisationFlags + , codeGenFlags -- * Warnings , WarningGroup(..) @@ -337,6 +338,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -484,15 +486,11 @@ data GeneralFlag | Opt_G_NoOptCoercion deriving (Eq, Show, Enum) --- Check whether a flag should be considered an "optimisation flag" --- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is --- not a guarantee that the flag has no other effect. We could, and --- perhaps should, separate out the flags that have some minor impact on --- program semantics and/or error behavior (e.g., assertions), but --- then we'd need to go to extra trouble (and an additional flag) --- to allow users to ignore the optimisation level even though that --- means ignoring some change. +-- | The set of flags which affect optimisation for the purposes of +-- recompilation avoidance. Specifically, these include flags which +-- affect code generation but not the semantics of the program. +-- +-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags) optimisationFlags :: EnumSet GeneralFlag optimisationFlags = EnumSet.fromList [ Opt_CallArity @@ -524,16 +522,12 @@ optimisationFlags = EnumSet.fromList , Opt_EnableRewriteRules , Opt_RegsGraph , Opt_RegsIterative - , Opt_PedanticBottoms , Opt_LlvmTBAA - , Opt_LlvmFillUndefWithGarbage , Opt_IrrefutableTuples , Opt_CmmSink , Opt_CmmElimCommonBlocks , Opt_AsmShortcutting - , Opt_OmitYields , Opt_FunToThunk - , Opt_DictsStrict , Opt_DmdTxDictSel , Opt_Loopification , Opt_CfgBlocklayout @@ -542,8 +536,48 @@ optimisationFlags = EnumSet.fromList , Opt_WorkerWrapper , Opt_WorkerWrapperUnlift , Opt_SolveConstantDicts + ] + +-- | The set of flags which affect code generation and can change a program's +-- runtime behavior (other than performance). These include flags which affect: +-- +-- * user visible debugging information (e.g. info table provenance) +-- * the ability to catch runtime errors (e.g. -fignore-asserts) +-- * the runtime result of the program (e.g. -fomit-yields) +-- * which code or interface file declarations are emitted +-- +-- We also considered placing flags which affect asympototic space behavior +-- (e.g. -ffull-laziness) however this would mean that changing optimisation +-- levels would trigger recompilation even with -fignore-optim-changes, +-- regressing #13604. +-- +-- Also, arguably Opt_IgnoreAsserts should be here as well; however, we place +-- it instead in 'optimisationFlags' since it is implied by @-O[12]@ and +-- therefore would also break #13604. +-- +-- See #23369. +codeGenFlags :: EnumSet GeneralFlag +codeGenFlags = EnumSet.fromList + [ -- Flags that affect runtime result + Opt_EagerBlackHoling + , Opt_ExcessPrecision + , Opt_DictsStrict + , Opt_PedanticBottoms + , Opt_OmitYields + + -- Flags that affect generated code + , Opt_ExposeAllUnfoldings + , Opt_NoTypeableBinds + + -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases - , Opt_IgnoreAsserts + , Opt_LlvmFillUndefWithGarbage + , Opt_DoTagInferenceChecks + + -- Flags that affect debugging information + , Opt_DistinctConstructorTables + , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Driver.Session ( makeDynFlagsConsistent, positionIndependent, optimisationFlags, + codeGenFlags, setFlagsFromEnvFile, pprDynFlagsDiff, flagSpecOf, @@ -2346,6 +2347,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Other flags which affect code generation + codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -50,6 +50,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== docs/users_guide/debugging.rst ===================================== @@ -1115,6 +1115,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== rts/RtsSymbols.c ===================================== @@ -870,7 +870,8 @@ extern char **environ; SymI_HasDataProto(stg_unpack_cstring_utf8_info) \ SymI_HasDataProto(stg_upd_frame_info) \ SymI_HasDataProto(stg_bh_upd_frame_info) \ - SymI_HasProto(suspendThread) \ + SymI_HasDataProto(stg_orig_thunk_info_frame_info) \ + SymI_HasProto(suspendThread) \ SymI_HasDataProto(stg_takeMVarzh) \ SymI_HasDataProto(stg_readMVarzh) \ SymI_HasDataProto(stg_threadStatuszh) \ @@ -878,7 +879,7 @@ extern char **environ; SymI_HasDataProto(stg_tryTakeMVarzh) \ SymI_HasDataProto(stg_tryReadMVarzh) \ SymI_HasDataProto(stg_unmaskAsyncExceptionszh) \ - SymI_HasProto(unloadObj) \ + SymI_HasProto(unloadObj) \ SymI_HasDataProto(stg_unsafeThawArrayzh) \ SymI_HasDataProto(stg_waitReadzh) \ SymI_HasDataProto(stg_waitWritezh) \ @@ -892,7 +893,7 @@ extern char **environ; SymI_NeedsProto(stg_interp_constr5_entry) \ SymI_NeedsProto(stg_interp_constr6_entry) \ SymI_NeedsProto(stg_interp_constr7_entry) \ - SymI_HasDataProto(stg_arg_bitmaps) \ + SymI_HasDataProto(stg_arg_bitmaps) \ SymI_HasProto(large_alloc_lim) \ SymI_HasProto(g0) \ SymI_HasProto(allocate) \ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -52,6 +52,7 @@ RTS_RET(stg_upd_frame); RTS_RET(stg_bh_upd_frame); RTS_RET(stg_marked_upd_frame); RTS_RET(stg_noupd_frame); +RTS_RET(stg_orig_thunk_info_frame); RTS_RET(stg_catch_frame); RTS_RET(stg_catch_retry_frame); RTS_RET(stg_atomically_frame); ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.hs ===================================== @@ -0,0 +1,4 @@ +module Main where +xs = iterate (+1) 0 +ten = xs !! 10 +main = print ten ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout ===================================== @@ -0,0 +1,2 @@ +10 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,4 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) +test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4926af7b018212356e9966685717c24a8da04030...eb6231494ada8f8468404f1ce3d2939a022a6ee5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4926af7b018212356e9966685717c24a8da04030...eb6231494ada8f8468404f1ce3d2939a022a6ee5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 12:08:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 11 Jul 2023 08:08:31 -0400 Subject: [Git][ghc/ghc][master] Fix wrong MIN_VERSION_GLASGOW_HASKELL macros Message-ID: <64ad463fa1407_1c29a5b16483240a4@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 1 changed file: - compiler/cbits/genSym.c Changes: ===================================== compiler/cbits/genSym.c ===================================== @@ -9,7 +9,7 @@ // // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) HsWord64 ghc_unique_counter64 = 0; #endif #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) @@ -18,7 +18,7 @@ HsInt ghc_unique_inc = 1; // This function has been added to the RTS. Here we pessimistically assume // that a threaded RTS is used. This function is only used for bootstrapping. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4731f44e430cf78ffaea8bffb28c2d29e6784ec5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4731f44e430cf78ffaea8bffb28c2d29e6784ec5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 12:25:56 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 11 Jul 2023 08:25:56 -0400 Subject: [Git][ghc/ghc][wip/T17521] Fix doc Message-ID: <64ad4a54711da_1c29a5b16e833147b@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 42b140fa by Jaro Reinders at 2023-07-11T14:25:48+02:00 Fix doc - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2029,8 +2029,8 @@ exprIsTopLevelBindable expr ty exprIsTickedString :: CoreExpr -> Bool exprIsTickedString = isJust . exprIsTickedString_maybe --- | Check if the expression is trivial or a constructor application and --- continue checking all arguments of that constructor recursively. +-- | Check if the expression is a constructor worker application to arguments +-- which are either trivial or themselves constructor worker applications, etc. exprIsNestedTrivialConApp :: CoreExpr -> Bool exprIsNestedTrivialConApp x | (Var v, xs) <- collectArgs x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42b140fa8c32cb355217116230300a9de274c3b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42b140fa8c32cb355217116230300a9de274c3b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 12:41:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 11 Jul 2023 08:41:35 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] rts: Make collectFreshWeakPtrs definition a prototype Message-ID: <64ad4dffa886e_1c29a5b1634341455@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 8aa9a7ad by Ben Gamari at 2023-07-11T08:30:11-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. (cherry picked from commit bb0ed354b9b05c0774c1e9379823bceb785987ce) - - - - - 1 changed file: - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/MarkWeak.c ===================================== @@ -457,7 +457,7 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) * Traverse the capabilities' local new-weak-pointer lists at the beginning of * GC and move them to the nursery's weak_ptr_list. */ -void collectFreshWeakPtrs() +void collectFreshWeakPtrs( void ) { uint32_t i; // move recently allocated weak_ptr_list to the old list as well View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8aa9a7ad5f159f068c06a064328d03ab8e71916b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8aa9a7ad5f159f068c06a064328d03ab8e71916b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 14:01:40 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 11 Jul 2023 10:01:40 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 9 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) Message-ID: <64ad60c432c01_1c29a5b16c0398484@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 6fc61f19 by Matthew Craven at 2023-07-11T14:57:17+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToCmm/Bind.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9541e0a363de6ca0200991e7ee1d1c7d8415924...6fc61f19517aaf0dac73d5c05ad6e819cbb402bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9541e0a363de6ca0200991e7ee1d1c7d8415924...6fc61f19517aaf0dac73d5c05ad6e819cbb402bd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 14:04:02 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Tue, 11 Jul 2023 10:04:02 -0400 Subject: [Git][ghc/ghc][wip/bump-bytestring-0.11.5.0] Bump bytestring submodule to 0.11.5.0 Message-ID: <64ad615245ff3_1c29a5b16344009f1@gitlab.mail> Matthew Craven pushed to branch wip/bump-bytestring-0.11.5.0 at Glasgow Haskell Compiler / GHC Commits: 013ac86f by Matthew Craven at 2023-07-11T10:03:01-04:00 Bump bytestring submodule to 0.11.5.0 - - - - - 6 changed files: - .gitlab-ci.yml - compiler/GHC/Utils/Binary.hs - hadrian/src/Settings/Warnings.hs - libraries/bytestring - testsuite/tests/ghci/scripts/T9881.stdout - testsuite/tests/ghci/scripts/ghci025.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -393,7 +393,7 @@ hadrian-multi: # workaround for docker permissions - sudo chown ghc:ghc -R . variables: - GHC_FLAGS: -Werror + GHC_FLAGS: "-Werror -Wwarn=deprecations" CONFIGURE_ARGS: --enable-bootstrap-with-devel-snapshot tags: - x86_64-linux ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -1228,13 +1228,13 @@ putBS :: BinHandle -> ByteString -> IO () putBS bh bs = BS.unsafeUseAsCStringLen bs $ \(ptr, l) -> do put_ bh l - putPrim bh l (\op -> BS.memcpy op (castPtr ptr) l) + putPrim bh l (\op -> copyBytes op (castPtr ptr) l) getBS :: BinHandle -> IO ByteString getBS bh = do l <- get bh :: IO Int BS.create l $ \dest -> do - getPrim bh l (\src -> BS.memcpy dest src l) + getPrim bh l (\src -> copyBytes dest src l) instance Binary ByteString where put_ bh f = putBS bh f ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -53,10 +53,12 @@ ghcWarningsArgs = do , package primitive ? pure [ "-Wno-unused-imports" , "-Wno-deprecations" ] , package rts ? pure [ "-Wcpp-undef" ] + , package text ? pure [ "-Wno-deprecations" ] , package terminfo ? pure [ "-Wno-unused-imports" ] , package transformers ? pure [ "-Wno-unused-matches" , "-Wno-unused-imports" , "-Wno-redundant-constraints" , "-Wno-orphans" ] + , package unix ? pure [ "-Wno-deprecations" ] , package win32 ? pure [ "-Wno-trustworthy-safe" ] , package xhtml ? pure [ "-Wno-unused-imports" ] ] ] ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 9cab76dc861f651c3940e873ce921d9e09733cc8 +Subproject commit 980206c96ff8ea3e10983d060f0b2c6685edf825 ===================================== testsuite/tests/ghci/scripts/T9881.stdout ===================================== @@ -19,19 +19,19 @@ instance Ord Data.ByteString.Lazy.ByteString type Data.ByteString.ByteString :: * data Data.ByteString.ByteString - = bytestring-0.11.4.0:Data.ByteString.Internal.Type.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr + = bytestring-0.11.5.0:Data.ByteString.Internal.Type.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr GHC.Word.Word8) {-# UNPACK #-}Int - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Monoid Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Read Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Semigroup Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Show Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Eq Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ instance Ord Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘bytestring-0.11.5.0:Data.ByteString.Internal.Type’ ===================================== testsuite/tests/ghci/scripts/ghci025.stdout ===================================== @@ -54,7 +54,7 @@ Prelude.length :: Data.Foldable.Foldable t => t a -> GHC.Types.Int type T.Integer :: * data T.Integer = ... T.length :: - bytestring-0.11.4.0:Data.ByteString.Internal.Type.ByteString + bytestring-0.11.5.0:Data.ByteString.Internal.Type.ByteString -> GHC.Types.Int :browse! T -- defined locally View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/013ac86fa19bdce2f5985b143624c5cab27b3c0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/013ac86fa19bdce2f5985b143624c5cab27b3c0f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 14:05:07 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 10:05:07 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] fixup! Windows builtin toolchain Message-ID: <64ad619314ea5_1c29a5b1670401597@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: ff6421e3 by Rodrigo Mesquita at 2023-07-11T15:04:59+01:00 fixup! Windows builtin toolchain - - - - - 4 changed files: - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 Changes: ===================================== m4/fp_settings.m4 ===================================== @@ -6,7 +6,7 @@ AC_DEFUN([SUBST_TOOLDIR], [ dnl See Note [tooldir: How GHC finds mingw on Windows] - $1=`echo $1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` + $1=`echo $$1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` ]) # FP_SETTINGS ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -120,6 +120,8 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ RANLIB="${mingwbin}llvm-ranlib.exe" OBJDUMP="${mingwbin}llvm-objdump.exe" DLLTOOL="${mingwbin}llvm-dlltool.exe" + DllWrapCmd="${mingwbin}llvm-dllwrap.exe" + WindresCmd="${mingwbin}llvm-windres.exe" # N.B. LLD does not support -r MergeObjsCmd="" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -94,7 +94,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--ar=$AR" >> acargs echo "--ranlib=$RANLIB" >> acargs echo "--nm=$NM" >> acargs - echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs + echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs echo "--dllwrap=$DllWrapCmd" >> acargs ===================================== m4/prep_target_file.m4 ===================================== @@ -2,7 +2,7 @@ # ========================= # # Issue a substitution of [$1MaybeProg] with -# * Nothing, if $1 is /bin/false (this is unfortunately hardcoded since SettingsDllWrapCommand and SettingsWindresCommand get set to this on windows). +# * Nothing, if $1 is empty # * Just (Program {prgPath = "$$1", prgFlags = []}), otherwise # # $1 = optional value View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff6421e3d4e18c217965758fa94e984490c00c66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff6421e3d4e18c217965758fa94e984490c00c66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 14:18:11 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 10:18:11 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] fixup! Windows builtin toolchain Message-ID: <64ad64a32422f_1c29a5b16484053bf@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7996317b by Rodrigo Mesquita at 2023-07-11T15:18:01+01:00 fixup! Windows builtin toolchain - - - - - 5 changed files: - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs Changes: ===================================== m4/fp_settings.m4 ===================================== @@ -6,7 +6,7 @@ AC_DEFUN([SUBST_TOOLDIR], [ dnl See Note [tooldir: How GHC finds mingw on Windows] - $1=`echo $1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` + $1=`echo $$1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` ]) # FP_SETTINGS ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -120,6 +120,8 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ RANLIB="${mingwbin}llvm-ranlib.exe" OBJDUMP="${mingwbin}llvm-objdump.exe" DLLTOOL="${mingwbin}llvm-dlltool.exe" + DllWrapCmd="${mingwbin}llvm-dllwrap.exe" + WindresCmd="${mingwbin}llvm-windres.exe" # N.B. LLD does not support -r MergeObjsCmd="" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -94,7 +94,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--ar=$AR" >> acargs echo "--ranlib=$RANLIB" >> acargs echo "--nm=$NM" >> acargs - echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs + echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs echo "--dllwrap=$DllWrapCmd" >> acargs ===================================== m4/prep_target_file.m4 ===================================== @@ -2,7 +2,7 @@ # ========================= # # Issue a substitution of [$1MaybeProg] with -# * Nothing, if $1 is /bin/false (this is unfortunately hardcoded since SettingsDllWrapCommand and SettingsWindresCommand get set to this on windows). +# * Nothing, if $1 is empty # * Just (Program {prgPath = "$$1", prgFlags = []}), otherwise # # $1 = optional value ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -34,6 +34,8 @@ import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.Except as Except import System.IO hiding (readFile, writeFile, appendFile) -- import qualified System.Directory +import qualified Data.Text as T +import qualified Data.Text.IO as T data Env = Env { verbosity :: Int @@ -100,7 +102,7 @@ logMsg v msg = do when (verbosity e >= v) (liftIO $ hPutStrLn stderr $ indent ++ msg) readFile :: FilePath -> M String -readFile path = liftIO $ Prelude.readFile path +readFile path = liftIO $ T.unpack <$> T.readFile path writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7996317b03dd2180494d5dc1e63877abd0cff9be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7996317b03dd2180494d5dc1e63877abd0cff9be You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 14:40:28 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 10:40:28 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] fixup! Windows builtin toolchain Message-ID: <64ad69dc24d89_5b5e1b1b8442462@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: a2a1d869 by Rodrigo Mesquita at 2023-07-11T15:40:19+01:00 fixup! Windows builtin toolchain - - - - - 6 changed files: - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/ghc-toolchain.cabal - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs Changes: ===================================== m4/fp_settings.m4 ===================================== @@ -6,7 +6,7 @@ AC_DEFUN([SUBST_TOOLDIR], [ dnl See Note [tooldir: How GHC finds mingw on Windows] - $1=`echo $1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` + $1=`echo $$1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` ]) # FP_SETTINGS ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -120,6 +120,8 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ RANLIB="${mingwbin}llvm-ranlib.exe" OBJDUMP="${mingwbin}llvm-objdump.exe" DLLTOOL="${mingwbin}llvm-dlltool.exe" + DllWrapCmd="${mingwbin}llvm-dllwrap.exe" + WindresCmd="${mingwbin}llvm-windres.exe" # N.B. LLD does not support -r MergeObjsCmd="" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -94,7 +94,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--ar=$AR" >> acargs echo "--ranlib=$RANLIB" >> acargs echo "--nm=$NM" >> acargs - echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs + echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs echo "--dllwrap=$DllWrapCmd" >> acargs ===================================== m4/prep_target_file.m4 ===================================== @@ -2,7 +2,7 @@ # ========================= # # Issue a substitution of [$1MaybeProg] with -# * Nothing, if $1 is /bin/false (this is unfortunately hardcoded since SettingsDllWrapCommand and SettingsWindresCommand get set to this on windows). +# * Nothing, if $1 is empty # * Just (Program {prgPath = "$$1", prgFlags = []}), otherwise # # $1 = optional value ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -36,6 +36,7 @@ library filepath, process, transformers, + text, ghc-platform hs-source-dirs: src default-language: Haskell2010 ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -34,6 +34,8 @@ import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.Except as Except import System.IO hiding (readFile, writeFile, appendFile) -- import qualified System.Directory +import qualified Data.Text as T +import qualified Data.Text.IO as T data Env = Env { verbosity :: Int @@ -100,7 +102,9 @@ logMsg v msg = do when (verbosity e >= v) (liftIO $ hPutStrLn stderr $ indent ++ msg) readFile :: FilePath -> M String -readFile path = liftIO $ Prelude.readFile path +readFile path = liftIO $ T.unpack <$> T.readFile path + -- Use T.readfile to read the file strictly, or otherwise run + -- into bugs (in practice on windows)! writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a1d869a4634cd128fe0b44c4760dde7cedf3cd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a1d869a4634cd128fe0b44c4760dde7cedf3cd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 15:24:19 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 11:24:19 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] fixup! Windows builtin toolchain Message-ID: <64ad74232cc2e_5b5e1b1b4871812@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 961b4526 by Rodrigo Mesquita at 2023-07-11T16:24:11+01:00 fixup! Windows builtin toolchain - - - - - 7 changed files: - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/ghc-toolchain.cabal - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs Changes: ===================================== m4/fp_settings.m4 ===================================== @@ -6,7 +6,7 @@ AC_DEFUN([SUBST_TOOLDIR], [ dnl See Note [tooldir: How GHC finds mingw on Windows] - $1=`echo $1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` + $1=`echo $$1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` ]) # FP_SETTINGS ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -120,6 +120,8 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ RANLIB="${mingwbin}llvm-ranlib.exe" OBJDUMP="${mingwbin}llvm-objdump.exe" DLLTOOL="${mingwbin}llvm-dlltool.exe" + DllWrap="${mingwbin}llvm-dllwrap.exe" + Windres="${mingwbin}llvm-windres.exe" # N.B. LLD does not support -r MergeObjsCmd="" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -94,7 +94,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--ar=$AR" >> acargs echo "--ranlib=$RANLIB" >> acargs echo "--nm=$NM" >> acargs - echo "--merge-objs=$SettingsMergeObjectsCommand" >> acargs + echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs echo "--dllwrap=$DllWrapCmd" >> acargs ===================================== m4/prep_target_file.m4 ===================================== @@ -2,7 +2,7 @@ # ========================= # # Issue a substitution of [$1MaybeProg] with -# * Nothing, if $1 is /bin/false (this is unfortunately hardcoded since SettingsDllWrapCommand and SettingsWindresCommand get set to this on windows). +# * Nothing, if $1 is empty # * Just (Program {prgPath = "$$1", prgFlags = []}), otherwise # # $1 = optional value ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -36,6 +36,7 @@ library filepath, process, transformers, + text, ghc-platform hs-source-dirs: src default-language: Haskell2010 ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -34,6 +34,8 @@ import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.Except as Except import System.IO hiding (readFile, writeFile, appendFile) -- import qualified System.Directory +import qualified Data.Text as T +import qualified Data.Text.IO as T data Env = Env { verbosity :: Int @@ -100,7 +102,9 @@ logMsg v msg = do when (verbosity e >= v) (liftIO $ hPutStrLn stderr $ indent ++ msg) readFile :: FilePath -> M String -readFile path = liftIO $ Prelude.readFile path +readFile path = liftIO $ T.unpack <$> T.readFile path + -- Use T.readfile to read the file strictly, or otherwise run + -- into bugs (in practice on windows)! writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -51,7 +51,7 @@ findCc llvmTarget progOpt = checking "for C compiler" $ do cc' <- ignoreUnusedArgs $ Cc {ccProgram} cc <- ccSupportsTarget llvmTarget cc' - checkCcWorks cc + checking "whether Cc works" $ checkCcWorks cc checkC99Support cc checkCcSupportsExtraViaCFlags cc return cc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/961b4526e7f17ccb2bfe0c87bc6b822d3ff74fe9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/961b4526e7f17ccb2bfe0c87bc6b822d3ff74fe9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 15:26:00 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 11 Jul 2023 11:26:00 -0400 Subject: [Git][ghc/ghc][wip/t23625] Allow users to override non-essential haddock options in a Flavour Message-ID: <64ad748886608_5b5e1b1b9874157@gitlab.mail> Matthew Pickering pushed to branch wip/t23625 at Glasgow Haskell Compiler / GHC Commits: ca0760a4 by Matthew Pickering at 2023-07-11T16:25:50+01:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - 7 changed files: - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Default.hs-boot - hadrian/src/Settings/Flavours/Benchmark.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Performance.hs - hadrian/src/Settings/Flavours/Validate.hs Changes: ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -50,6 +50,10 @@ haddockBuilderArgs = mconcat baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) let baseUrl p = substituteTemplate baseUrlTemplate p ghcOpts <- haddockGhcArgs + -- These are the options which are necessary to perform the build. Additional + -- options such as `--hyperlinked-source`, `--hoogle`, `--quickjump` are + -- added by the `extraArgs` field in the flavour. The defaults are provided + -- by `defaultHaddockExtraArgs`. mconcat [ arg "--verbosity=0" , arg $ "-B" ++ root -/- stageString Stage1 -/- "lib" @@ -57,9 +61,6 @@ haddockBuilderArgs = mconcat , arg $ "--odir=" ++ takeDirectory output , arg $ "--dump-interface=" ++ output , arg "--html" - , arg "--hyperlinked-source" - , arg "--hoogle" - , arg "--quickjump" , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version ++ ": " ++ synopsis , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -7,7 +7,7 @@ module Settings.Default ( -- * Default command line arguments for various builders SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, - defaultExtraArgs, + defaultExtraArgs, defaultHaddockExtraArgs, -- * Default build flavour and BigNum backend defaultFlavour, defaultBignumBackend @@ -218,7 +218,13 @@ sourceArgs SourceArgs {..} = builder Ghc ? mconcat -- | All default command line arguments. defaultExtraArgs :: Args -defaultExtraArgs = sourceArgs defaultSourceArgs +defaultExtraArgs = + mconcat [ sourceArgs defaultSourceArgs, defaultHaddockExtraArgs ] + +defaultHaddockExtraArgs :: Args +defaultHaddockExtraArgs = builder (Haddock BuildPackage) ? + mconcat [ arg "--hyperlinked-source", arg "--hoogle", arg "--quickjump" ] + -- | Default source arguments, e.g. optimisation settings. defaultSourceArgs :: SourceArgs ===================================== hadrian/src/Settings/Default.hs-boot ===================================== @@ -1,6 +1,6 @@ module Settings.Default ( SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, - defaultExtraArgs, defaultLibraryWays, defaultRtsWays, + defaultExtraArgs, defaultHaddockExtraArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultBignumBackend ) where @@ -15,7 +15,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args -defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs :: Args +defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs, defaultHaddockExtraArgs :: Args defaultLibraryWays, defaultRtsWays :: Ways defaultFlavour :: Flavour defaultBignumBackend :: String ===================================== hadrian/src/Settings/Flavours/Benchmark.hs ===================================== @@ -10,7 +10,7 @@ import {-# SOURCE #-} Settings.Default benchmarkFlavour :: Flavour benchmarkFlavour = defaultFlavour { name = "bench" - , extraArgs = benchmarkArgs + , extraArgs = benchmarkArgs <> defaultHaddockExtraArgs , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = Set.fromList <$> mconcat [pure [vanilla], targetSupportsThreadedRts ? pure [threaded]] } ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default developmentFlavour :: Stage -> Flavour developmentFlavour ghcStage = defaultFlavour { name = "devel" ++ stageString ghcStage - , extraArgs = developmentArgs ghcStage + , extraArgs = developmentArgs ghcStage <> defaultHaddockExtraArgs , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = Set.fromList <$> mconcat [pure [vanilla, debug], targetSupportsThreadedRts ? pure [threaded, threadedDebug]] , dynamicGhcPrograms = return False ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -8,7 +8,7 @@ import {-# SOURCE #-} Settings.Default performanceFlavour :: Flavour performanceFlavour = splitSections $ defaultFlavour { name = "perf" - , extraArgs = performanceArgs } + , extraArgs = performanceArgs <> defaultHaddockExtraArgs } performanceArgs :: Args performanceArgs = sourceArgs SourceArgs ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default validateFlavour :: Flavour validateFlavour = enableLinting $ werror $ defaultFlavour { name = "validate" - , extraArgs = validateArgs + , extraArgs = validateArgs <> defaultHaddockExtraArgs , libraryWays = Set.fromList <$> mconcat [ pure [vanilla] , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca0760a4ff8174b10e859cfbee29e7d2cab931cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca0760a4ff8174b10e859cfbee29e7d2cab931cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 15:28:46 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 11 Jul 2023 11:28:46 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] Use deb10 for i386 bindists Message-ID: <64ad752e2552c_5b5e1b1b48766f1@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: e709d6cb by Matthew Pickering at 2023-07-11T16:28:34+01:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: a722cd11c4b0f33fa7caa15940f84d4996cf7aa3 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false - - job: nightly-i386-linux-deb9-validate + - job: nightly-i386-linux-deb10-validate artifacts: false - job: nightly-x86_64-linux-deb10-validate artifacts: false ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -928,7 +928,7 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -126,7 +126,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -137,7 +137,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -147,14 +147,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -180,11 +180,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -377,7 +377,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -388,7 +388,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -398,14 +398,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -431,11 +431,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2536,7 +2536,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2547,7 +2547,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2557,14 +2557,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2590,13 +2590,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -191,7 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): deb10 = mk(debian("x86_64", 10)) deb11 = mk(debian("x86_64", 11)) deb10_arm64 = mk(debian("aarch64", 10)) - deb9_i386 = mk(debian("i386", 9)) + deb10_i386 = mk(debian("i386", 10)) source = mk_one_metadata(release_mode, version, job_map, source_artifact) test = mk_one_metadata(release_mode, version, job_map, test_artifact) @@ -221,10 +221,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): } - a32 = { "Linux_Debian": { "<10": deb9_i386, "unknown_versioning": deb9_i386 } - , "Linux_Ubuntu": { "unknown_versioning": deb9_i386 } - , "Linux_Mint" : { "unknown_versioning": deb9_i386 } - , "Linux_UnknownLinux" : { "unknown_versioning": deb9_i386 } + a32 = { "Linux_Debian": { "unknown_versioning": deb10_i386 } + , "Linux_Ubuntu": { "unknown_versioning": deb10_i386 } + , "Linux_Mint" : { "unknown_versioning": deb10_i386 } + , "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 } } arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e709d6cb1ec0f0be48c5b075f0e17f59c0872857 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e709d6cb1ec0f0be48c5b075f0e17f59c0872857 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 15:43:41 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 11 Jul 2023 11:43:41 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Equality of forall-types is visiblity aware Message-ID: <64ad78ad3b0d4_5b5e1b1b7080995@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: b782e184 by Matthew Craven at 2023-07-11T16:43:26+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - docs/core-spec/core-spec.mng - testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/pmcheck/should_compile/T11195.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b782e1842a84d0a6689a2573ce8631a2abc12de4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b782e1842a84d0a6689a2573ce8631a2abc12de4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 16:12:06 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 12:12:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/drop-dllwrap Message-ID: <64ad7f56b318f_5b5e1b1b48857b2@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/drop-dllwrap at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/drop-dllwrap You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 16:16:11 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 12:16:11 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-dllwrap] 112 commits: Add support for deprecating exported items (proposal #134) Message-ID: <64ad804b46feb_5b5e1b1b98942c0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-dllwrap at Glasgow Haskell Compiler / GHC Commits: 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - c68d4b06 by Rodrigo Mesquita at 2023-07-11T17:15:58+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e20379c94f23990ae6c0f490e144ae380e7460de...c68d4b069144057ff897da07abb7b265d682cf7e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e20379c94f23990ae6c0f490e144ae380e7460de...c68d4b069144057ff897da07abb7b265d682cf7e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 16:16:38 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 12:16:38 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-dllwrap] configure: Drop DllWrap command Message-ID: <64ad806667df8_5b5e1b1b849452e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-dllwrap at Glasgow Haskell Compiler / GHC Commits: 4866b73e by Rodrigo Mesquita at 2023-07-11T17:16:19+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 11 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - utils/haddock Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_a, sPgm_l, sPgm_lm, - sPgm_dll, sPgm_T, sPgm_windres, sPgm_ar, @@ -136,7 +135,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -404,8 +403,6 @@ pgm_l :: DynFlags -> (String,[Option]) pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags -pgm_dll :: DynFlags -> (String,[Option]) -pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags pgm_T :: DynFlags -> String pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String @@ -1080,8 +1077,6 @@ dynamic_flags_deps = [ } , make_ord_flag defFlag "pgml-supports-no-pie" $ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True } - , make_ord_flag defFlag "pgmdll" - $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) } , make_ord_flag defFlag "pgmwindres" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f } , make_ord_flag defFlag "pgmar" ===================================== compiler/GHC/Settings.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Settings , sPgm_a , sPgm_l , sPgm_lm - , sPgm_dll , sPgm_T , sPgm_windres , sPgm_ar @@ -108,7 +107,6 @@ data ToolSettings = ToolSettings -- ^ N.B. On Windows we don't have a linker which supports object -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. - , toolSettings_pgm_dll :: (String, [Option]) , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String @@ -218,8 +216,6 @@ sPgm_l :: Settings -> (String, [Option]) sPgm_l = toolSettings_pgm_l . sToolSettings sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings -sPgm_dll :: Settings -> (String, [Option]) -sPgm_dll = toolSettings_pgm_dll . sToolSettings sPgm_T :: Settings -> String sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -127,9 +127,6 @@ initSettings top_dir = do touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" - let mkdll_args = [] - -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -189,7 +186,6 @@ initSettings top_dir = do , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r - , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path ===================================== configure.ac ===================================== @@ -328,14 +328,12 @@ else AC_PATH_TOOL([AR],[ar]) AC_PATH_TOOL([RANLIB],[ranlib]) AC_PATH_TOOL([OBJDUMP],[objdump]) - AC_PATH_TOOL([DllWrap],[dllwrap]) AC_PATH_TOOL([Windres],[windres]) AC_PATH_TOOL([Genlib],[genlib]) HAVE_GENLIB=False if test "$HostOS" = "mingw32"; then AC_CHECK_TARGET_TOOL([Windres],[windres]) - AC_CHECK_TARGET_TOOL([DllWrap],[dllwrap]) AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump]) if test "$Genlib" != ""; then @@ -346,9 +344,7 @@ else fi if test "$HostOS" = "mingw32"; then - DllWrapCmd="$DllWrap" WindresCmd="$Windres" - AC_SUBST([DllWrapCmd]) AC_SUBST([WindresCmd]) AC_SUBST([GenlibCmd]) AC_SUBST([HAVE_GENLIB]) @@ -1238,7 +1234,6 @@ echo "\ otool : $OtoolCmd install_name_tool : $InstallNameToolCmd windres : $WindresCmd - dllwrap : $DllWrapCmd genlib : $GenlibCmd Happy : $HappyCmd ($HappyVersion) Alex : $AlexCmd ($AlexVersion) ===================================== hadrian/bindist/Makefile ===================================== @@ -103,7 +103,6 @@ lib/settings : config.mk @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ - @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -271,7 +271,6 @@ SettingsArCommand = @SettingsArCommand@ SettingsOtoolCommand = @SettingsOtoolCommand@ SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ -SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -155,7 +155,6 @@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ -settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ settings-llc-command = @SettingsLlcCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -123,7 +123,6 @@ data SettingsFileSetting | SettingsFileSetting_RanlibCommand | SettingsFileSetting_OtoolCommand | SettingsFileSetting_InstallNameToolCommand - | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand | SettingsFileSetting_LlcCommand @@ -220,7 +219,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" SettingsFileSetting_OtoolCommand -> "settings-otool-command" SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -462,7 +462,6 @@ generateSettings = do , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) - , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) ===================================== m4/fp_settings.m4 ===================================== @@ -23,7 +23,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsFlags="" SettingsArCommand="${mingw_bin_prefix}llvm-ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" - SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" SettingsTouchCommand='$$topdir/bin/touchy.exe' @@ -45,11 +44,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsCommand="$MergeObjsCmd" SettingsMergeObjectsFlags="$MergeObjsArgs" - if test -z "$DllWrapCmd"; then - SettingsDllWrapCommand="/bin/false" - else - SettingsDllWrapCommand="$DllWrapCmd" - fi if test -z "$WindresCmd"; then SettingsWindresCommand="/bin/false" else @@ -70,7 +64,6 @@ AC_DEFUN([FP_SETTINGS], SettingsLdCommand="$(basename $SettingsLdCommand)" SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" SettingsArCommand="$(basename $SettingsArCommand)" - SettingsDllWrapCommand="$(basename $SettingsDllWrapCommand)" SettingsWindresCommand="$(basename $SettingsWindresCommand)" fi fi @@ -115,7 +108,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsOtoolCommand) AC_SUBST(SettingsInstallNameToolCommand) - AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsLlcCommand) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 495c0655dcb9a9482054c5e48c0106f57f5ddb06 +Subproject commit bfb52adefa028f541672623321eb1b3d21dd2547 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4866b73ebc5aa807e93fd5b4a9b3c99f73ae06d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4866b73ebc5aa807e93fd5b4a9b3c99f73ae06d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 16:17:47 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 12:17:47 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-dllwrap] configure: Drop DllWrap command Message-ID: <64ad80ab171a6_5b5e1b1b48948f8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-dllwrap at Glasgow Haskell Compiler / GHC Commits: 74a92224 by Rodrigo Mesquita at 2023-07-11T17:17:30+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 10 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_a, sPgm_l, sPgm_lm, - sPgm_dll, sPgm_T, sPgm_windres, sPgm_ar, @@ -136,7 +135,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -404,8 +403,6 @@ pgm_l :: DynFlags -> (String,[Option]) pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags -pgm_dll :: DynFlags -> (String,[Option]) -pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags pgm_T :: DynFlags -> String pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String @@ -1080,8 +1077,6 @@ dynamic_flags_deps = [ } , make_ord_flag defFlag "pgml-supports-no-pie" $ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True } - , make_ord_flag defFlag "pgmdll" - $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) } , make_ord_flag defFlag "pgmwindres" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f } , make_ord_flag defFlag "pgmar" ===================================== compiler/GHC/Settings.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Settings , sPgm_a , sPgm_l , sPgm_lm - , sPgm_dll , sPgm_T , sPgm_windres , sPgm_ar @@ -108,7 +107,6 @@ data ToolSettings = ToolSettings -- ^ N.B. On Windows we don't have a linker which supports object -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. - , toolSettings_pgm_dll :: (String, [Option]) , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String @@ -218,8 +216,6 @@ sPgm_l :: Settings -> (String, [Option]) sPgm_l = toolSettings_pgm_l . sToolSettings sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings -sPgm_dll :: Settings -> (String, [Option]) -sPgm_dll = toolSettings_pgm_dll . sToolSettings sPgm_T :: Settings -> String sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -127,9 +127,6 @@ initSettings top_dir = do touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" - let mkdll_args = [] - -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -189,7 +186,6 @@ initSettings top_dir = do , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r - , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path ===================================== configure.ac ===================================== @@ -328,14 +328,12 @@ else AC_PATH_TOOL([AR],[ar]) AC_PATH_TOOL([RANLIB],[ranlib]) AC_PATH_TOOL([OBJDUMP],[objdump]) - AC_PATH_TOOL([DllWrap],[dllwrap]) AC_PATH_TOOL([Windres],[windres]) AC_PATH_TOOL([Genlib],[genlib]) HAVE_GENLIB=False if test "$HostOS" = "mingw32"; then AC_CHECK_TARGET_TOOL([Windres],[windres]) - AC_CHECK_TARGET_TOOL([DllWrap],[dllwrap]) AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump]) if test "$Genlib" != ""; then @@ -346,9 +344,7 @@ else fi if test "$HostOS" = "mingw32"; then - DllWrapCmd="$DllWrap" WindresCmd="$Windres" - AC_SUBST([DllWrapCmd]) AC_SUBST([WindresCmd]) AC_SUBST([GenlibCmd]) AC_SUBST([HAVE_GENLIB]) @@ -1238,7 +1234,6 @@ echo "\ otool : $OtoolCmd install_name_tool : $InstallNameToolCmd windres : $WindresCmd - dllwrap : $DllWrapCmd genlib : $GenlibCmd Happy : $HappyCmd ($HappyVersion) Alex : $AlexCmd ($AlexVersion) ===================================== hadrian/bindist/Makefile ===================================== @@ -103,7 +103,6 @@ lib/settings : config.mk @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ - @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -271,7 +271,6 @@ SettingsArCommand = @SettingsArCommand@ SettingsOtoolCommand = @SettingsOtoolCommand@ SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ -SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -155,7 +155,6 @@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ -settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ settings-llc-command = @SettingsLlcCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -123,7 +123,6 @@ data SettingsFileSetting | SettingsFileSetting_RanlibCommand | SettingsFileSetting_OtoolCommand | SettingsFileSetting_InstallNameToolCommand - | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand | SettingsFileSetting_LlcCommand @@ -220,7 +219,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" SettingsFileSetting_OtoolCommand -> "settings-otool-command" SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -462,7 +462,6 @@ generateSettings = do , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) - , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) ===================================== m4/fp_settings.m4 ===================================== @@ -23,7 +23,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsFlags="" SettingsArCommand="${mingw_bin_prefix}llvm-ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" - SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" SettingsTouchCommand='$$topdir/bin/touchy.exe' @@ -45,11 +44,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsCommand="$MergeObjsCmd" SettingsMergeObjectsFlags="$MergeObjsArgs" - if test -z "$DllWrapCmd"; then - SettingsDllWrapCommand="/bin/false" - else - SettingsDllWrapCommand="$DllWrapCmd" - fi if test -z "$WindresCmd"; then SettingsWindresCommand="/bin/false" else @@ -70,7 +64,6 @@ AC_DEFUN([FP_SETTINGS], SettingsLdCommand="$(basename $SettingsLdCommand)" SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" SettingsArCommand="$(basename $SettingsArCommand)" - SettingsDllWrapCommand="$(basename $SettingsDllWrapCommand)" SettingsWindresCommand="$(basename $SettingsWindresCommand)" fi fi @@ -115,7 +108,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsOtoolCommand) AC_SUBST(SettingsInstallNameToolCommand) - AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsLlcCommand) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74a922244cde678abb5f896f10662a5158b1d956 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74a922244cde678abb5f896f10662a5158b1d956 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 16:30:59 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 12:30:59 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 26 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) Message-ID: <64ad83c37cdd9_5b5e1b1bfc973af@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 74a92224 by Rodrigo Mesquita at 2023-07-11T17:17:30+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - db4454a3 by Ben Gamari at 2023-07-11T17:22:24+01:00 ghc-toolchain: Initial commit - - - - - de6a0116 by Rodrigo Mesquita at 2023-07-11T17:22:24+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 87c8aea7 by Rodrigo Mesquita at 2023-07-11T17:23:46+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - 1a278f13 by Rodrigo Mesquita at 2023-07-11T17:24:48+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - 25ba707c by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - c660ea0c by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 3e29f45f by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 Use ghc-platform instead of ghc-boot - - - - - 9ae06670 by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - aff8843a by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 FixeWs Fixes2 - - - - - bfbc9fdf by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 Try to add locally-executable arg - - - - - bf593b9a by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 New host.target - - - - - 5cb99b17 by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 Try to parse the undefined fields - - - - - d2e361a9 by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 Configure Host toolchain with dummy options, hope they aren't used - - - - - fbbfe3a2 by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 prettier comment - - - - - 72e96c8a by Rodrigo Mesquita at 2023-07-11T17:24:49+01:00 Fixes - - - - - 9d2e941f by Rodrigo Mesquita at 2023-07-11T17:30:51+01:00 Windows builtin toolchain - - - - - d6fc7cde by Rodrigo Mesquita at 2023-07-11T17:30:51+01:00 dont validate ghc-toolchain host - - - - - 30 changed files: - + TODO - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Parser.y - compiler/GHC/Platform.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/TyThing.hs - compiler/cbits/genSym.c - configure.ac - + default.host.target.in - + default.target.in - distrib/configure.ac.in - docs/users_guide/debugging.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/961b4526e7f17ccb2bfe0c87bc6b822d3ff74fe9...d6fc7cde983844f8378d310080f7d83d1ee3c0db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/961b4526e7f17ccb2bfe0c87bc6b822d3ff74fe9...d6fc7cde983844f8378d310080f7d83d1ee3c0db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 17:01:08 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 11 Jul 2023 13:01:08 -0400 Subject: [Git][ghc/ghc][wip/az/epa-annlist-decls] 33 commits: Substitute free variables captured by breakpoints in SpecConstr Message-ID: <64ad8ad47dac7_5b5e1b1b84104127@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-annlist-decls at Glasgow Haskell Compiler / GHC Commits: 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - c87df532 by Alan Zimmerman at 2023-07-10T22:54:58+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c0594578 by Alan Zimmerman at 2023-07-11T18:00:29+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/313c0865390e2d900e3cd7f1b73f5227517f19fa...c0594578f12ad07a665c17f3b44dcb4d17f3b7cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/313c0865390e2d900e3cd7f1b73f5227517f19fa...c0594578f12ad07a665c17f3b44dcb4d17f3b7cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 17:02:00 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 11 Jul 2023 13:02:00 -0400 Subject: [Git][ghc/ghc][wip/az/epa-improve-getmonobind] 34 commits: Substitute free variables captured by breakpoints in SpecConstr Message-ID: <64ad8b08cc3ee_5b5e1b1b84104366@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-improve-getmonobind at Glasgow Haskell Compiler / GHC Commits: 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - c87df532 by Alan Zimmerman at 2023-07-10T22:54:58+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c0594578 by Alan Zimmerman at 2023-07-11T18:00:29+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - cc634fd6 by Alan Zimmerman at 2023-07-11T18:01:42+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e907421d00998e0de2a17ceaef71435cdb466f2...cc634fd6a0e1ccf023c85a16f570ed04b839d3c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e907421d00998e0de2a17ceaef71435cdb466f2...cc634fd6a0e1ccf023c85a16f570ed04b839d3c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 17:04:07 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 11 Jul 2023 13:04:07 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] EPA: deal with fallout from getMonoBind Message-ID: <64ad8b87a928_5b5e1b1bc010459d@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: a4643c3c by Alan Zimmerman at 2023-07-11T18:03:32+01:00 EPA: deal with fallout from getMonoBind - - - - - 5 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -4621,9 +4621,6 @@ adaptWhereBinds (Just (L l (b, mc))) = L l (b, maybe emptyComments id mc) combineHasLocs :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan combineHasLocs a b = combineSrcSpans (getHasLoc a) (getHasLoc b) -noTrailingN :: SrcSpanAnnN -> SrcSpanAnnN -noTrailingN s = s { s_anns = (s_anns s) { nann_trailing = [] } } - fromTrailingN :: SrcSpanAnnN -> SrcSpanAnnA fromTrailingN (EpAnnS anc ann cs) = EpAnnS anc (AnnListItem (nann_trailing ann)) cs ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -52,6 +52,7 @@ module GHC.Parser.Annotation ( -- ** Trailing annotations in lists TrailingAnn(..), trailingAnnToAddEpAnn, addTrailingAnnToA, addTrailingAnnToL, addTrailingCommaToN, + noTrailingN, -- ** Utilities for converting between different 'GenLocated' when -- ** we do not care about the annotations. @@ -907,6 +908,9 @@ addTrailingCommaToN n l = n { s_anns = addTrailing (s_anns n) l } addTrailing :: NameAnn -> EpaLocation -> NameAnn addTrailing n l = n { nann_trailing = nann_trailing n ++ [AddCommaAnn l]} +noTrailingN :: SrcSpanAnnN -> SrcSpanAnnN +noTrailingN s = s { s_anns = (s_anns s) { nann_trailing = [] } } + {- Note [list append in addTrailing*] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -528,12 +528,14 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do mflush -- end of sub-Anchor processing, start of tail end processing - postCs <- cua canUpdateAnchor takeAppliedCommentsPop - when (flush == NoFlushComments) $ do - when ((getFollowingComments cs) /= []) $ do - debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs) - mapM_ printOneComment (map tokComment $ getFollowingComments cs) - debugM $ "ending trailing comments" + -- postCs <- cua canUpdateAnchor takeAppliedCommentsPop + -- when (flush == NoFlushComments) $ do + -- when ((getFollowingComments cs) /= []) $ do + + -- debugM $ "enterAnn:in:(anchor') =" ++ show (eloc2str anchor') + -- debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs) + -- mapM_ printOneComment (map tokComment $ getFollowingComments cs) + -- debugM $ "ending trailing comments" eof <- getEofPos case eof of @@ -560,6 +562,14 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do EpaSpan _ -> return () -- Outside the anchor, mark any trailing + postCs <- cua canUpdateAnchor takeAppliedCommentsPop + when (flush == NoFlushComments) $ do + when ((getFollowingComments cs) /= []) $ do + + debugM $ "enterAnn:in:(anchor') =" ++ show (eloc2str anchor') + debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs) + mapM_ printOneComment (map tokComment $ getFollowingComments cs) + debugM $ "ending trailing comments" trailing' <- markTrailing trailing_anns -- Update original anchor, comments based on the printing process ===================================== utils/check-exact/Main.hs ===================================== @@ -69,7 +69,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" (Just addLocaLDecl4) -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" (Just addLocaLDecl5) -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just addLocaLDecl6) - -- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1) + "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" (Just rmDecl2) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" (Just rmDecl3) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl4.hs" (Just rmDecl4) @@ -134,7 +134,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Ppr043.hs" Nothing -- "../../testsuite/tests/printer/Ppr044.hs" Nothing -- "../../testsuite/tests/printer/Ppr045.hs" Nothing - "../../testsuite/tests/printer/Ppr046.hs" Nothing + -- "../../testsuite/tests/printer/Ppr046.hs" Nothing -- "../../testsuite/tests/printer/Ppr048.hs" Nothing -- "../../testsuite/tests/printer/Ppr049.hs" Nothing -- "../../testsuite/tests/printer/Ppr050.hs" Nothing @@ -539,6 +539,7 @@ changeLocalDecls libdir (L l p) = do (ValBinds sortKey (listToBag $ decl':oldBinds) (sig':os':oldSigs))) return (L lm (Match an mln pats (GRHSs emptyComments rhs binds'))) + `debug` ("oldDecls=" ++ showAst oldDecls) replaceLocalBinds x = return x return (L l p') @@ -738,8 +739,10 @@ rmDecl1 _libdir top = do -- let lp = makeDeltaAst top let lp = top tlDecs0 <- hsDecls lp - tlDecs <- balanceCommentsList $ captureLineSpacing tlDecs0 + tlDecs' <- balanceCommentsList tlDecs0 + let tlDecs = captureLineSpacing tlDecs' let (de1:_s1:_d2:d3:ds) = tlDecs + -- let d3' = setEntryDPDecl d3 (DifferentLine 2 0) let d3' = setEntryDP d3 (DifferentLine 2 0) replaceDecls lp (de1:d3':ds) @@ -840,7 +843,8 @@ rmDecl6 _libdir lp = do [de1] <- hsDecls lp (de1',_) <- modifyValD (getLocA de1) de1 $ \_m subDecs -> do - let (ss1:_sd1:sd2:sds) = subDecs + let subDecs' = captureLineSpacing subDecs + let (ss1:_sd1:sd2:sds) = subDecs' sd2' <- transferEntryDP' ss1 sd2 return (sd2':sds,Nothing) @@ -879,8 +883,8 @@ rmTypeSig1 _libdir lp = do let (s0:de1:d2) = tlDecs s1 = captureTypeSigSpacing s0 (L l (SigD x1 (TypeSig x2 [n1,n2] typ))) = s1 - n2' <- transferEntryDP n1 n2 - let s1' = (L l (SigD x1 (TypeSig x2 [n2'] typ))) + L ln n2' <- transferEntryDP n1 n2 + let s1' = (L l (SigD x1 (TypeSig x2 [L (noTrailingN ln) n2'] typ))) replaceDecls lp (s1':de1:d2) let (lp',_,_w) = runTransform doRmDecl @@ -896,8 +900,9 @@ rmTypeSig2 _libdir lp = do let [de1] = tlDecs (de1',_) <- modifyValD (getLocA de1) de1 $ \_m [s,d] -> do - d' <- transferEntryDP s d - return ([d'],Nothing) + d' <- transferEntryDP' s d + return $ ([d'],Nothing) + `debug` ("rmTypeSig2:(d,d')" ++ showAst (d,d')) replaceDecls lp [de1'] let (lp',_,_w) = runTransform doRmDecl ===================================== utils/check-exact/Transform.hs ===================================== @@ -69,7 +69,7 @@ module Transform -- ** Managing lists, pure functions , captureOrder, captureOrderBinds - , captureLineSpacing, captureLineSpacingI + , captureLineSpacing , captureMatchLineSpacing , captureTypeSigSpacing @@ -77,7 +77,7 @@ module Transform , isUniqueSrcSpan -- * Pure functions - , setEntryDP + , setEntryDP, setEntryDPDecl , getEntryDP , transferEntryDP, transferEntryDPI , transferEntryDP' @@ -210,24 +210,20 @@ captureMatchLineSpacing (L l (ValD x (FunBind a b (MG c (L d ms ))))) ms' = captureLineSpacing ms captureMatchLineSpacing d = d -captureLineSpacingI :: Default t - => [LocatedAn t e] -> [LocatedAn t e] -captureLineSpacingI [] = [] -captureLineSpacingI [d] = [d] -captureLineSpacingI (de1:d2:ds) = de1:captureLineSpacingI (d2':ds) - where - (l1,_) = ss2pos $ rs $ getLocI de1 - (l2,_) = ss2pos $ rs $ getLocI d2 - d2' = setEntryDPI d2 (deltaPos (l2-l1) 0) - captureLineSpacing :: [LocatedA e] -> [LocatedA e] captureLineSpacing [] = [] captureLineSpacing [d] = [d] -captureLineSpacing (de1:d2:ds) = de1:captureLineSpacing (d2':ds) +captureLineSpacing ds = map snd $ go (map to ds) where - (l1,_) = ss2pos $ rs $ getLocA de1 - (l2,_) = ss2pos $ rs $ getLocA d2 - d2' = setEntryDP d2 (deltaPos (l2-l1) 0) + to :: LocatedA e -> (Int, LocatedA e) + to d = (fst $ ss2pos $ rs $ getHasLoc d,d) + + go :: [(Int, LocatedA e)] -> [(Int, LocatedA e)] + go [] = [] + go [d] = [d] + go ((l1,de1):(l2,d2):ds) = (l1,de1):go ((l2,d2'):ds) + where + d2' = setEntryDP d2 (deltaPos (l2-l1) 0) -- --------------------------------------------------------------------- @@ -247,21 +243,16 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (H -- --------------------------------- ty' :: LHsSigType GhcPs - ty' = case ty of - -- (L (EpAnnS (Anchor r op) a c) b) - -- -> let - -- op' = case op of - -- MovedAnchor _ -> op - -- _ -> case dca of - -- EpaSpan dcr -> MovedAnchor (ss2delta (ss2posEnd dcr) r) - -- EpaDelta _ _ -> MovedAnchor (SameLine 1) - -- in (L (EpAnnS (Anchor r op') a c) b) + ty' = case ty + `debug` ("captureTypeSigSpacing:ty=" ++ showAst ty) + of (L (EpAnnS anc0 a c) b) -> let anc' = case anc0 of EpaDelta _ _ -> anc0 _ -> case dca of - EpaSpan _ -> error "todo" + -- EpaSpan _ -> error "todo" + EpaSpan _ -> EpaDelta (SameLine 1) [] EpaDelta _ _ -> EpaDelta (SameLine 1) [] in (L (EpAnnS anc' a c) b) @@ -285,18 +276,6 @@ decl2Sig _ = [] -- --------------------------------------------------------------------- --- -- |Convert a 'LSig' into a 'LHsDecl' --- wrapSig :: LSig GhcPs -> LHsDecl GhcPs --- wrapSig (L l s) = L l (SigD NoExtField s) - --- --------------------------------------------------------------------- - --- -- |Convert a 'LHsBind' into a 'LHsDecl' --- wrapDecl :: LHsBind GhcPs -> LHsDecl GhcPs --- wrapDecl (L l s) = L l (ValD NoExtField s) - --- --------------------------------------------------------------------- - setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs setEntryDPDecl decl@(L _ (ValD x (FunBind a b (MG c (L d ms ))))) dp = L l' (ValD x (FunBind a b (MG c (L d ms')))) @@ -329,7 +308,8 @@ setEntryDP (L (EpAnnS (EpaDelta d csd) an cs) a) dp (dp0,c') = go h in (dp0, c':t++csd, EpaCommentsBalanced [] ts) - -- _ -> (dp, cs) + EpaCommentsBalanced [] ts -> + (d, csd, EpaCommentsBalanced [] ts) go (L (EpaDelta ma c0) c) = (d, L (EpaDelta ma c0) c) go (L (EpaSpan _) c) = (d, L (EpaDelta dp []) c) setEntryDP (L (EpAnnS (EpaSpan (RealSrcSpan r _)) an cs) a) dp @@ -533,7 +513,7 @@ balanceComments first second = do balanceCommentsFB :: (Monad m) => LHsBind GhcPs -> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b) balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)))) second = do - logTr $ "balanceCommentsFB entered: " ++ showGhc (ss2range $ locA lf) + debugM $ "balanceCommentsFB entered: " ++ showGhc (ss2range $ locA lf) -- There are comments on lf. We need to -- + Keep the prior ones here -- + move the interior ones to the first match, @@ -554,7 +534,8 @@ balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)))) second = do getFollowingComments $ s_comments lf) lf' = setCommentsEpAnnS lf (EpaComments before) - logTr $ "balanceCommentsFB (before, after): " ++ showAst (before, after) + debugM $ "balanceCommentsFB (before, after): " ++ showAst (before, after) + debugM $ "balanceCommentsFB lf': " ++ showAst lf' -- let matches' = case matches of let matches' :: [LocatedA (Match GhcPs (LHsExpr GhcPs))] matches' = case matches of @@ -566,13 +547,17 @@ balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)))) second = do (L lm' m':ms') -> (L (addCommentsToEpAnnS lm' (EpaCommentsBalanced [] after)) m',ms') _ -> error "balanceCommentsFB4" + debugM $ "balanceCommentsFB: (m,ms):" ++ showAst (m,ms) (m',second') <- balanceComments' m second m'' <- balanceCommentsMatch m' let (m''',lf'') = case ms of [] -> moveLeadingComments m'' lf' _ -> (m'',lf') - logTr $ "balanceCommentsMatch done" - balanceComments' (L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms)))))) second' + debugM $ "balanceCommentsFB: (lf'', m'''):" ++ showAst (lf'',m''') + debugM $ "balanceCommentsFB done" + let bind = L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms))))) + debugM $ "balanceCommentsFB returning:" ++ showAst bind + balanceComments' (packFunBind bind) second' balanceCommentsFB f s = balanceComments' f s -- | Move comments on the same line as the end of the match into the @@ -647,11 +632,10 @@ balanceCommentsList' (a:b:ls) = do -- Many of these should in fact be following comments for the previous anchor balanceComments' :: (Monad m) => LocatedA a -> LocatedA b -> TransformT m (LocatedA a, LocatedA b) balanceComments' la1 la2 = do - -- logTr $ "balanceComments': (loc1,loc2)=" ++ showGhc (ss2range loc1,ss2range loc2) - logTr $ "balanceComments': (anc1)=" ++ showAst (anc1) - logTr $ "balanceComments': (cs1s)=" ++ showAst (cs1s) - logTr $ "balanceComments': (cs1stay,cs1move)=" ++ showAst (cs1stay,cs1move) - logTr $ "balanceComments': (an1',an2')=" ++ showAst (an1',an2') + debugM $ "balanceComments': (anc1)=" ++ showAst (anc1) + debugM $ "balanceComments': (cs1s)=" ++ showAst (cs1s) + debugM $ "balanceComments': (cs1stay,cs1move)=" ++ showAst (cs1stay,cs1move) + debugM $ "balanceComments': (an1',an2')=" ++ showAst (an1',an2') return (la1', la2') where simpleBreak n (r,_) = r > n @@ -766,7 +750,7 @@ moveLeadingComments (L la a) lb = (L la' a, lb') -- TODO: need to set an entry delta on lb' to zero, and move the -- original spacing to the first comment. - la' = setCommentsEpAnnS la (EpaComments after) + la' = setCommentsEpAnnS la (EpaCommentsBalanced [] after) lb' = addCommentsToEpAnnS lb (EpaCommentsBalanced before []) -- | A GHC comment includes the span of the preceding (non-comment) @@ -925,6 +909,7 @@ insertAtStart = insertAt insertFirst case xs of [] -> [x] (h:t) -> x:setEntryDP h (DifferentLine 2 0):t + `debug` ("insertAtStart:h=" ++ showAst h) -- |Insert a declaration at a specific location in the subdecls of the given @@ -989,10 +974,12 @@ class (Data t) => HasDecls t where instance HasDecls ParsedSource where hsDecls (L _ (HsModule (XModulePs _ _lo _ _) _mn _exps _imps decls)) = return decls + replaceDecls (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps _decls)) decls = do logTr "replaceDecls LHsModule" -- modifyAnnsT (captureOrder m decls) + -- let decls' = map packFunDecl decls return (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps decls)) -- --------------------------------------------------------------------- @@ -1140,6 +1127,87 @@ instance HasDecls (LocatedA (Stmt GhcPs (LocatedA (HsExpr GhcPs)))) where -- end of HasDecls instances -- ===================================================================== +-- --------------------------------------------------------------------- +-- A @FunBind@ is a container for @[LMatch GhcPs]@ +-- +-- When being used as a Bind (or Decl), the surrounding context +-- annotations must appear at the FunBind level, so it can be +-- manipulated in the context of other Binds or Decls. +-- +-- Surrounding context annotations are specifically prior comments, +-- following comments and trailing annotations. +-- +-- But when we unpack the container, by calling @hsDecls@ on a +-- @FunBind@, we must make sure that the component parts fully +-- represent the relationship between them and the surrounding +-- declarations. +-- +-- This means pushing the prior context annotations into the first +-- match, and the following ones into the last match when returning +-- @hsDecls@, and undoing this for @replaceDecls at . + +-- |Push leading and trailing top level annotations into the @[LMatch GhcPs]@ +unpackFunBind :: LHsBind GhcPs -> LHsBind GhcPs +unpackFunBind (L loc (FunBind x1 fid (MG x2 (L lg (L lm m:matches))))) + = (L loc'' (FunBind x1 fid (MG x2 (L lg (reverse (L llm' lmtch:tail matches')))))) + -- `debug` ("unpackFunBind: =" + -- ++ showAst (("loc",loc), ("loc'",loc'), ("loc''",loc''), + -- ("lm'",lm'), ("llm",llm), ("llm'", llm'))) + where + (loc', lm') = transferPriorCommentsA loc lm + matches' = reverse $ L lm' m:matches + L llm lmtch = head matches' -- Guaranteed at least one + (loc'', llm') = transferFollowingA loc' llm + +unpackFunBind d = d + +-- |Pull leading and trailing annotations from the @[LMatch GhcPs]@ to +-- the top level. +packFunBind :: LHsBind GhcPs -> LHsBind GhcPs +packFunBind (L loc (FunBind x1 fid (MG x2 (L lg (L lm m:matches))))) + = (L loc'' (FunBind x1 fid (MG x2 (L lg (reverse (L llm' lmtch:tail matches')))))) + `debug` ("packFunBind: =" + ++ showAst (("loc",loc), ("loc'",loc'), ("loc''",loc''), + ("lm'",lm'), ("llm",llm), ("llm'", llm'))) + where + (lm', loc') = transferPriorCommentsA lm loc + matches' = reverse $ L lm' m:matches + L llm lmtch = head matches' -- Guaranteed at least one + (llm', loc'') = transferFollowingA llm loc' +packFunBind d = d + +packFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs +packFunDecl (L l (ValD x b)) = L l' (ValD x b') + where + L l' b' = packFunBind (L l b) + +unpackFunDecl :: LHsDecl GhcPs -> LHsDecl GhcPs +unpackFunDecl (L l (ValD x b)) = L l' (ValD x b') + where + L l' b' = unpackFunBind (L l b) + +-- TODO: Move to Annotation.hs + +transferPriorCommentsA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferPriorCommentsA (EpAnnS a1 an1 cs1) (EpAnnS a2 an2 cs2) + = (EpAnnS a1 an1 cs1', EpAnnS a2 an2 cs2') + `debug` ("transferPriorCommentsA: ((cs1, cs2), (cs1', cs2'))=" ++ showAst ((cs1, cs2), (cs1', cs2'))) + where + pc = priorComments cs1 + fc = getFollowingComments cs1 + cs1' = setFollowingComments emptyComments fc + cs2' = setPriorComments cs2 (priorComments cs2 <> pc) + +transferFollowingA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferFollowingA (EpAnnS a1 an1 cs1) (EpAnnS a2 an2 cs2) + = (EpAnnS a1 mempty cs1', EpAnnS a2 (an1 <> an2) cs2') + `debug` ("transferFollowingA: (pc,fc,cs1', cs2')=" ++ showAst (pc,fc,cs1', cs2')) + where + pc = priorComments cs1 + fc = getFollowingComments cs1 + cs1' = setPriorComments emptyComments pc + cs2' = setFollowingComments cs2 fc + -- --------------------------------------------------------------------- -- |Look up the annotated order and sort the decls accordingly @@ -1287,15 +1355,16 @@ modifyValD p pb@(L ss (ValD _ (PatBind {} ))) f = pb' <- liftT $ replaceDeclsPatBindD pb ds' return (pb',r) else return (pb,Nothing) -modifyValD p ast f = do - (ast',r) <- runStateT (everywhereM (mkM doModLocal) ast) Nothing - return (ast',r) +modifyValD p decl f = do + (decl',r) <- runStateT (everywhereM (mkM doModLocal) (unpackFunDecl decl)) Nothing + return (packFunDecl decl',r) where doModLocal :: PMatch -> StateT (Maybe t) m PMatch doModLocal (match@(L ss _) :: PMatch) = do if (locA ss) == p then do ds <- lift $ liftT $ hsDecls match + `debug` ("modifyValD: match=" ++ showAst match) (ds',r) <- lift $ f match ds put r match' <- lift $ liftT $ replaceDecls match ds' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a4643c3ce3f081311ec128a04278344c0fcc6809 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a4643c3ce3f081311ec128a04278344c0fcc6809 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 17:10:19 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 11 Jul 2023 13:10:19 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 2 commits: - make the ExpandedStmt generated expression location-less Message-ID: <64ad8cfb2a1d0_5b5e1b1bac10683b@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 929f0851 by Apoorv Ingle at 2023-07-10T18:38:16-05:00 - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - - - - - 5364bb8e by Apoorv Ingle at 2023-07-11T12:09:55-05:00 some cleanup needed - - - - - 11 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -458,7 +458,7 @@ data XXExprGhcRn = ExpandedExpr {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcRn)) | ExpandedStmt - {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (LHsExpr GhcRn)) + {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (HsExpr GhcRn)) | PopSrcSpan {-# UNPACK #-} !(LHsExpr GhcRn) -- Placeholder for identifying generated source locations in GhcRn phase @@ -480,7 +480,7 @@ mkExpandedExpr a b = XExpr (ExpandedExpr (HsExpanded a b)) mkExpandedStmt :: ExprLStmt GhcRn -- ^ source statement - -> LHsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedStmt a b = XExpr (ExpandedStmt (HsExpanded a b)) @@ -491,6 +491,9 @@ data XXExprGhcTc | ExpansionExpr -- See Note [Rebindable syntax and HsExpansion] below {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcTc)) + | ExpansionStmt -- See Note [Rebindable syntax and HsExpansion] below + {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (HsExpr GhcTc)) + | ConLikeTc -- Result of typechecking a data-con -- See Note [Typechecking data constructors] in -- GHC.Tc.Gen.Head @@ -765,6 +768,11 @@ instance Outputable XXExprGhcTc where -- expression (LHsExpr GhcPs), not the -- desugared one (LHsExpr GhcTc). + ppr (ExpansionStmt stmt) + = ppr stmt -- e is an HsExpansion, we print the original + -- expression (LHsExpr GhcPs), not the + -- desugared one (LHsExpr GhcTc). + ppr (ConLikeTc con _ _) = pprPrefixOcc con -- Used in error messages generated by -- the pattern match overlap checker @@ -802,6 +810,7 @@ ppr_infix_expr_rn (PopSrcSpan (L _ a)) = ppr_infix_expr a ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc ppr_infix_expr_tc (WrapExpr (HsWrap _ e)) = ppr_infix_expr e ppr_infix_expr_tc (ExpansionExpr (HsExpanded a _)) = ppr_infix_expr a +ppr_infix_expr_tc (ExpansionStmt {}) = Nothing ppr_infix_expr_tc (ConLikeTc {}) = Nothing ppr_infix_expr_tc (HsTick {}) = Nothing ppr_infix_expr_tc (HsBinTick {}) = Nothing @@ -822,7 +831,6 @@ ppr_apps fun args = hang (ppr_expr fun) 2 (fsep (map pp args)) pp (Right arg) = text "@" <> ppr arg - pprDebugParendExpr :: (OutputableBndrId p) => PprPrec -> LHsExpr (GhcPass p) -> SDoc pprDebugParendExpr p expr @@ -902,6 +910,7 @@ hsExprNeedsParens prec = go go_x_tc :: XXExprGhcTc -> Bool go_x_tc (WrapExpr (HsWrap _ e)) = hsExprNeedsParens prec e go_x_tc (ExpansionExpr (HsExpanded a _)) = hsExprNeedsParens prec a + go_x_tc (ExpansionStmt{}) = False go_x_tc (ConLikeTc {}) = False go_x_tc (HsTick _ (L _ e)) = hsExprNeedsParens prec e go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e @@ -947,6 +956,7 @@ isAtomicHsExpr (XExpr x) go_x_tc :: XXExprGhcTc -> Bool go_x_tc (WrapExpr (HsWrap _ e)) = isAtomicHsExpr e go_x_tc (ExpansionExpr (HsExpanded a _)) = isAtomicHsExpr a + go_x_tc (ExpansionStmt {}) = False go_x_tc (ConLikeTc {}) = True go_x_tc (HsTick {}) = False go_x_tc (HsBinTick {}) = False ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -144,6 +144,7 @@ hsExprType (HsStatic (_, ty) _s) = ty hsExprType (HsPragE _ _ e) = lhsExprType e hsExprType (XExpr (WrapExpr (HsWrap wrap e))) = hsWrapperType wrap $ hsExprType e hsExprType (XExpr (ExpansionExpr (HsExpanded _ tc_e))) = hsExprType tc_e +hsExprType (XExpr (ExpansionStmt (HsExpanded _ tc_e))) = hsExprType tc_e hsExprType (XExpr (ConLikeTc con _ _)) = conLikeType con hsExprType (XExpr (HsTick _ e)) = lhsExprType e hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -265,6 +265,7 @@ dsExpr (HsOverLit _ lit) dsExpr e@(XExpr ext_expr_tc) = case ext_expr_tc of ExpansionExpr (HsExpanded _ b) -> dsExpr b + ExpansionStmt (HsExpanded (L loc _) b) -> putSrcSpanDsA loc $ dsExpr b WrapExpr {} -> dsHsWrapped e ConLikeTc con tvs tys -> dsConLike con tvs tys -- Hpc Support @@ -880,6 +881,7 @@ warnUnusedBindValue fun arg@(L loc _) arg_ty fish_var (L l (XExpr (WrapExpr (HsWrap _ e)))) = do (l, e') <- fish_var (L l e) return (l, e') fish_var (L l (XExpr (ExpansionExpr (HsExpanded _ e)))) = fish_var (L l e) + fish_var (L l (XExpr (ExpansionStmt (HsExpanded _ e)))) = fish_var (L l e) fish_var _ = Nothing warnUnusedBindValue _ _ _ = return () ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -158,7 +158,7 @@ pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do -- should be strict in @missing@ anyway! !missing <- getLdiNablas tracePm "pmcMatches {" $ - hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) + hang (vcat [ppr origin, ppr ctxt, ppr vars, text "Matches:"]) 2 ((ppr matches) $$ (text "missing:" <+> ppr missing)) case NE.nonEmpty matches of @@ -176,7 +176,7 @@ pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do result <- {-# SCC "checkMatchGroup" #-} unCA (checkMatchGroup matches) missing tracePm "}: " (ppr (cr_uncov result)) - when (not (isDoExpansionGenerated origin)) -- Generated code shouldn't give overlapping warnings + when (not (isDoExpansionGenerated origin)) -- Generated code shouldn't emit overlapping warnings ({-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result) return (NE.toList (ldiMatchGroup (cr_ret result))) ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -594,6 +594,9 @@ addTickHsExpr (XExpr (WrapExpr (HsWrap w e))) = addTickHsExpr (XExpr (ExpansionExpr (HsExpanded a b))) = liftM (XExpr . ExpansionExpr . HsExpanded a) $ (addTickHsExpr b) +addTickHsExpr (XExpr (ExpansionStmt (HsExpanded a b))) = + liftM (XExpr . ExpansionStmt . HsExpanded a) $ + (addTickHsExpr b) addTickHsExpr e@(XExpr (ConLikeTc {})) = return e -- We used to do a freeVar on a pat-syn builder, but actually ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1242,6 +1242,8 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where , toHie (L mspan w) ] ExpansionExpr (HsExpanded _ b) -> [ toHie (L mspan b) ] + ExpansionStmt (HsExpanded _ b) + -> [ toHie (L mspan b) ] ConLikeTc con _ _ -> [ toHie $ C Use $ L mspan $ conLikeName con ] HsTick _ expr ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -138,7 +138,7 @@ tcInferSigma :: Bool -> LHsExpr GhcRn -> TcM TcSigmaType -- False <=> don't instantiate -- return a sigma-type tcInferSigma inst (L loc rn_expr) | (fun@(rn_fun,_), rn_args) <- splitHsApps rn_expr - = addExprCtxt rn_expr $ + = addExprCtxt (text "tcInferSigma") rn_expr $ setSrcSpanA loc $ do { do_ql <- wantQuickLook rn_fun ; (_tc_fun, fun_sigma) <- tcInferAppHead fun rn_args @@ -357,12 +357,13 @@ tcApp rn_expr exp_res_ty ; let perhaps_add_res_ty_ctxt thing_inside | insideExpansion fun_ctxt , VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ <- fun_ctxt - = do traceTc "tcApp" (vcat [text "VACall stmt", ppr loc, ppr rn_fun, ppr fun_ctxt]) - setSrcSpanA loc $ addStmtCtxt stmt thing_inside - | insideExpansion fun_ctxt - , XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun - = do traceTc "tcApp" (vcat [text "VAExpansion stmt", ppr loc, ppr rn_fun, ppr fun_ctxt]) - setSrcSpanA loc $ addStmtCtxt stmt thing_inside + = do traceTc "tcApp" (vcat [text "VACall stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) + setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VACall stmt") stmt + thing_inside + | XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun + = do traceTc "tcApp" (vcat [text "VAExpansion stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) + setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VAExpansion stmt") stmt + thing_inside | insideExpansion fun_ctxt = do traceTc "tcApp" (vcat [text "insideExpansion", ppr rn_fun, ppr fun_ctxt]) addHeadCtxt fun_ctxt thing_inside @@ -556,12 +557,13 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args maybeSetCtxt (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) thing_inside = do traceTc "tcInstFun" (text "set stmt ctxt" <+> ppr stmt <+> ppr loc) setSrcSpanA loc $ - addStmtCtxt stmt thing_inside + addStmtCtxt (text "tcInstFun") stmt thing_inside maybeSetCtxt _ thing_inside = thing_inside fun_orig = exprCtOrigin (case fun_ctxt of VAExpansion e _ -> e - VACall e _ _ -> e) + VACall e _ _ -> e + VAExpansionStmt stmt _ -> HsDo noExtField (DoExpr Nothing) (L noSrcSpanA [stmt])) -- Count value args only when complaining about a function -- applied to too many value args @@ -725,42 +727,32 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside , text "arg_loc" <+> ppr arg_loc , text "is src ctxt" <+> ppr in_src_ctxt , text "is generated code" <+> ppr in_generated_code - , text "is then/bind" - <+> ppr (is_then_fun (appCtxtExpr ctxt)) - <+> ppr (is_bind_fun (appCtxtExpr ctxt)) ]) + -- , text "is then/bind" + -- <+> ppr (is_then_fun (appCtxtExpr ctxt)) + -- <+> ppr (is_bind_fun (appCtxtExpr ctxt)) + ]) ; case ctxt of VACall fun arg_no _ | not in_generated_code && not (is_then_fun fun || is_bind_fun fun) -> do traceTc "addArgCtxt 2a" empty setSrcSpanA arg_loc $ addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside - VACall fun arg_no _ | not in_generated_code && (is_then_fun fun || is_bind_fun fun) - -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..." if the arg_no is > 1 - -- We have already set the context "In the stmt" - if arg_no == 1 -- this arg location needs to be added - then setSrcSpanA arg_loc $ - addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated - thing_inside - else thing_inside + VACall fun _ _ | not in_generated_code && is_then_fun fun + -> do traceTc "addArgCtxt 2b >>" empty -- Skip setting "In the expression..." if the arg_no is > 1 + thing_inside VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ -> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .." setSrcSpanA loc $ - addStmtCtxt stmt $ + addStmtCtxt (text "addArgCtxt 2c") stmt $ thing_inside VAExpansion (HsDo _ _ _) _ -> do traceTc "addArgCtxt 2d" empty -- Set the context as the first statement of do block - -- setSrcSpan loc $ -- skip adding "In the expression do ... " - -- addExprCtxt e $ - thing_inside - VAExpansion _ _ - -> do traceTc "addArgCtxt 2e" empty -- Skip setting "In the expression..." - -- as the arg will be an generated expanded stmt - -- setSrcSpan loc $ - -- addExprCtxt orig $ + -- setSrcSpanA arg_loc $ -- skip adding "In the expression do ... " + -- addExprCtxt ((text "addArgCtxt 2d")) e $ thing_inside _ -> do traceTc "addArgCtxt 3" empty setSrcSpanA arg_loc $ - addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated + addExprCtxt (text "addArgCtxt 3") arg $ -- Auto-suppressed if arg_loc is generated thing_inside } where is_then_fun :: HsExpr GhcRn -> Bool @@ -771,6 +763,9 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside is_bind_fun (HsVar _ (L _ f)) = f == bindMName is_bind_fun _ = False + -- mk_body_stmt :: HsExpr GhcRn -> ExprLStmt GhcRn + -- mk_body_stmt e = L arg_loc (BodyStmt noExtField (L arg_loc e) NoSyntaxExprRn NoSyntaxExprRn) + {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -122,7 +122,7 @@ tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType tcPolyLExpr (L loc expr) res_ty = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addExprCtxt expr $ -- Note [Error contexts in generated code] + addExprCtxt (text "tcPolyLExpr") expr $ -- Note [Error contexts in generated code] do { expr' <- tcPolyExpr expr res_ty ; return (L loc expr') } @@ -148,7 +148,7 @@ tcMonoExpr, tcMonoExprNC tcMonoExpr (L loc expr) res_ty = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addExprCtxt expr $ -- Note [Error contexts in generated code] + addExprCtxt (text "tcMonoExpr") expr $ -- Note [Error contexts in generated code] do { expr' <- tcExpr expr res_ty ; return (L loc expr') } @@ -162,7 +162,7 @@ tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType) -- Infer a *rho*-type. The return type is always instantiated. tcInferRho (L loc expr) = setSrcSpanA loc $ -- Set location /first/; see GHC.Tc.Utils.Monad - addExprCtxt expr $ -- Note [Error contexts in generated code] + addExprCtxt (text "tcInferRho") expr $ -- Note [Error contexts in generated code] do { (expr', rho) <- tcInfer (tcExpr expr) ; return (L loc expr', rho) } @@ -215,14 +215,15 @@ tcExpr (XExpr (PopSrcSpan (L _ e))) res_ty = do traceTc "tcExpr" (text "PopSrcSpan") popErrCtxt $ tcExpr e res_ty -tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) (L _ e)))) res_ty +tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) e))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr e , text "res_ty:" <+> ppr res_ty , text "loc" <+> ppr loc ]) ; setSrcSpanA loc $ - addStmtCtxt stmt $ tcExpr e res_ty + addStmtCtxt (text "tcExpr") stmt $ + tcExpr e res_ty } @@ -431,7 +432,7 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L _ stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L loc stmts)) res_ty = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo ; if isApplicativeDo then tcDoStmts doFlav ss res_ty @@ -441,12 +442,13 @@ tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L _ stmts)) res_ty ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo , text "expr:" <+> ppr expanded_expr ]) - ; -- addExprCtxt hsDo $ - tcExpr expanded_do_expr res_ty + ; setSrcSpanA loc $ + -- addExprCtxt (text "tcExpr") hsDo $ + tcExpr expanded_do_expr res_ty } } -tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) ss@(L _ stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) ss@(L loc stmts)) res_ty = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo ; if isApplicativeDo then tcDoStmts doFlav ss res_ty @@ -456,8 +458,9 @@ tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) ss@(L _ stmts)) res_ty ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo , text "expr:" <+> ppr expanded_expr ]) - ; -- addExprCtxt hsDo $ - tcExpr expanded_do_expr res_ty + ; setSrcSpanA loc $ + -- addExprCtxt (text "tcExpr") hsDo $ + tcExpr expanded_do_expr res_ty } } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -189,6 +189,7 @@ data HsExprArg (p :: TcPass) data EWrap = EPar AppCtxt | EExpand (HsExpr GhcRn) + | EExpandStmt (ExprLStmt GhcRn) | EHsWrap HsWrapper data EValArg (p :: TcPass) where -- See Note [EValArg] @@ -208,6 +209,10 @@ data AppCtxt (HsExpr GhcRn) -- Inside an expansion of this expression SrcSpan -- The SrcSpan of the expression -- noSrcSpan if outermost; see Note [AppCtxt] + | VAExpansionStmt + (ExprLStmt GhcRn) -- Inside an expansion of this do stmt + SrcSpan -- The SrcSpan of the expression + -- noSrcSpan if outermost; see Note [AppCtxt] | VACall (HsExpr GhcRn) Int -- In the third argument of function f @@ -243,18 +248,22 @@ a second time. appCtxtLoc :: AppCtxt -> SrcSpan appCtxtLoc (VAExpansion _ l) = l +appCtxtLoc (VAExpansionStmt _ l) = l appCtxtLoc (VACall _ _ l) = l -appCtxtExpr :: AppCtxt -> HsExpr GhcRn -appCtxtExpr (VAExpansion e _) = e -appCtxtExpr (VACall e _ _) = e +appCtxtExpr :: AppCtxt -> Maybe (HsExpr GhcRn) +appCtxtExpr (VAExpansion e _) = Just e +appCtxtExpr (VACall e _ _) = Just e +appCtxtExpr _ = Nothing insideExpansion :: AppCtxt -> Bool insideExpansion (VAExpansion {}) = True +insideExpansion (VAExpansionStmt {}) = True insideExpansion (VACall {}) = False instance Outputable AppCtxt where ppr (VAExpansion e l) = text "VAExpansion" <+> ppr e <+> ppr l + ppr (VAExpansionStmt stmt l) = text "VAExpansionStmt" <+> ppr stmt <+> ppr l ppr (VACall f n l) = text "VACall" <+> int n <+> ppr f <+> ppr l type family XPass p where @@ -300,7 +309,7 @@ splitHsApps e = go e (top_ctxt 0 e) [] top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun top_ctxt n (XExpr (ExpandedExpr (HsExpanded orig _))) = VACall orig n noSrcSpan - top_ctxt n other_fun@(XExpr (ExpandedStmt _)) = VACall other_fun n generatedSrcSpan + -- top_ctxt n (XExpr (ExpandedStmt (HsExpanded stmt _))) = VACall other_fun n generatedSrcSpan top_ctxt n other_fun = VACall other_fun n noSrcSpan top_lctxt n (L _ fun) = top_ctxt n fun @@ -313,11 +322,20 @@ splitHsApps e = go e (top_ctxt 0 e) [] go (HsAppType _ (L l fun) at ty) ctxt args = go fun (dec l ctxt) (mkETypeArg ctxt at ty : args) go (HsApp _ (L l fun) arg) ctxt args = go fun (dec l ctxt) (mkEValArg ctxt arg : args) + go (XExpr (ExpandedExpr (HsExpanded orig@(HsDo _ _ _) fun))) ctxt args + = go fun (VAExpansion orig (appCtxtLoc ctxt)) + (EWrap (EExpand orig) : args) + + -- See Note [Looking through HsExpanded] go (XExpr (ExpandedExpr (HsExpanded orig fun))) ctxt args = go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args) + go (XExpr (ExpandedStmt (HsExpanded stmt fun))) _ args + = go fun (VAExpansionStmt stmt generatedSrcSpan) + (EWrap (EExpandStmt stmt) : args) + -- See Note [Desugar OpApp in the typechecker] go e@(OpApp _ arg1 (L l op) arg2) _ args = ( (op, VACall op 0 (locA l)) @@ -331,10 +349,12 @@ splitHsApps e = go e (top_ctxt 0 e) [] set :: SrcSpanAnnA -> AppCtxt -> AppCtxt set l (VACall f n _) = VACall f n (locA l) set _ ctxt@(VAExpansion {}) = ctxt + set _ ctxt@(VAExpansionStmt {}) = ctxt dec :: SrcSpanAnnA -> AppCtxt -> AppCtxt dec l (VACall f n _) = VACall f (n-1) (locA l) dec _ ctxt@(VAExpansion {}) = ctxt + dec _ ctxt@(VAExpansionStmt {}) = ctxt -- | Rebuild an application: takes a type-checked application head -- expression together with arguments in the form of typechecked 'HsExprArg's @@ -378,6 +398,8 @@ rebuild_hs_apps fun ctxt (arg : args) -> rebuild_hs_apps (gHsPar lfun) ctxt' args EWrap (EExpand orig) -> rebuild_hs_apps (XExpr (ExpansionExpr (HsExpanded orig fun))) ctxt args + EWrap (EExpandStmt stmt) + -> rebuild_hs_apps (XExpr (ExpansionStmt (HsExpanded stmt fun))) ctxt args EWrap (EHsWrap wrap) -> rebuild_hs_apps (mkHsWrap wrap fun) ctxt args where @@ -674,7 +696,9 @@ countVisAndInvisValArgs (EValArg {} : args) = 1 + countVisAndInvisValArgs args countVisAndInvisValArgs (EWrap wrap : args) = case wrap of { EHsWrap hsWrap -> countHsWrapperInvisArgs hsWrap + countVisAndInvisValArgs args ; EPar {} -> countVisAndInvisValArgs args - ; EExpand {} -> countVisAndInvisValArgs args } + ; EExpand {} -> countVisAndInvisValArgs args + ; EExpandStmt {} -> countVisAndInvisValArgs args + } countVisAndInvisValArgs (EPrag {} : args) = countVisAndInvisValArgs args countVisAndInvisValArgs (ETypeArg {}: args) = countVisAndInvisValArgs args @@ -706,6 +730,7 @@ instance Outputable EWrap where ppr (EPar _) = text "EPar" ppr (EHsWrap w) = text "EHsWrap" <+> ppr w ppr (EExpand orig) = text "EExpand" <+> ppr orig + ppr (EExpandStmt orig) = text "EExpandStmt" <+> ppr orig instance OutputableBndrId (XPass p) => Outputable (EValArg p) where ppr (ValArg e) = ppr e @@ -793,6 +818,11 @@ tcInferAppHead_maybe fun args _ -> return Nothing addHeadCtxt :: AppCtxt -> TcM a -> TcM a +-- addHeadCtxt (VAExpansionStmt stmt@(L stmt_loc _) _) thing_inside = +-- do setSrcSpanA stmt_loc $ +-- addStmtCtxt (text "addHeadCtxt") stmt +-- thing_inside + addHeadCtxt fun_ctxt thing_inside | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments = do traceTc "addHeadCtxt not good" (ppr fun_ctxt) @@ -801,7 +831,8 @@ addHeadCtxt fun_ctxt thing_inside = setSrcSpan fun_loc $ do traceTc "addHeadCtxt okay" (ppr fun_ctxt) case fun_ctxt of - VAExpansion orig _ -> addExprCtxt orig thing_inside + VAExpansion orig _ -> addExprCtxt (text "addHeadCtxt") orig thing_inside + VAExpansionStmt {} -> thing_inside VACall {} -> thing_inside where fun_loc = appCtxtLoc fun_ctxt @@ -1472,20 +1503,32 @@ mis-match in the number of value arguments. * * ********************************************************************* -} -addStmtCtxt :: ExprLStmt GhcRn -> TcRn a -> TcRn a -addStmtCtxt stmt thing_inside - = addErrCtxt ({-text "tcDoStmts" <+> -} - pprStmtInCtxt @'Renamed @'Renamed @'Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) thing_inside +addStmtCtxt :: SDoc -> ExprLStmt GhcRn -> TcRn a -> TcRn a +addStmtCtxt _ stmt thing_inside + = addErrCtxt ({- doc <+> -} + pprStmtInCtxt (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) thing_inside + + where + pprStmtInCtxt :: HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc + pprStmtInCtxt ctxt stmt + = hang (text "In" <+> maybeExpansionClause stmt <+> text "a stmt of" <+> pprAStmtContext ctxt <> colon) + 2 (pprStmt stmt) + maybeExpansionClause :: StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc + maybeExpansionClause stmt | BindStmt{} <- stmt = text "the expansion of" + | otherwise = empty + + -addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a -addExprCtxt e thing_inside +addExprCtxt :: SDoc -> HsExpr GhcRn -> TcRn a -> TcRn a +addExprCtxt doc e thing_inside = case e of HsUnboundVar {} -> thing_inside - _ -> addErrCtxt (exprCtxt e) thing_inside + XExpr (ExpandedStmt (HsExpanded stmt _)) -> addStmtCtxt doc stmt thing_inside + _ -> addErrCtxt (exprCtxt doc e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ -- when we don't want to say "In the expression: _", -- because it is mentioned in the error message itself -exprCtxt :: HsExpr GhcRn -> SDoc -exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr)) +exprCtxt :: SDoc -> HsExpr GhcRn -> SDoc +exprCtxt _ expr = hang ({-doc <+> -}text "In the expression:") 2 (ppr (stripParensHsExpr expr)) ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1201,9 +1201,8 @@ genPopSrcSpanExpr = wrapGenSpan . mkPopSrcSpanExpr expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expandDoStmts doFlav stmts = do expanded_expr <- expand_do_stmts doFlav stmts case expanded_expr of - L _ (XExpr (PopSrcSpan (L loc e))) -> return $ L loc e - _ -> return expanded_expr - + L _ (XExpr (PopSrcSpan (L loc e))) -> return $ L loc e + _ -> return expanded_expr -- | Expand the Do statments so that it works fine with Quicklook -- See Note[Rebindable Do and Expanding Statements] @@ -1223,19 +1222,19 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ _ _)): _) = pprPanic "expand_do_stmts: Applicative Stmt" $ ppr stmt -expand_do_stmts _ [stmt@(L _ (LastStmt _ body _ ret_expr))] +expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return $ wrapGenSpan (mkExpandedStmt stmt body) + = return $ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt (unLoc body))) | SyntaxExprRn ret <- ret_expr -- -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ wrapGenSpan (mkExpandedStmt stmt (genHsApp (wrapGenSpan ret) body)) + = return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt (genHsApp (wrapGenSpan ret) body))) expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bs)) : lstmts) = @@ -1243,7 +1242,7 @@ expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bs)) : lstmts) = -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (mkExpandedStmt stmt (genHsLet bs $ genPopSrcSpanExpr expand_stmts)) + return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt (genHsLet bs $ expand_stmts))) expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn @@ -1257,13 +1256,12 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) do -- isRebindableOn <- xoptM LangExt.RebindableSyntax -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan expand_stmts <- expand_do_stmts do_or_lc lstmts - expr@(L l _) <- mk_failable_lexpr_tcm pat expand_stmts fail_op - traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) - return $ wrapGenSpan (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt ( - (wrapGenSpan bind_op) - `genHsApp` e)) -- (>>=) + expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op + return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (wrapGenSpan (mkExpandedStmt stmt ( + (wrapGenSpan bind_op) -- (>>=) + `genHsApp` e)) `genHsApp` - expr) + expr)) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) = @@ -1273,13 +1271,12 @@ expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : -- e ; stmts ~~> (>>) e stmts' do -- isRebindableOn <- xoptM LangExt.RebindableSyntax -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan - expand_stmts@(L l _) <- expand_do_stmts do_or_lc lstmts - traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) - return $ wrapGenSpan (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt ( + expand_stmts <- expand_do_stmts do_or_lc lstmts + return $ wrapGenSpan (mkPopSrcSpanExpr $ L loc ((L loc (mkExpandedStmt stmt ( (wrapGenSpan then_op) -- (>>) - `genHsApp` e)) + `genHsApp` e))) `genHsApp` - expand_stmts) -- stmts' + expand_stmts)) -- stmts' expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts @@ -1361,7 +1358,7 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup (Generated DoExpansion) -- \ (wrapGenSpan [ genHsCaseAltDoExp pat lexpr -- pat -> expr , genHsCaseAltDoExp (wrapGenSpan (WildPat noExtField)) -- _ -> fail "fail pattern" - (genHsApp (wrapGenSpan fail_op) (mk_fail_msg_expr dflags pat)) + $ wrapGenSpan (genHsApp (wrapGenSpan fail_op) (mk_fail_msg_expr dflags pat)) ])) where mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn @@ -1373,8 +1370,8 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty -genHsApp :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -genHsApp fun arg = wrapGenSpan (HsApp noAnn fun arg) +genHsApp :: LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn +genHsApp fun arg = HsApp noAnn fun arg genHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) => [LPat (GhcPass p)] @@ -1409,8 +1406,8 @@ genSimpleMatch ctxt pats rhs Match { m_ext = noAnn, m_ctxt = ctxt, m_pats = pats , m_grhss = unguardedGRHSs generatedSrcSpan rhs noAnn } -genHsLet :: HsLocalBindsLR GhcRn GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -genHsLet bindings body = wrapGenSpan $ HsLet noExtField noHsTok bindings noHsTok body +genHsLet :: HsLocalBindsLR GhcRn GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn +genHsLet bindings body = HsLet noExtField noHsTok bindings noHsTok body {- Note [Expanding HsDo with HsExpansion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1072,6 +1072,9 @@ zonkExpr (XExpr (WrapExpr (HsWrap co_fn expr))) zonkExpr (XExpr (ExpansionExpr (HsExpanded a b))) = XExpr . ExpansionExpr . HsExpanded a <$> zonkExpr b +zonkExpr (XExpr (ExpansionStmt (HsExpanded a b))) + = XExpr . ExpansionStmt . HsExpanded a <$> zonkExpr b + zonkExpr (XExpr (ConLikeTc con tvs tys)) = XExpr . ConLikeTc con tvs <$> mapM zonk_scale tys where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1c9f376f483c2c7253ddb12585c027c9670b122...5364bb8e262ea9b8808eff6b7381c9217e4a1bc4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1c9f376f483c2c7253ddb12585c027c9670b122...5364bb8e262ea9b8808eff6b7381c9217e4a1bc4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 17:32:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 11 Jul 2023 13:32:17 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Add flag to enable/disable ghc-toolchain based configurations Message-ID: <64ad92217e82d_5b5e1b1bac10958d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 48f6dd22 by Rodrigo Mesquita at 2023-07-11T18:31:31+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 6 changed files: - configure.ac - distrib/configure.ac.in - hadrian/cfg/system.config.in - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - m4/ghc_toolchain.m4 Changes: ===================================== configure.ac ===================================== @@ -163,6 +163,13 @@ if test "$EnableNativeIOManager" = "YES"; then AC_DEFINE_UNQUOTED([DEFAULT_NATIVE_IO_MANAGER], [1], [Enable Native I/O manager as default.]) fi +AC_ARG_ENABLE(ghc-toolchain, +[AS_HELP_STRING([--enable-ghc-toolchain], + [Whether to use the newer ghc-toolchain tool to configure ghc targets])], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableGhcToolchain])], + [EnableGhcToolchain=NO] +) +AC_SUBST([EnableGhcToolchain]) dnl CC_STAGE0, LD_STAGE0, AR_STAGE0 are like the "previous" variable dnl CC, LD, AR (inherited by CC_STAGE[123], etc.) @@ -1304,7 +1311,7 @@ For more information on how to configure your GHC build, see # have a correct complete /host/ toolchain rather than an incomplete one, which # might further unlock things like canadian cross-compilation # -# VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.ghc-toolchain.host.target]) +# VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.host.target.ghc-toolchain]) -VALIDATE_GHC_TOOLCHAIN([default.target],[default.ghc-toolchain.target]) +VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) ===================================== distrib/configure.ac.in ===================================== @@ -314,7 +314,7 @@ checkMake380 gmake PREP_TARGET_FILE FIND_GHC_TOOLCHAIN -VALIDATE_GHC_TOOLCHAIN([default.target],[default.ghc-toolchain.target]) +VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) echo "****************************************************" echo "Configuration done, ready to 'make install'" ===================================== hadrian/cfg/system.config.in ===================================== @@ -38,6 +38,7 @@ cc-llvm-backend = @CcLlvmBackend@ #=============== ghc-source-path = @hardtop@ +use-ghc-toolchain = @EnableGhcToolchain@ # Information about build, host and target systems: #================================================== ===================================== hadrian/src/Hadrian/Oracles/TextFile.hs ===================================== @@ -89,7 +89,10 @@ lookupDependencies depFile file = do -- | Parse a target from a text file, tracking the result. The file is expected -- to contain a parseable Toolchain.Target value generated by ghc-toolchain. getTargetConfig :: FilePath -> Action Toolchain.Target -getTargetConfig file = askOracle $ TargetFile file +getTargetConfig file0 = do + useGhcToolchain <- lookupSystemConfig "use-ghc-toolchain" + let file1 = if useGhcToolchain == "YES" then file0 <.> "ghc-toolchain" else file0 + askOracle $ TargetFile file1 -- | Get the build target configuration through 'getTargetConfig' getBuildTarget :: Action Toolchain.Target ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -38,6 +38,7 @@ data Flag = CrossCompiling | UseLibbfd | UseLibpthread | NeedLibatomic + | UseGhcToolchain -- Note, if a flag is set to empty string we treat it as set to NO. This seems -- fragile, but some flags do behave like this. @@ -61,6 +62,7 @@ flag f = do UseLibbfd -> "use-lib-bfd" UseLibpthread -> "use-lib-pthread" NeedLibatomic -> "need-libatomic" + UseGhcToolchain -> "use-ghc-toolchain" value <- lookupSystemConfig key when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag " ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." ===================================== m4/ghc_toolchain.m4 ===================================== @@ -51,7 +51,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], # (1) Configure a toolchain for the build and host platform (we require that BUILD=HOST, so one toolchain suffices) rm -f acargs echo "--triple=$HostPlatform" >> acargs - echo "--output=default.ghc-toolchain.host.target" >> acargs + echo "--output=default.host.target.ghc-toolchain" >> acargs dnl echo "--llvm-triple=$LlvmTarget" >> acargs echo "--cc=$CC_STAGE0" >> acargs dnl echo "--readelf=$READELF" >> acargs @@ -84,7 +84,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], # calling it through configure. rm -f acargs echo "--triple=$target" >> acargs - echo "--output=default.ghc-toolchain.target" >> acargs + echo "--output=default.target.ghc-toolchain" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs echo "--cc=$CC" >> acargs echo "--cxx=$CXX" >> acargs @@ -124,7 +124,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], dnl $1 like "default.target" -dnl $2 like "default.ghc-toolchain.target" +dnl $2 like "default.target.ghc-toolchain" AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ diff_output=`diff "$1" "$2" 2>&1` if test -z "$diff_output"; then View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f6dd226dab48e282c96bb896a3d1f72c9a6cad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f6dd226dab48e282c96bb896a3d1f72c9a6cad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 18:12:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 11 Jul 2023 14:12:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: compiler: Fingerprint more code generation flags Message-ID: <64ad9b8fcce5d_5b5e1b1bac121953@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - c3f23d76 by Matthew Pickering at 2023-07-11T14:12:11-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 056f909e by sheaf at 2023-07-11T14:12:18-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - 23 changed files: - .gitlab/ci.sh - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/cbits/genSym.c - docs/users_guide/debugging.rst - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - + testsuite/tests/codeGen/should_run/OrigThunkInfo.hs - + testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/typecheck/should_fail/T22684.hs - + testsuite/tests/typecheck/should_fail/T22684.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/deriveConstants/Main.hs Changes: ===================================== .gitlab/ci.sh ===================================== @@ -75,16 +75,6 @@ Environment variables affecting both build systems: (either "x86-64-darwin" or "aarch-darwin") NO_BOOT Whether to run ./boot or not, used when testing the source dist -Environment variables determining build configuration of Make system: - - BUILD_FLAVOUR Which flavour to build. - BUILD_SPHINX_HTML Whether to build Sphinx HTML documentation. - BUILD_SPHINX_PDF Whether to build Sphinx PDF documentation. - INTEGER_LIBRARY Which integer library to use (integer-simple or integer-gmp). - HADDOCK_HYPERLINKED_SOURCES - Whether to build hyperlinked Haddock sources. - TEST_TYPE Which test rule to run. - Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. @@ -390,26 +380,6 @@ function cleanup_submodules() { end_section "clean submodules" } -function prepare_build_mk() { - if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi - if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi - if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi - - cat > mk/build.mk <> mk/build.mk - fi - - - info "build.mk is:" - cat mk/build.mk -} - function configure() { case "${CONFIGURE_WRAPPER:-}" in emconfigure) source "$EMSDK/emsdk_env.sh" ;; ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -53,6 +53,7 @@ module GHC.Cmm.CLabel ( mkDirty_MUT_VAR_Label, mkMUT_VAR_CLEAN_infoLabel, mkNonmovingWriteBarrierEnabledLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, @@ -641,7 +642,7 @@ mkBlockInfoTableLabel name c = IdLabel name c BlockInfoTable -- Constructing Cmm Labels mkDirty_MUT_VAR_Label, mkNonmovingWriteBarrierEnabledLabel, - mkUpdInfoLabel, + mkOrigThunkInfoLabel, mkUpdInfoLabel, mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel, mkMAP_FROZEN_CLEAN_infoLabel, mkMAP_FROZEN_DIRTY_infoLabel, mkMAP_DIRTY_infoLabel, @@ -655,6 +656,7 @@ mkDirty_MUT_VAR_Label, mkDirty_MUT_VAR_Label = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction mkNonmovingWriteBarrierEnabledLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "nonmoving_write_barrier_enabled") CmmData +mkOrigThunkInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_orig_thunk_info_frame") CmmInfo mkUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_upd_frame") CmmInfo mkBHUpdInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_bh_upd_frame" ) CmmInfo mkIndStaticInfoLabel = CmmLabel rtsUnitId (NeedExternDecl False) (fsLit "stg_IND_STATIC") CmmInfo ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -41,6 +41,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmFastPAPCalls = gopt Opt_FastPAPCalls dflags , stgToCmmSCCProfiling = sccProfilingEnabled dflags , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags + , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -5,6 +5,7 @@ module GHC.Driver.Flags , GeneralFlag(..) , Language(..) , optimisationFlags + , codeGenFlags -- * Warnings , WarningGroup(..) @@ -337,6 +338,7 @@ data GeneralFlag | Opt_IgnoreHpcChanges | Opt_ExcessPrecision | Opt_EagerBlackHoling + | Opt_OrigThunkInfo | Opt_NoHsMain | Opt_SplitSections | Opt_StgStats @@ -484,15 +486,11 @@ data GeneralFlag | Opt_G_NoOptCoercion deriving (Eq, Show, Enum) --- Check whether a flag should be considered an "optimisation flag" --- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags). Being listed here is --- not a guarantee that the flag has no other effect. We could, and --- perhaps should, separate out the flags that have some minor impact on --- program semantics and/or error behavior (e.g., assertions), but --- then we'd need to go to extra trouble (and an additional flag) --- to allow users to ignore the optimisation level even though that --- means ignoring some change. +-- | The set of flags which affect optimisation for the purposes of +-- recompilation avoidance. Specifically, these include flags which +-- affect code generation but not the semantics of the program. +-- +-- See Note [Ignoring some flag changes] in GHC.Iface.Recomp.Flags) optimisationFlags :: EnumSet GeneralFlag optimisationFlags = EnumSet.fromList [ Opt_CallArity @@ -524,16 +522,12 @@ optimisationFlags = EnumSet.fromList , Opt_EnableRewriteRules , Opt_RegsGraph , Opt_RegsIterative - , Opt_PedanticBottoms , Opt_LlvmTBAA - , Opt_LlvmFillUndefWithGarbage , Opt_IrrefutableTuples , Opt_CmmSink , Opt_CmmElimCommonBlocks , Opt_AsmShortcutting - , Opt_OmitYields , Opt_FunToThunk - , Opt_DictsStrict , Opt_DmdTxDictSel , Opt_Loopification , Opt_CfgBlocklayout @@ -542,8 +536,48 @@ optimisationFlags = EnumSet.fromList , Opt_WorkerWrapper , Opt_WorkerWrapperUnlift , Opt_SolveConstantDicts + ] + +-- | The set of flags which affect code generation and can change a program's +-- runtime behavior (other than performance). These include flags which affect: +-- +-- * user visible debugging information (e.g. info table provenance) +-- * the ability to catch runtime errors (e.g. -fignore-asserts) +-- * the runtime result of the program (e.g. -fomit-yields) +-- * which code or interface file declarations are emitted +-- +-- We also considered placing flags which affect asympototic space behavior +-- (e.g. -ffull-laziness) however this would mean that changing optimisation +-- levels would trigger recompilation even with -fignore-optim-changes, +-- regressing #13604. +-- +-- Also, arguably Opt_IgnoreAsserts should be here as well; however, we place +-- it instead in 'optimisationFlags' since it is implied by @-O[12]@ and +-- therefore would also break #13604. +-- +-- See #23369. +codeGenFlags :: EnumSet GeneralFlag +codeGenFlags = EnumSet.fromList + [ -- Flags that affect runtime result + Opt_EagerBlackHoling + , Opt_ExcessPrecision + , Opt_DictsStrict + , Opt_PedanticBottoms + , Opt_OmitYields + + -- Flags that affect generated code + , Opt_ExposeAllUnfoldings + , Opt_NoTypeableBinds + + -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases - , Opt_IgnoreAsserts + , Opt_LlvmFillUndefWithGarbage + , Opt_DoTagInferenceChecks + + -- Flags that affect debugging information + , Opt_DistinctConstructorTables + , Opt_InfoTableMap + , Opt_OrigThunkInfo ] data WarningFlag = ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -66,6 +66,7 @@ module GHC.Driver.Session ( makeDynFlagsConsistent, positionIndependent, optimisationFlags, + codeGenFlags, setFlagsFromEnvFile, pprDynFlagsDiff, flagSpecOf, @@ -2346,6 +2347,7 @@ fFlagsDeps = [ flagSpec "do-eta-reduction" Opt_DoEtaReduction, flagSpec "do-lambda-eta-expansion" Opt_DoLambdaEtaExpansion, flagSpec "eager-blackholing" Opt_EagerBlackHoling, + flagSpec "orig-thunk-info" Opt_OrigThunkInfo, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Other flags which affect code generation + codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -730,7 +730,8 @@ setupUpdate closure_info node body lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel - pushUpdateFrame lbl (CmmReg (CmmLocal node)) body + pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame lbl (CmmReg (CmmLocal node)) body | otherwise -- A static closure = do { tickyUpdateBhCaf closure_info @@ -738,7 +739,8 @@ setupUpdate closure_info node body ; if closureUpdReqd closure_info then do -- Blackhole the (updatable) CAF: { upd_closure <- link_caf node - ; pushUpdateFrame mkBHUpdInfoLabel upd_closure body } + ; pushOrigThunkInfoFrame closure_info + $ pushUpdateFrame mkBHUpdInfoLabel upd_closure body } else do {tickyUpdateFrameOmitted; body} } @@ -754,8 +756,7 @@ pushUpdateFrame lbl updatee body = do updfr <- getUpdFrameOff profile <- getProfile - let - hdr = fixedHdrSize profile + let hdr = fixedHdrSize profile frame = updfr + hdr + pc_SIZEOF_StgUpdateFrame_NoHdr (profileConstants profile) -- emitUpdateFrame (CmmStackSlot Old frame) lbl updatee @@ -773,6 +774,47 @@ emitUpdateFrame frame lbl updatee = do emitStore (cmmOffset platform frame off_updatee) updatee initUpdFrameProf frame +----------------------------------------------------------------------------- +-- Original thunk info table frames +-- +-- Note [Original thunk info table frames] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- In some debugging scenarios (e.g. when debugging cyclic thunks) it can be very +-- useful to know which thunks the program is in the process of evaluating. +-- However, in the case of updateable thunks this can be very difficult +-- to determine since the process of blackholing overwrites the thunk's +-- info table pointer. +-- +-- To help in such situations we provide the -forig-thunk-info flag. This enables +-- code generation logic which pushes a stg_orig_thunk_info_frame stack frame to +-- accompany each update frame. As the name suggests, this frame captures the +-- the original info table of the thunk being updated. The entry code for these +-- frames has no operational effects; the frames merely exist as breadcrumbs +-- for debugging. + +pushOrigThunkInfoFrame :: ClosureInfo -> FCode () -> FCode () +pushOrigThunkInfoFrame closure_info body = do + cfg <- getStgToCmmConfig + if stgToCmmOrigThunkInfo cfg + then do_it + else body + where + orig_itbl = mkLblExpr (closureInfoLabel closure_info) + do_it = do + updfr <- getUpdFrameOff + profile <- getProfile + let platform = profilePlatform profile + hdr = fixedHdrSize profile + orig_info_frame_sz = + hdr + pc_SIZEOF_StgOrigThunkInfoFrame_NoHdr (profileConstants profile) + off_orig_info = hdr + pc_OFFSET_StgOrigThunkInfoFrame_info_ptr (profileConstants profile) + frame_off = updfr + orig_info_frame_sz + frame = CmmStackSlot Old frame_off + -- + emitStore frame (mkLblExpr mkOrigThunkInfoLabel) + emitStore (cmmOffset platform frame off_orig_info) orig_itbl + withUpdFrameOff frame_off body + ----------------------------------------------------------------------------- -- Entering a CAF -- ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -50,6 +50,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmFastPAPCalls :: !Bool -- ^ , stgToCmmSCCProfiling :: !Bool -- ^ Check if cost-centre profiling is enabled , stgToCmmEagerBlackHole :: !Bool -- ^ + , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1563,16 +1563,19 @@ validHoleFits :: SolverReportErrCtxt -- ^ The context we're in, i.e. the -- the valid hole fits. validHoleFits ctxt@(CEC { cec_encl = implics , cec_tidy = lcl_env}) simps hole - = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (map mk_wanted simps) hole + = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (mapMaybe mk_wanted simps) hole ; return (ctxt {cec_tidy = tidy_env}, fits) } where - mk_wanted :: ErrorItem -> CtEvidence - mk_wanted (EI { ei_pred = pred, ei_evdest = Just dest, ei_loc = loc }) - = CtWanted { ctev_pred = pred - , ctev_dest = dest - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet } - mk_wanted item = pprPanic "validHoleFits no evdest" (ppr item) + mk_wanted :: ErrorItem -> Maybe CtEvidence + mk_wanted (EI { ei_pred = pred, ei_evdest = m_dest, ei_loc = loc }) + | Just dest <- m_dest + = Just (CtWanted { ctev_pred = pred + , ctev_dest = dest + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet }) + | otherwise + = Nothing -- The ErrorItem was a Given + -- See Note [Constraints include ...] givenConstraints :: SolverReportErrCtxt -> [(Type, RealSrcSpan)] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4867,7 +4867,9 @@ data ErrorItem = EI { ei_pred :: PredType -- report about this -- The ei_pred field will never be an unboxed equality with -- a (casted) tyvar on the right; this is guaranteed by the solver - , ei_evdest :: Maybe TcEvDest -- for Wanteds, where to put evidence + , ei_evdest :: Maybe TcEvDest + -- ^ for Wanteds, where to put the evidence + -- for Givens, Nothing , ei_flavour :: CtFlavour , ei_loc :: CtLoc , ei_m_reason :: Maybe CtIrredReason -- if this ErrorItem was made from a ===================================== compiler/cbits/genSym.c ===================================== @@ -9,7 +9,7 @@ // // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) HsWord64 ghc_unique_counter64 = 0; #endif #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) @@ -18,7 +18,7 @@ HsInt ghc_unique_inc = 1; // This function has been added to the RTS. Here we pessimistically assume // that a threaded RTS is used. This function is only used for bootstrapping. -#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,9,0,0) EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr) { ===================================== docs/users_guide/debugging.rst ===================================== @@ -1115,6 +1115,18 @@ Checking for consistency cases. This is helpful when debugging demand analysis or type checker bugs which can sometimes manifest as segmentation faults. +.. ghc-flag:: -forig-thunk-info + :shortdesc: Generate ``stg_orig_thunk_info`` stack frames on thunk entry + :type: dynamic + + When debugging cyclic thunks it can be helpful to know the original + info table of a thunk being evaluated. This flag enables code generation logic + to facilitate this, producing a ``stg_orig_thunk_info`` stack frame alongside + the usual update frame; such ``orig_thunk`` frames have no operational + effect but capture the original info table of the updated thunk for inspection + by debugging tools. See ``Note [Original thunk info table frames]`` in + ``GHC.StgToCmm.Bind`` for details. + .. ghc-flag:: -fcheck-prim-bounds :shortdesc: Instrument array primops with bounds checks. :type: dynamic ===================================== rts/RtsSymbols.c ===================================== @@ -870,7 +870,8 @@ extern char **environ; SymI_HasDataProto(stg_unpack_cstring_utf8_info) \ SymI_HasDataProto(stg_upd_frame_info) \ SymI_HasDataProto(stg_bh_upd_frame_info) \ - SymI_HasProto(suspendThread) \ + SymI_HasDataProto(stg_orig_thunk_info_frame_info) \ + SymI_HasProto(suspendThread) \ SymI_HasDataProto(stg_takeMVarzh) \ SymI_HasDataProto(stg_readMVarzh) \ SymI_HasDataProto(stg_threadStatuszh) \ @@ -878,7 +879,7 @@ extern char **environ; SymI_HasDataProto(stg_tryTakeMVarzh) \ SymI_HasDataProto(stg_tryReadMVarzh) \ SymI_HasDataProto(stg_unmaskAsyncExceptionszh) \ - SymI_HasProto(unloadObj) \ + SymI_HasProto(unloadObj) \ SymI_HasDataProto(stg_unsafeThawArrayzh) \ SymI_HasDataProto(stg_waitReadzh) \ SymI_HasDataProto(stg_waitWritezh) \ @@ -892,7 +893,7 @@ extern char **environ; SymI_NeedsProto(stg_interp_constr5_entry) \ SymI_NeedsProto(stg_interp_constr6_entry) \ SymI_NeedsProto(stg_interp_constr7_entry) \ - SymI_HasDataProto(stg_arg_bitmaps) \ + SymI_HasDataProto(stg_arg_bitmaps) \ SymI_HasProto(large_alloc_lim) \ SymI_HasProto(g0) \ SymI_HasProto(allocate) \ ===================================== rts/StgMiscClosures.cmm ===================================== @@ -45,6 +45,17 @@ import CLOSURE stg_ret_t_info; import CLOSURE stg_ret_v_info; #endif +/* See Note [Original thunk info table frames] in GHC.StgToCmm.Bind. */ +INFO_TABLE_RET (stg_orig_thunk_info_frame, RET_SMALL, + W_ info_ptr, + W_ thunk_info_ptr) + /* no args => explicit stack */ +{ + unwind Sp = W_[Sp + WDS(2)]; + Sp_adj(2); + jump %ENTRY_CODE(Sp(0)) [*]; // NB. all registers live! +} + /* ---------------------------------------------------------------------------- Stack underflow ------------------------------------------------------------------------- */ ===================================== rts/include/rts/storage/Closures.h ===================================== @@ -261,6 +261,13 @@ typedef struct _StgUpdateFrame { StgClosure *updatee; } StgUpdateFrame; +// Thunk update frame +// +// Closure types: RET_SMALL +typedef struct _StgOrigThunkInfoFrame { + StgHeader header; + StgInfoTable *info_ptr; +} StgOrigThunkInfoFrame; // Closure types: RET_SMALL typedef struct { ===================================== rts/include/stg/MiscClosures.h ===================================== @@ -52,6 +52,7 @@ RTS_RET(stg_upd_frame); RTS_RET(stg_bh_upd_frame); RTS_RET(stg_marked_upd_frame); RTS_RET(stg_noupd_frame); +RTS_RET(stg_orig_thunk_info_frame); RTS_RET(stg_catch_frame); RTS_RET(stg_catch_retry_frame); RTS_RET(stg_atomically_frame); ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.hs ===================================== @@ -0,0 +1,4 @@ +module Main where +xs = iterate (+1) 0 +ten = xs !! 10 +main = print ten ===================================== testsuite/tests/codeGen/should_run/OrigThunkInfo.stdout ===================================== @@ -0,0 +1,2 @@ +10 + ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,4 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) +test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) ===================================== testsuite/tests/typecheck/should_fail/T22684.hs ===================================== @@ -0,0 +1,19 @@ +module T22684 where + +-- Example 1 from #22684 +p :: (Int ~ Bool => r) -> r +p _ = undefined + +q :: r +q = p _ + +-- Example 3 from #22684 +class Category k where + (.) :: k b c -> k a b -> k a c + +data Free p a b where + Prod :: Free p a (b, c) + Sum :: Free p (Either a b) c + +instance Category (Free p) where + Sum . Prod = _ ===================================== testsuite/tests/typecheck/should_fail/T22684.stderr ===================================== @@ -0,0 +1,35 @@ + +T22684.hs:8:7: error: [GHC-88464] + • Found hole: _ :: r + Where: ‘r’ is a rigid type variable bound by + the type signature for: + q :: forall r. r + at T22684.hs:7:1-6 + • In the first argument of ‘p’, namely ‘_’ + In the expression: p _ + In an equation for ‘q’: q = p _ + • Relevant bindings include q :: r (bound at T22684.hs:8:1) + Constraints include Int ~ Bool (from T22684.hs:8:7) + Valid hole fits include q :: r (bound at T22684.hs:8:1) + +T22684.hs:19:16: error: [GHC-88464] + • Found hole: _ :: Free p a c + Where: ‘k’, ‘p’ are rigid type variables bound by + the instance declaration + at T22684.hs:18:10-26 + ‘a’, ‘c’ are rigid type variables bound by + the type signature for: + (T22684..) :: forall b c a. Free p b c -> Free p a b -> Free p a c + at T22684.hs:19:7 + • In an equation for ‘T22684..’: Sum T22684.. Prod = _ + In the instance declaration for ‘Category (Free p)’ + • Relevant bindings include + (.) :: Free p b c -> Free p a b -> Free p a c + (bound at T22684.hs:19:7) + Constraints include + b ~ (b2, c1) (from T22684.hs:19:9-12) + b ~ Either a1 b1 (from T22684.hs:19:3-5) + Valid hole fits include + q :: forall r. r + with q @(Free p a c) + (bound at T22684.hs:8:1) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -696,4 +696,5 @@ test('VisFlag2', normal, compile_fail, ['']) test('VisFlag3', normal, compile_fail, ['']) test('VisFlag4', normal, compile_fail, ['']) test('VisFlag5', normal, compile_fail, ['']) +test('T22684', normal, compile_fail, ['']) test('T23514a', normal, compile_fail, ['']) ===================================== utils/deriveConstants/Main.hs ===================================== @@ -437,6 +437,7 @@ wanteds os = concat ,structField Both "StgEntCounter" "entry_count" ,closureSize Both "StgUpdateFrame" + ,closureSize Both "StgOrigThunkInfoFrame" ,closureSize C "StgCatchFrame" ,closureSize C "StgStopFrame" ,closureSize C "StgDeadThreadFrame" @@ -479,6 +480,7 @@ wanteds os = concat ,structSize C "StgTSOProfInfo" ,closureField Both "StgUpdateFrame" "updatee" + ,closureField Both "StgOrigThunkInfoFrame" "info_ptr" ,closureField C "StgCatchFrame" "handler" ,closureField C "StgCatchFrame" "exceptions_blocked" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e96c949e48b373a2f235b33955884e64e9825a18...056f909e96ff169efaf251a13144f0edea6893d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e96c949e48b373a2f235b33955884e64e9825a18...056f909e96ff169efaf251a13144f0edea6893d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 18:34:29 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 11 Jul 2023 14:34:29 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Add note about left-to-right scoping Message-ID: <64ada0b57311b_5b5e1b1bd41277c0@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 42891dd2 by Andrei Borzenkov at 2023-07-11T22:33:59+04:00 Add note about left-to-right scoping - - - - - 1 changed file: - compiler/GHC/Rename/Pat.hs Changes: ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -1116,6 +1116,7 @@ rnHsTyPat ctxt sigType = case sigType of -- For the OccSet in the ReaderT, see Note [Locally bound names in type patterns] -- For the HsTyPatRnBuilderRn in the WriterT, see Note [Implicit and explicit type variable binders] -- For the CpsRn base monad, see Note [CpsRn monad] +-- For why we need CpsRn in TPRnM see Note [Left-to-right scoping of type patterns] newtype TPRnM a = MkTPRnM (ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a) deriving newtype (Functor, Applicative, Monad) @@ -1422,4 +1423,68 @@ as `collectPatBinders` and `tcHsTyPat`, so we store it in the extension field of To collect lists of those variables efficiently we use `HsTyPatRnBuilder` which is exactly like `HsTyPatRn`, but uses Bags. + +Note [Left-to-right scoping of type patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In term-level patterns, we use continuation passing to implement left-to-right +scoping, see Note [CpsRn monad]. Left-to-right scoping manifests itself when +e.g. view patterns are involved: + + f (x, g x -> Just y) = ... + +Here the first occurrence of `x` is a binder, and the second occurrence is a +use of `x` in a view pattern. This example does not work if we swap the +components of the tuple: + + f (g x -> Just y, x) = ... + -- ^^^ + -- Variable not in scope: x + +In type patterns there are no view patterns, but there is a different feature +that is served well by left-to-right scoping: kind annotations. Compare: + + f (Proxy @(T k (a :: k))) = ... + g (Proxy @(T (a :: k) k)) = ... + +In `f`, the first occurrence of `k` is an explicit binder, + and the second occurrence is a usage. Simple. +In `g`, the first occurrence of `k` is an implicit binder, + and then the second occurrence is an explicit binder that shadows it. + +So we get two different results after renaming: + + f (Proxy @(T k1 (a :: k1))) = ... + g (Proxy @(T (a :: k1) k2)) = ... + +This makes GHC accept the first example but rejects the second example with an +error about duplicate binders. + +One could argue that we don't want order-sensitivity here. Historically, we +used a different principle when renaming types: collect all free variables, +bind them on the outside, and then rename all occurrences as usages. +This approach does not scale to multiple patterns. Consider: + + f' (MkP @k @(a :: k)) = ... + g' (MkP @(a :: k) @k) = ... + +Here a difference in behavior is inevitable, as we rename type patterns +one at a time. Could we perhaps concatenate the free variables from all +type patterns in a ConPat? But then we still get the same problem one level up, +when we have multiple patterns in a function LHS + + f'' (Proxy @k) (Proxy @(a :: k)) = ... + g'' (Proxy @(a :: k)) (Proxy @k) = ... + +And if we tried to provide order sensitivity at this level, then we'd still be left +with lambdas: + + f''' (Proxy @k) = \(Proxy @(a :: k)) -> ... + g''' (Proxy @(a :: k)) = \(Proxy @k) -> ... + + +So we have at least three options where we could do free variable extraction: +HsConPatTyArg, ConPat, or a Match (used to represent a function LHS). And none +of those would be general enough. Rather than make an arbitrary choice, we +embrace left-to-right scoping in types and implement it with CPS, just like +it's done for view patterns in terms. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42891dd2e9cbf9c7e71635f6f93ae85cce5c180e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42891dd2e9cbf9c7e71635f6f93ae85cce5c180e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 18:45:43 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 11 Jul 2023 14:45:43 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Fix typo Message-ID: <64ada357a081a_5b5e1b1bc01372d7@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: bb97b95f by Andrei Borzenkov at 2023-07-11T22:45:32+04:00 Fix typo - - - - - 1 changed file: - compiler/GHC/Rename/Pat.hs Changes: ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -1475,7 +1475,7 @@ when we have multiple patterns in a function LHS f'' (Proxy @k) (Proxy @(a :: k)) = ... g'' (Proxy @(a :: k)) (Proxy @k) = ... -And if we tried to provide order sensitivity at this level, then we'd still be left +And if we tried to avoid order sensitivity at this level, then we'd still be left with lambdas: f''' (Proxy @k) = \(Proxy @(a :: k)) -> ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb97b95f46ea2209986ec819880882b20bf7f51a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bb97b95f46ea2209986ec819880882b20bf7f51a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 11 22:39:44 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 11 Jul 2023 18:39:44 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 60 commits: Substitute free variables captured by breakpoints in SpecConstr Message-ID: <64adda301268_5b5e1b1b481586f1@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - c87df532 by Alan Zimmerman at 2023-07-10T22:54:58+01:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c0594578 by Alan Zimmerman at 2023-07-11T18:00:29+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - cc634fd6 by Alan Zimmerman at 2023-07-11T18:01:42+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 7788a6ec by Alan Zimmerman at 2023-07-11T18:04:24+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - a2c5076d by Alan Zimmerman at 2023-07-11T18:04:24+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - c5cefaee by Alan Zimmerman at 2023-07-11T18:04:24+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 9d479f88 by Alan Zimmerman at 2023-07-11T18:04:24+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - bf739df2 by Alan Zimmerman at 2023-07-11T18:04:24+01:00 EPA: Fix span for GRHS - - - - - 2ce7de1a by Alan Zimmerman at 2023-07-11T18:04:24+01:00 EPA: Fix span for Located Context - - - - - 4d58fc83 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - 54d87f3a by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: widen more TrailingAnn usages - - - - - 331be587 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 4ddbd0f1 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 7507650c by Alan Zimmerman at 2023-07-11T18:04:25+01:00 WIP - - - - - 07cd2074 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 Fixup after rebase - - - - - f62f4ad7 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - d50ed87f by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 767536c2 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - 8bd5504d by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - ff93c748 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - c432776f by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: More extending anchors to full span in Parser.y - - - - - 63416654 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 3fae44a1 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: Fix simple tests - - - - - 6de3c020 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - f3208adc by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 9f5f6150 by Alan Zimmerman at 2023-07-11T18:04:25+01:00 EPA: deal with fallout from getMonoBind - - - - - 862e778b by Alan Zimmerman at 2023-07-11T20:46:09+01:00 EPA fix captureLineSpacing - - - - - 27a2d829 by Alan Zimmerman at 2023-07-11T23:38:48+01:00 EPA print any comments in the span before exiting it - - - - - cb34b526 by Alan Zimmerman at 2023-07-11T23:39:17+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4643c3ce3f081311ec128a04278344c0fcc6809...cb34b5264fc8f990dc449a1bf468cf8699ef2975 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4643c3ce3f081311ec128a04278344c0fcc6809...cb34b5264fc8f990dc449a1bf468cf8699ef2975 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 01:30:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 11 Jul 2023 21:30:02 -0400 Subject: [Git][ghc/ghc][wip/T22710] 68 commits: Add -fbreak-points to control breakpoint insertion Message-ID: <64ae021adcaa4_3f5efcb31b432514@gitlab.mail> Ben Gamari pushed to branch wip/T22710 at Glasgow Haskell Compiler / GHC Commits: 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 7eea297e by Ben Gamari at 2023-07-11T21:29:18-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 1c68fb94 by Ben Gamari at 2023-07-11T21:29:45-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/629d2e2ea5ae3437fc341f89ac1bd2aa6502cf84...1c68fb94f0a8bf79bf13c4b2d6b3d88f49aa7436 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/629d2e2ea5ae3437fc341f89ac1bd2aa6502cf84...1c68fb94f0a8bf79bf13c4b2d6b3d88f49aa7436 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 02:19:33 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Tue, 11 Jul 2023 22:19:33 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to `-f{no-}specialise-incoherents` to enable/disable specialisation of Message-ID: <64ae0db56e880_3f5efcb32a444359@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 6b15ac27 by Gergő Érdi at 2023-07-12T03:19:11+01:00 Add flag to `-f{no-}specialise-incoherents` to enable/disable specialisation of incoherent instances Fixes #23287 - - - - - 25 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/Basic.hs - docs/users_guide/using-optimisation.rst - testsuite/tests/simplCore/should_run/T22448.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -11,7 +11,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv. module GHC.Core.InstEnv ( DFunId, InstMatch, ClsInstLookupResult, - Coherence(..), PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, + Canonical, PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst, @@ -122,10 +122,11 @@ fuzzyClsInstCmp x y = cmp (RM_KnownTc _, RM_WildCard) = GT cmp (RM_KnownTc x, RM_KnownTc y) = stableNameCmp x y -isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool +isOverlappable, isOverlapping, isIncoherent, isNonCanonical :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i)) isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i)) +isNonCanonical i = hasNonCanonicalFlag (overlapMode (is_flag i)) {- Note [ClsInst laziness and the rough-match fields] @@ -812,8 +813,33 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. But sometimes that is +fine, because the programmer promises that it doesn't matter which one is +chosen. A good example is in the `optics` library: + + data IxEq i is js where { IxEq :: IxEq i is is } + + class AppendIndices xs ys ks | xs ys -> ks where + appendIndices :: IxEq i (Curry xs (Curry ys i)) (Curry ks i) + + instance {-# INCOHERENT #-} xs ~ zs => AppendIndices xs '[] zs where + appendIndices = IxEq + + instance ys ~ zs => AppendIndices '[] ys zs where + appendIndices = IxEq + +Here `xs` and `ys` are type-level lists, and for type inference purposes we want to +solve the `AppendIndices` constraint when /either/ of them are the empty list. The +dictionaries are the same in both cases (indeed the dictionary type is a singleton!), +so we really don't care which is used. See #23287 for discussion. + +In short, sometimes we want to specialise on these incoherently-selected dictionaries, +and sometimes we don't. It would be best to have a per-instance pragma, but for now +we have a global flag. The flag `-fspecialise-incoherents` (on by default) enables +specialisation on incoherent evidence (as has been the case previously). +The rest of this note describes what happens with `-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -850,7 +876,7 @@ Here are the moving parts: * `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into (nospec f d) if `d` is incoherent. It has to do a dependency analysis to determine transitive dependencies, but we need to do that anyway. - See Note [Desugaring incoherent evidence] in GHC.HsToCore.Binds. + See Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds. See also Note [nospecId magic] in GHC.Types.Id.Make. -} @@ -955,10 +981,13 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +type Canonical = Bool -- See Note [Recording coherence information in `PotentialUnifiers`] -data PotentialUnifiers = NoUnifiers Coherence +data PotentialUnifiers = NoUnifiers Canonical + -- NoUnifiers True: We have a unique solution modulo canonicity + -- NoUnifiers False: The solutions is not canonical, and thus + -- we shouldn't specialise on it. | OneOrMoreUnifiers (NonEmpty ClsInst) -- This list is lazy as we only look at all the unifiers when -- printing an error message. It can be expensive to compute all @@ -972,28 +1001,19 @@ in `matchInstEnv`. According to Note [Rules for instance lookup] steps IL4 and IL6, we only care about non-`INCOHERENT` instances for this purpose. -It is only when we don't have any potential unifiers (i.e. we know -that we have a unique solution modulo `INCOHERENT` instances) that we -care about that unique solution being coherent or not (see -Note [Coherence and specialisation: overview] for why we care at all). -So we only need the `Coherent` flag in the case where the set of -potential unifiers is otherwise empty. +If we don't have any potential unifiers (i.e. we know that we have a +unique solution modulo `INCOHERENT` instances), we need to know if +that unique solution is canonical or not (see Note [Coherence and +specialisation: overview] for why we care at all). So when the set of +potential unifiers is empty, we record if it's `Canonical`. -} -instance Outputable Coherence where - ppr IsCoherent = text "coherent" - ppr IsIncoherent = text "incoherent" - instance Outputable PotentialUnifiers where - ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c + ppr (NoUnifiers c) = text "NoUnifiers" <+> if c then text "canonical" else text "non-canonical" ppr xs = ppr (getPotentialUnifiers xs) -instance Semigroup Coherence where - IsCoherent <> IsCoherent = IsCoherent - _ <> _ = IsIncoherent - instance Semigroup PotentialUnifiers where - NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 <> c2) + NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 && c2) NoUnifiers _ <> u = u OneOrMoreUnifiers (unifier :| unifiers) <> u = OneOrMoreUnifiers (unifier :| (unifiers <> getPotentialUnifiers u)) @@ -1039,22 +1059,24 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys = acc - incoherently_matched :: PotentialUnifiers -> PotentialUnifiers - incoherently_matched (NoUnifiers _) = NoUnifiers IsIncoherent - incoherently_matched u = u + noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers + noncanonically_matched (NoUnifiers _) = NoUnifiers False + noncanonically_matched u = u check_unifier :: [ClsInst] -> PotentialUnifiers - check_unifier [] = NoUnifiers IsCoherent + check_unifier [] = NoUnifiers True check_unifier (item at ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items) | not (instIsVisible vis_mods item) = check_unifier items -- See Note [Instance lookup and orphan instances] | Just {} <- tcMatchTys tpl_tys tys = check_unifier items -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] + -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview] + | isNonCanonical item + = noncanonically_matched $ check_unifier items -- Ignore ones that are incoherent: Note [Incoherent instances] - -- Record that we encountered incoherent instances: Note [Coherence and specialisation: overview] | isIncoherent item - = incoherently_matched $ check_unifier items + = check_unifier items | otherwise = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set) @@ -1111,7 +1133,7 @@ lookupInstEnv check_overlap_safe -- If the selected match is incoherent, discard all unifiers final_unifs = case final_matches of - (m:_) | isIncoherent (fst m) -> NoUnifiers IsCoherent + (m:_) | isIncoherent (fst m) -> NoUnifiers True _ -> all_unifs -- Note [Safe Haskell isSafeOverlap] @@ -1289,7 +1311,7 @@ noMatches = InstMatches { instMatches = [], instGuards = [] } pruneOverlappedMatches :: [InstMatch] -> [InstMatch] -- ^ Remove from the argument list any InstMatches for which another -- element of the list is more specific, and overlaps it, using the --- rules of Nove [Rules for instance lookup] +-- rules of Note [Rules for instance lookup] pruneOverlappedMatches all_matches = instMatches $ foldr insert_overlapping noMatches all_matches ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1168,7 +1168,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -267,6 +267,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2433,6 +2433,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -911,6 +911,7 @@ ppOverlapPragma mb = 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 where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Hs -- lots of things import GHC.Core -- lots of things import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Core.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( etaExpand ) @@ -1152,14 +1152,14 @@ evidence that is used in `e`. This question arose when thinking about deep subsumption; see https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649). -Note [Desugaring incoherent evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the evidence is coherent, we desugar WpEvApp by simply passing +Note [Desugaring non-canonical evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the evidence is canonical, we desugar WpEvApp by simply passing core_tm directly to k: k core_tm -If the evidence is not coherent, we mark the application with nospec: +If the evidence is not canonical, we mark the application with nospec: nospec @(cls => a) k core_tm @@ -1170,14 +1170,14 @@ of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). See Note [Coherence and specialisation: overview] for why we shouldn't specialise incoherent evidence. -We can find out if a given evidence is coherent or not during the -desugaring of its WpLet wrapper: an evidence is incoherent if its +We can find out if a given evidence is canonical or not during the +desugaring of its WpLet wrapper: an evidence is non-canonical if its own resolution was incoherent (see Note [Incoherent instances]), or -if its definition refers to other incoherent evidence. dsEvBinds is +if its definition refers to other non-canonical evidence. dsEvBinds is the convenient place to compute this, since it already needs to do inter-evidence dependency analysis to generate well-scoped -bindings. We then record this coherence information in the -dsl_coherence field of DsM's local environment. +bindings. We then record this specialisability information in the +dsl_unspecables field of DsM's local environment. -} @@ -1201,20 +1201,27 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring non-canonical evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } +-- We are about to construct an evidence application `f dict`. If the dictionary is +-- non-specialisable, instead construct +-- nospec f dict +-- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1232,7 +1239,7 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- * Desugars the ev_binds, sorts them into dependency order, and -- passes the resulting [CoreBind] to thing_inside --- * Extends the DsM (dsl_coherence field) with coherence information +-- * Extends the DsM (dsl_unspecable field) with specialisability information -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside @@ -1240,53 +1247,50 @@ dsEvBinds ev_binds thing_inside ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where - go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a + go ::[SCC (Node EvVar (Canonical, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False - - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where - ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + ((v, rhs), (this_canonical, deps)) = unpack_node node + transitively_unspecable = not this_canonical || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where - (pairs, direct_coherence) = unzip $ map unpack_node nodes + (pairs, direct_canonicity) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not this_canonical || any is_unspecable_remote deps | (this_canonical, deps) <- direct_canonicity ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring non-canonical evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty - unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) + unpack_node DigraphNode { node_key = v, node_payload = (canonical, rhs), node_dependencies = deps } = ((v, rhs), (canonical, deps)) -sort_ev_binds :: Bag (Id, Coherence, CoreExpr) -> [SCC (Node EvVar (Coherence, CoreExpr))] +sort_ev_binds :: Bag (Id, Canonical, CoreExpr) -> [SCC (Node EvVar (Canonical, CoreExpr))] -- We do SCC analysis of the evidence bindings, /after/ desugaring -- them. This is convenient: it means we can use the GHC.Core -- free-variable functions rather than having to do accurate free vars -- for EvTerm. sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges where - edges :: [ Node EvVar (Coherence, CoreExpr) ] + edges :: [ Node EvVar (Canonical, CoreExpr) ] edges = foldr ((:) . mk_node) [] ds_binds - mk_node :: (Id, Coherence, CoreExpr) -> Node EvVar (Coherence, CoreExpr) - mk_node (var, coherence, rhs) - = DigraphNode { node_payload = (coherence, rhs) + mk_node :: (Id, Canonical, CoreExpr) -> Node EvVar (Canonical, CoreExpr) + mk_node (var, canonical, rhs) + = DigraphNode { node_payload = (canonical, rhs) , node_key = var , node_dependencies = nonDetEltsUniqSet $ exprFreeVars rhs `unionVarSet` @@ -1295,13 +1299,13 @@ sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges -- is still deterministic even if the edges are in nondeterministic order -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. -dsEvBind :: EvBind -> DsM (Id, Coherence, CoreExpr) +dsEvBind :: EvBind -> DsM (Id, Canonical, CoreExpr) dsEvBind (EvBind { eb_lhs = v, eb_rhs = r, eb_info = info }) = do e <- dsEvTerm r - let coherence = case info of - EvBindGiven{} -> IsCoherent - EvBindWanted{ ebi_coherence = coherence } -> coherence - return (v, coherence, e) + let canonical = case info of + EvBindGiven{} -> True + EvBindWanted{ ebi_canonical = canonical } -> canonical + return (v, canonical, e) {-********************************************************************** ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -357,7 +357,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +413,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -2628,6 +2628,7 @@ repOverlap mb = Overlapping _ -> just =<< dataCon overlappingDataConName Overlaps _ -> just =<< dataCon overlapsDataConName Incoherent _ -> just =<< dataCon incoherentDataConName + NonCanonical _ -> just =<< dataCon incoherentDataConName where nothing = coreNothing overlapTyConName just = coreJust overlapTyConName ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -79,9 +79,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar - -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + , dsl_unspecables :: S.Set EvVar + -- ^ See Note [Desugaring non-canonical evidence]: this field collects + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1212,11 +1212,11 @@ addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty ; case dest of EvVarDest evar - -> addTcEvBind ev_binds_var $ mkWantedEvBind evar IsCoherent err_tm + -> addTcEvBind ev_binds_var $ mkWantedEvBind evar True err_tm HoleDest hole -> do { -- See Note [Deferred errors for coercion holes] let co_var = coHoleCoVar hole - ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var IsCoherent err_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var True err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2514,6 +2514,7 @@ reifyClassInstance is_poly_tvs i Overlapping _ -> Just TH.Overlapping Overlaps _ -> Just TH.Overlaps Incoherent _ -> Just TH.Incoherent + NonCanonical _ -> Just TH.Incoherent ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -92,7 +92,7 @@ data ClsInstResult | OneInst { cir_new_theta :: [TcPredType] , cir_mk_ev :: [EvExpr] -> EvTerm - , cir_coherence :: Coherence -- See Note [Coherence and specialisation: overview] + , cir_canonical :: Canonical -- See Note [Coherence and specialisation: overview] , cir_what :: InstanceWhat } | NotSure -- Multiple matches and/or one or more unifiers @@ -162,7 +162,7 @@ matchInstEnv dflags short_cut_solver clas tys ; return NoInstance } -- A single match (& no safe haskell failure) - ([(ispec, inst_tys)], NoUnifiers coherence, False) + ([(ispec, inst_tys)], NoUnifiers canonical, False) | short_cut_solver -- Called from the short-cut solver , isOverlappable ispec -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT @@ -175,12 +175,11 @@ matchInstEnv dflags short_cut_solver clas tys | otherwise -> do { let dfun_id = instanceDFunId ispec ; traceTc "matchClass success" $ - vcat [text "dict" <+> ppr pred, - ppr coherence, + vcat [text "dict" <+> ppr pred <+> parens (if canonical then text "canonical" else text "non-canonical"), text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ] -- Record that this dfun is needed - ; match_one (null unsafeOverlaps) coherence dfun_id inst_tys } + ; match_one (null unsafeOverlaps) canonical dfun_id inst_tys } -- More than one matches (or Safe Haskell fail!). Defer any -- reactions of a multitude until we learn more about the reagent @@ -191,15 +190,15 @@ matchInstEnv dflags short_cut_solver clas tys where pred = mkClassPred clas tys -match_one :: SafeOverlapping -> Coherence -> DFunId -> [DFunInstType] -> TcM ClsInstResult +match_one :: SafeOverlapping -> Canonical -> DFunId -> [DFunInstType] -> TcM ClsInstResult -- See Note [DFunInstType: instantiating types] in GHC.Core.InstEnv -match_one so coherence dfun_id mb_inst_tys +match_one so canonical dfun_id mb_inst_tys = do { traceTc "match_one" (ppr dfun_id $$ ppr mb_inst_tys) ; (tys, theta) <- instDFunType dfun_id mb_inst_tys ; traceTc "match_one 2" (ppr dfun_id $$ ppr tys $$ ppr theta) ; return $ OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = TopLevInstance { iw_dfun_id = dfun_id , iw_safe_over = so } } } @@ -235,7 +234,7 @@ matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys , cir_mk_ev = tuple_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! where @@ -399,7 +398,7 @@ makeLitDict clas ty et , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) = return $ OneInst { cir_new_theta = [] , cir_mk_ev = \_ -> ev_tm - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } | otherwise @@ -448,7 +447,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_canonical = False -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } @@ -555,7 +554,7 @@ Some further observations about `withDict`: k (sv |> (sub co2 ; sym co))) That is, we cast the method using a coercion, and apply k to - it. Moreover, we mark the evidence as incoherent, resulting in + it. Moreover, we mark the evidence as non-canonical, resulting in the use of the 'nospec' magicId (see Note [nospecId magic] in GHC.Types.Id.Make) to ensure that the typeclass specialiser doesn't incorrectly common-up distinct evidence terms. This is @@ -641,7 +640,7 @@ doFunTy :: Class -> Type -> Mult -> Type -> Type -> TcM ClsInstResult doFunTy clas ty mult arg_ty ret_ty = return $ OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] @@ -658,7 +657,7 @@ doTyConApp clas ty tc kind_args | tyConIsTypeable tc = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) kind_args , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinTypeableInstance tc } | otherwise = return NoInstance @@ -690,7 +689,7 @@ doTyApp clas ty f tk | otherwise = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2) @@ -711,7 +710,7 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc mk_ev _ = panic "doTyLit" ; return (OneInst { cir_new_theta = [kc_pred] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) } {- Note [Typeable (T a b c)] @@ -946,7 +945,7 @@ matchHasField dflags short_cut clas tys ; keepAlive (greName gre) ; return OneInst { cir_new_theta = theta , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } } else matchInstEnv dflags short_cut clas tys } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -33,7 +33,6 @@ import GHC.Data.Bag import GHC.Core.Class import GHC.Core import GHC.Core.DataCon -import GHC.Core.InstEnv ( Coherence(IsCoherent) ) import GHC.Core.Make import GHC.Driver.DynFlags import GHC.Data.FastString @@ -612,7 +611,7 @@ solveImplicationUsingUnsatGiven go_simple ct = case ctEvidence ct of CtWanted { ctev_pred = pty, ctev_dest = dst } -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty - ; setWantedEvTerm dst IsCoherent $ EvExpr ev_expr } + ; setWantedEvTerm dst True $ EvExpr ev_expr } _ -> return () -- | Create an evidence expression for an arbitrary constraint using ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Hs.Type( HsIPName(..) ) import GHC.Core import GHC.Core.Type -import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) +import GHC.Core.InstEnv ( DFunInstType ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) @@ -184,7 +184,7 @@ solveCallStack ev ev_cs -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] = do { cs_tm <- evCallStack ev_cs ; let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) - ; setEvBindIfWanted ev IsCoherent ev_tm } + ; setEvBindIfWanted ev True ev_tm } {- Note [Shadowing of implicit parameters] @@ -394,7 +394,7 @@ solveEqualityDict ev cls tys ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ evDataConApp data_con tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } @@ -715,10 +715,10 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys -- the inert from the work-item or vice-versa. ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) - ; setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + ; setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) - ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) + ; setEvBindIfWanted ev_i True (ctEvTerm ev_w) ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } @@ -784,7 +784,7 @@ shortCutSolver dflags ev_w ev_i ; case inst_res of OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = what } | safeOverlap what , all isTyFamFree preds -- Note [Shortcut solving: type families] @@ -804,7 +804,7 @@ shortCutSolver dflags ev_w ev_i ; let ev_tm = mk_ev (map getEvExpr evc_vs) ev_binds' = extendEvBinds ev_binds $ - mkWantedEvBind (ctEvEvId ev) coherence ev_tm + mkWantedEvBind (ctEvEvId ev) canonical ev_tm ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ freshGoals evc_vs } @@ -847,7 +847,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls -- See Note [No Given/Given fundeps] | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached - = do { setEvBindIfWanted ev IsCoherent (ctEvTerm solved_ev) + = do { setEvBindIfWanted ev True (ctEvTerm solved_ev) ; stopWith ev "Dict/Top (cached)" } | otherwise -- Wanted, but not cached @@ -869,14 +869,14 @@ chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev - , cir_coherence = coherence }) + , cir_canonical = canonical }) = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) (ppr work_item) ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta - ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; setEvBindIfWanted work_item canonical (mk_ev (map getEvExpr evc_vars)) ; emitWorkNC (freshGoals evc_vars) ; stopWith work_item "Dict/Top (solved wanted)" } where @@ -1070,7 +1070,7 @@ matchLocalInst pred loc -> do { let result = OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = LocalInstance } ; traceTcS "Best local instance found:" $ vcat [ text "pred:" <+> ppr pred @@ -1317,7 +1317,7 @@ last_resort inerts (DictCt { di_ev = ev_w, di_cls = cls, di_tys = xis }) , Just ct_i <- lookupInertDict inerts loc_w cls xis , let ev_i = dictCtEvidence ct_i , isGiven ev_i - = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + = do { setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ TcRnLoopySuperclassSolve loc_w (ctEvPred ev_w) ; return $ Stop ev_w (text "Loopy superclass") } @@ -2158,4 +2158,3 @@ constraints. See also Note [Evidence for quantified constraints] in GHC.Core.Predicate. -} - ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -32,7 +32,6 @@ import GHC.Core.Coercion import GHC.Core.Coercion.Axiom import GHC.Core.Reduction import GHC.Core.Unify( tcUnifyTyWithTFs ) -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.FamInstEnv ( FamInstEnvs, FamInst(..), apartnessCheck , lookupFamInstEnvByTyCon ) import GHC.Core @@ -357,7 +356,7 @@ can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ -- Literals can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ | l1 == l2 - = do { setEvBindIfWanted ev IsCoherent (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) + = do { setEvBindIfWanted ev True (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } -- Decompose FunTy: (s -> t) and (c => t) @@ -1847,7 +1846,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Provide Refl evidence for the constraint -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted new_ev IsCoherent $ + ; setEvBindIfWanted new_ev True $ evCoercion (mkNomReflCo final_rhs) -- Kick out any constraints that can now be rewritten @@ -1958,7 +1957,7 @@ canEqReflexive :: CtEvidence -- ty ~ ty -> TcType -- ty -> TcS (StopOrContinue a) -- always Stop canEqReflexive ev eq_rel ty - = do { setEvBindIfWanted ev IsCoherent $ + = do { setEvBindIfWanted ev True $ evCoercion (mkReflCo (eqRelRole eq_rel) ty) ; stopWith ev "Solved by reflexivity" } @@ -2541,7 +2540,7 @@ tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item - -> do { setEvBindIfWanted ev IsCoherent $ + -> do { setEvBindIfWanted ev True $ evCoercion (maybeSymCo swapped $ downgradeRole (eqRelRole eq_rel) (ctEvRole ev_i) @@ -3188,4 +3187,4 @@ To avoid this situation we do not cache as solved any workitems (or inert) which did not really made a 'step' towards proving some goal. Solved's are just an optimization so we don't lose anything in terms of completeness of solving. --} \ No newline at end of file +-} ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -15,7 +15,6 @@ import GHC.Tc.Solver.Monad import GHC.Tc.Types.Evidence import GHC.Core.Coercion -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Types.Basic( SwapFlag(..) ) @@ -74,9 +73,9 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) + KeepInert -> do { setEvBindIfWanted ev_w True (swap_me swap ev_i) ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } - KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) + KeepWork -> do { setEvBindIfWanted ev_i True (swap_me swap ev_w) ; updInertCans (updIrreds (\_ -> others)) ; continueWith () } } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1688,19 +1688,19 @@ setWantedEq (HoleDest hole) co setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) -- | Good for both equalities and non-equalities -setWantedEvTerm :: TcEvDest -> Coherence -> EvTerm -> TcS () -setWantedEvTerm (HoleDest hole) _coherence tm +setWantedEvTerm :: TcEvDest -> Canonical -> EvTerm -> TcS () +setWantedEvTerm (HoleDest hole) _canonical tm | Just co <- evTermCoercion_maybe tm = do { useVars (coVarsOfCo co) ; fillCoercionHole hole co } | otherwise = -- See Note [Yukky eq_sel for a HoleDest] do { let co_var = coHoleCoVar hole - ; setEvBind (mkWantedEvBind co_var IsCoherent tm) + ; setEvBind (mkWantedEvBind co_var True tm) ; fillCoercionHole hole (mkCoVarCo co_var) } -setWantedEvTerm (EvVarDest ev_id) coherence tm - = setEvBind (mkWantedEvBind ev_id coherence tm) +setWantedEvTerm (EvVarDest ev_id) canonical tm + = setEvBind (mkWantedEvBind ev_id canonical tm) {- Note [Yukky eq_sel for a HoleDest] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1726,10 +1726,10 @@ fillCoercionHole hole co = do { wrapTcS $ TcM.fillCoercionHole hole co ; kickOutAfterFillingCoercionHole hole } -setEvBindIfWanted :: CtEvidence -> Coherence -> EvTerm -> TcS () -setEvBindIfWanted ev coherence tm +setEvBindIfWanted :: CtEvidence -> Canonical -> EvTerm -> TcS () +setEvBindIfWanted ev canonical tm = case ev of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest coherence tm + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest canonical tm _ -> return () newTcEvBinds :: TcS EvBindsVar ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -20,7 +20,6 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate import GHC.Core.Reduction import GHC.Core.Coercion @@ -427,7 +426,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars , et_binds = ev_binds, et_body = w_id } @@ -556,7 +555,7 @@ finish_rewrite ev@(CtWanted { ctev_dest = dest (Reduction co new_pred) new_rewriters = do { mb_new_ev <- newWanted loc rewriters' new_pred ; massert (coercionRole co == ctEvRole ev) - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ mkEvCast (getEvExpr mb_new_ev) (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) ; case mb_new_ev of @@ -631,7 +630,7 @@ runTcPluginsWanted wc@(WC { wc_simple = simples1 }) where setEv :: (EvTerm,Ct) -> TcS () setEv (ev,ct) = case ctEvidence ct of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest IsCoherent ev -- TODO: plugins should be able to signal non-coherence + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest True ev -- TODO: plugins should be able to signal non-canonicity _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" -- | A pair of (given, wanted) constraints to pass to plugins ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1482,7 +1482,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_top_name <- newName (mkSuperDictAuxOcc n (getOccName cls)) ; sc_ev_id <- newEvVar sc_pred - ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id True sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred sc_top_id = mkLocalId sc_top_name ManyTy sc_top_ty export = ABE { abe_wrap = idHsWrapper ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Types.Basic import GHC.Core import GHC.Core.Class (Class, classSCSelId ) import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Utils.Misc import GHC.Utils.Panic @@ -451,7 +451,7 @@ instance Outputable EvBindMap where data EvBindInfo = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver } - | EvBindWanted { ebi_coherence :: Coherence -- See Note [Desugaring incoherent evidence] + | EvBindWanted { ebi_canonical :: Canonical -- See Note [Desugaring non-canonical evidence] } ----------------- @@ -465,7 +465,7 @@ data EvBind evBindVar :: EvBind -> EvVar evBindVar = eb_lhs -mkWantedEvBind :: EvVar -> Coherence -> EvTerm -> EvBind +mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind mkWantedEvBind ev c tm = EvBind { eb_info = EvBindWanted c, eb_lhs = ev, eb_rhs = tm } -- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, RecursiveDo #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -820,16 +821,31 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt LangExt.OverlappingInstances dflags - incoherent_ok = xopt LangExt.IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags + noncanonical_incoherence = not $ gopt Opt_SpecialiseIncoherents dflags + use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent NoSourceText) | overlap_ok = use (Overlaps NoSourceText) | otherwise = use (NoOverlap NoSourceText) - final_oflag = setOverlapModeMaybe default_oflag overlap_mode + oflag = setOverlapModeMaybe default_oflag overlap_mode + final_oflag = effective_oflag noncanonical_incoherence oflag ; return final_oflag } + where + effective_oflag noncanonical_incoherence oflag at OverlapFlag{ overlapMode = overlap_mode } + = oflag { overlapMode = effective_overlap_mode noncanonical_incoherence overlap_mode } + + -- The `-fspecialise-incoherents` flag controls the meaning of the + -- `Incoherent` overlap mode: as either an Incoherent overlap + -- flag, or a NonCanonical overlap flag. See Note [Coherence and specialisation: overview] + -- in GHC.Core.InstEnv for why we care about this distinction. + effective_overlap_mode noncanonical_incoherence = \case + Incoherent s | noncanonical_incoherence -> NonCanonical s + overlap_mode -> overlap_mode + tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, - hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, + hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag, Boxity(..), isBoxed, @@ -628,6 +628,7 @@ hasIncoherentFlag :: OverlapMode -> Bool hasIncoherentFlag mode = case mode of Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappableFlag :: OverlapMode -> Bool @@ -636,6 +637,7 @@ hasOverlappableFlag mode = Overlappable _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappingFlag :: OverlapMode -> Bool @@ -644,8 +646,14 @@ hasOverlappingFlag mode = Overlapping _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False +hasNonCanonicalFlag :: OverlapMode -> Bool +hasNonCanonicalFlag = \case + NonCanonical{} -> True + _ -> False + data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv = NoOverlap SourceText -- See Note [Pragma source text] @@ -700,6 +708,16 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv -- instantiating 'b' would change which instance -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv" + | NonCanonical SourceText + -- ^ Behave like Incoherent, but the instance choice is observable + -- by the program behaviour. See Note [Coherence and specialisation: overview]. + -- + -- We don't have surface syntax for the distinction between + -- Incoherent and NonCanonical instances; instead, the flag + -- `-f{no-}specialise-incoherents` (on by default) controls + -- whether `INCOHERENT` instances are regarded as Incoherent or + -- NonCanonical. + deriving (Eq, Data) @@ -712,6 +730,7 @@ instance Outputable OverlapMode where ppr (Overlapping _) = text "[overlapping]" ppr (Overlaps _) = text "[overlap ok]" ppr (Incoherent _) = text "[incoherent]" + ppr (NonCanonical _) = text "[noncanonical]" instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s @@ -719,6 +738,7 @@ instance Binary OverlapMode where put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s + put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s get bh = do h <- getByte bh case h of @@ -727,6 +747,7 @@ instance Binary OverlapMode where 2 -> (get bh) >>= \s -> return $ Incoherent s 3 -> (get bh) >>= \s -> return $ Overlapping s 4 -> (get bh) >>= \s -> return $ Overlappable s + 5 -> (get bh) >>= \s -> return $ NonCanonical s _ -> panic ("get OverlapMode" ++ show h) ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1144,6 +1144,25 @@ as such you shouldn't need to set any of them explicitly. A flag which returns a constrained type. For example, a type class where one of the methods implements a traversal. + +.. ghc-flag:: -fspecialise-incoherents + :shortdesc: Enable specialisation on incoherent instances + :type: dynamic + :reverse: -fno-specialise-incoherents + :category: + + :default: on + + Enable specialisation of overloaded functions in cases when the + selected instance is incoherent. This makes the choice of instance + non-deterministic, so it is only safe to do if there is no + observable runtime behaviour difference between potentially + unifying instances. Turning this flag off ensures the incoherent + instance selection adheres to the algorithm described in + :extension:`IncoherentInstances` at the cost of optimisation + opportunities arising from specialisation. + + .. ghc-flag:: -finline-generics :shortdesc: Annotate methods of derived Generic and Generic1 instances with INLINE[1] pragmas based on heuristics. Implied by :ghc-flag:`-O`. ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2081,6 +2081,11 @@ instance ExactPrint (LocatedP OverlapMode) where an1 <- markAnnCloseP an0 return (L (SrcSpanAnn an1 l) (Incoherent src)) + exact (L (SrcSpanAnn an l) (NonCanonical src)) = do + an0 <- markAnnOpenP an src "{-# INCOHERENT" + an1 <- markAnnCloseP an0 + return (L (SrcSpanAnn an1 l) (Incoherent src)) + -- --------------------------------------------------------------------- instance ExactPrint (HsBind GhcPs) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b15ac27629dda6daea8e3963afa930660873f5b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b15ac27629dda6daea8e3963afa930660873f5b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 05:23:18 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 12 Jul 2023 01:23:18 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 128 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <64ae38c615879_3f5efcb317872329@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 3a8f6515 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 138f9fa2 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 41e49c8a by Apoorv Ingle at 2023-07-11T12:10:48-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - 81f716b8 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - cec61cc9 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 trying out changes to heralds - - - - - 1f87df60 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 add location information for last statements - - - - - 75c79861 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - 3f6608f8 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 adjusting the generated spans for proper error messages - - - - - 73f73e9b by Apoorv Ingle at 2023-07-11T12:10:48-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - 674c8a97 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - 395d2b5a by Apoorv Ingle at 2023-07-11T12:10:48-05:00 - addStmtCtxt to add the right statement context in the error contexts - expansion stmt to span over bind/>>= application and pattern rather than only the arguments - - - - - c6d24b44 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 add stmt context in tcApp rather other places - - - - - 3874bc87 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 add the correct expression context in tcApp - - - - - f45a1d07 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 disable expansion if applicative do is enabled - - - - - 802ea360 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 handle a special in desugaring when a do block has only one statment, the ds location should be set to that of the last statement - - - - - e50b2fb3 by Apoorv Ingle at 2023-07-11T12:10:48-05:00 do not add argument context if it is a do statement - - - - - 77b2c9f0 by Apoorv Ingle at 2023-07-11T12:10:49-05:00 remove applicative do expansion - - - - - 19d72e18 by Apoorv Ingle at 2023-07-11T12:10:49-05:00 add context of first do statement in addArgCtxt, somehow it goes missing - - - - - 416d11de by Apoorv Ingle at 2023-07-11T12:10:49-05:00 add the argument location in error ctxt if it is the first argument of a >> or a >>= - - - - - 367806c1 by Apoorv Ingle at 2023-07-11T12:10:49-05:00 - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - - - - - 66ab1d78 by Apoorv Ingle at 2023-07-11T12:10:49-05:00 some cleanup needed - - - - - 1c47fea6 by Apoorv Ingle at 2023-07-12T00:21:55-05:00 - VAExpansionStmt doesn't need srcloc - fix the ppr function for XExprs - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5364bb8e262ea9b8808eff6b7381c9217e4a1bc4...1c47fea6d5afa0503ab1c1c8d3fc5185f86216e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5364bb8e262ea9b8808eff6b7381c9217e4a1bc4...1c47fea6d5afa0503ab1c1c8d3fc5185f86216e7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 07:13:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 03:13:52 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64ae52b0b77cc_3f5efcb368c9038@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 88272cdf by sheaf at 2023-07-12T03:13:35-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 14d14eb4 by sheaf at 2023-07-12T03:13:35-04:00 exactprint: silence incomplete record update warnings - - - - - 161137d8 by sheaf at 2023-07-12T03:13:35-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - a45e478a by sheaf at 2023-07-12T03:13:35-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - 75de112c by sheaf at 2023-07-12T03:13:35-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - 140358d9 by Andreas Schwab at 2023-07-12T03:13:39-04:00 Hadrian: enable GHCi support on riscv64 - - - - - d8229c94 by Josh Meredith at 2023-07-12T03:13:40-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 9f271a5e by Matthew Pickering at 2023-07-12T03:13:40-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - f897f690 by sheaf at 2023-07-12T03:13:44-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - 30 changed files: - .gitlab/ci.sh - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/056f909e96ff169efaf251a13144f0edea6893d0...f897f6908cc970f35fbbdf101bfc57bd55ab9248 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/056f909e96ff169efaf251a13144f0edea6893d0...f897f6908cc970f35fbbdf101bfc57bd55ab9248 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 08:18:35 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 04:18:35 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-dllwrap] configure: Drop DllWrap command Message-ID: <64ae61db4031a_3f5efc65c9ff8108399@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-dllwrap at Glasgow Haskell Compiler / GHC Commits: 1d452ce8 by Rodrigo Mesquita at 2023-07-12T09:18:20+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 11 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - testsuite/tests/safeHaskell/flags/Flags02.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_a, sPgm_l, sPgm_lm, - sPgm_dll, sPgm_T, sPgm_windres, sPgm_ar, @@ -136,7 +135,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -404,8 +403,6 @@ pgm_l :: DynFlags -> (String,[Option]) pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags -pgm_dll :: DynFlags -> (String,[Option]) -pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags pgm_T :: DynFlags -> String pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String @@ -1080,8 +1077,6 @@ dynamic_flags_deps = [ } , make_ord_flag defFlag "pgml-supports-no-pie" $ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True } - , make_ord_flag defFlag "pgmdll" - $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) } , make_ord_flag defFlag "pgmwindres" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f } , make_ord_flag defFlag "pgmar" ===================================== compiler/GHC/Settings.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Settings , sPgm_a , sPgm_l , sPgm_lm - , sPgm_dll , sPgm_T , sPgm_windres , sPgm_ar @@ -108,7 +107,6 @@ data ToolSettings = ToolSettings -- ^ N.B. On Windows we don't have a linker which supports object -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. - , toolSettings_pgm_dll :: (String, [Option]) , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String @@ -218,8 +216,6 @@ sPgm_l :: Settings -> (String, [Option]) sPgm_l = toolSettings_pgm_l . sToolSettings sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings -sPgm_dll :: Settings -> (String, [Option]) -sPgm_dll = toolSettings_pgm_dll . sToolSettings sPgm_T :: Settings -> String sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -127,9 +127,6 @@ initSettings top_dir = do touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" - let mkdll_args = [] - -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -189,7 +186,6 @@ initSettings top_dir = do , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r - , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path ===================================== configure.ac ===================================== @@ -328,14 +328,12 @@ else AC_PATH_TOOL([AR],[ar]) AC_PATH_TOOL([RANLIB],[ranlib]) AC_PATH_TOOL([OBJDUMP],[objdump]) - AC_PATH_TOOL([DllWrap],[dllwrap]) AC_PATH_TOOL([Windres],[windres]) AC_PATH_TOOL([Genlib],[genlib]) HAVE_GENLIB=False if test "$HostOS" = "mingw32"; then AC_CHECK_TARGET_TOOL([Windres],[windres]) - AC_CHECK_TARGET_TOOL([DllWrap],[dllwrap]) AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump]) if test "$Genlib" != ""; then @@ -346,9 +344,7 @@ else fi if test "$HostOS" = "mingw32"; then - DllWrapCmd="$DllWrap" WindresCmd="$Windres" - AC_SUBST([DllWrapCmd]) AC_SUBST([WindresCmd]) AC_SUBST([GenlibCmd]) AC_SUBST([HAVE_GENLIB]) @@ -1238,7 +1234,6 @@ echo "\ otool : $OtoolCmd install_name_tool : $InstallNameToolCmd windres : $WindresCmd - dllwrap : $DllWrapCmd genlib : $GenlibCmd Happy : $HappyCmd ($HappyVersion) Alex : $AlexCmd ($AlexVersion) ===================================== hadrian/bindist/Makefile ===================================== @@ -103,7 +103,6 @@ lib/settings : config.mk @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ - @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -271,7 +271,6 @@ SettingsArCommand = @SettingsArCommand@ SettingsOtoolCommand = @SettingsOtoolCommand@ SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ -SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -155,7 +155,6 @@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ -settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ settings-llc-command = @SettingsLlcCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -123,7 +123,6 @@ data SettingsFileSetting | SettingsFileSetting_RanlibCommand | SettingsFileSetting_OtoolCommand | SettingsFileSetting_InstallNameToolCommand - | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand | SettingsFileSetting_LlcCommand @@ -220,7 +219,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" SettingsFileSetting_OtoolCommand -> "settings-otool-command" SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -462,7 +462,6 @@ generateSettings = do , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) - , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) ===================================== m4/fp_settings.m4 ===================================== @@ -23,7 +23,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsFlags="" SettingsArCommand="${mingw_bin_prefix}llvm-ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" - SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" SettingsTouchCommand='$$topdir/bin/touchy.exe' @@ -45,11 +44,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsCommand="$MergeObjsCmd" SettingsMergeObjectsFlags="$MergeObjsArgs" - if test -z "$DllWrapCmd"; then - SettingsDllWrapCommand="/bin/false" - else - SettingsDllWrapCommand="$DllWrapCmd" - fi if test -z "$WindresCmd"; then SettingsWindresCommand="/bin/false" else @@ -70,7 +64,6 @@ AC_DEFUN([FP_SETTINGS], SettingsLdCommand="$(basename $SettingsLdCommand)" SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" SettingsArCommand="$(basename $SettingsArCommand)" - SettingsDllWrapCommand="$(basename $SettingsDllWrapCommand)" SettingsWindresCommand="$(basename $SettingsWindresCommand)" fi fi @@ -115,7 +108,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsOtoolCommand) AC_SUBST(SettingsInstallNameToolCommand) - AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsLlcCommand) ===================================== testsuite/tests/safeHaskell/flags/Flags02.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# OPTIONS_GHC -pgmdll pgmdll, -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} +{-# OPTIONS_GHC -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} -- | These are all flags that should be allowed module Flags02 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d452ce8276789348e35e45ff3bb0097e19761af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d452ce8276789348e35e45ff3bb0097e19761af You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 08:22:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 04:22:39 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 19 commits: configure: Drop DllWrap command Message-ID: <64ae62cfeda1e_3f5efc65c9ff81095c3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1d452ce8 by Rodrigo Mesquita at 2023-07-12T09:18:20+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 347036af by Ben Gamari at 2023-07-12T09:18:52+01:00 ghc-toolchain: Initial commit - - - - - af72240f by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - 7bd1663c by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags - - - - - 878f5e78 by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - dd5444fe by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 342d09cd by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 9bad0e62 by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 Use ghc-platform instead of ghc-boot - - - - - ed6740f8 by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 Revert "Mingw bundled toolchain" This reverts commit 7d04d6bcb4a65d6dc97f1d59497c3c0a208b8be6. Revert "Windows bundled toolchain, output path, etc" This reverts commit 50089ea4b39885c38f1e6b02c9babebf47170d1c. Revert "Add windows bundled toolchain specific flags" This reverts commit a5734d7450890f739196d46610ba8d5558755782. Adjust - - - - - e349bf98 by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 FixeWs Fixes2 - - - - - c12fa335 by Rodrigo Mesquita at 2023-07-12T09:18:52+01:00 Try to add locally-executable arg - - - - - 5dfb5d41 by Rodrigo Mesquita at 2023-07-12T09:22:26+01:00 New host.target - - - - - 67432ee9 by Rodrigo Mesquita at 2023-07-12T09:22:26+01:00 Try to parse the undefined fields - - - - - 1968bdab by Rodrigo Mesquita at 2023-07-12T09:22:26+01:00 Configure Host toolchain with dummy options, hope they aren't used - - - - - 47fffb7f by Rodrigo Mesquita at 2023-07-12T09:22:26+01:00 prettier comment - - - - - 5083190e by Rodrigo Mesquita at 2023-07-12T09:22:26+01:00 Fixes - - - - - f4769f92 by Rodrigo Mesquita at 2023-07-12T09:22:27+01:00 Windows builtin toolchain - - - - - 4e8f54c2 by Rodrigo Mesquita at 2023-07-12T09:22:27+01:00 dont validate ghc-toolchain host - - - - - 60ad3491 by Rodrigo Mesquita at 2023-07-12T09:22:27+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - + TODO - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - configure.ac - + default.host.target.in - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48f6dd226dab48e282c96bb896a3d1f72c9a6cad...60ad3491fc60599afbbb2224145a5adc73c2eddd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48f6dd226dab48e282c96bb896a3d1f72c9a6cad...60ad3491fc60599afbbb2224145a5adc73c2eddd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 08:40:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 04:40:09 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 6 commits: Create ghc_toolchain.m4 Message-ID: <64ae66e98c7f1_3f5efcb31b4117857@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0286cede by Rodrigo Mesquita at 2023-07-12T09:38:36+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain - - - - - c9d6dfb3 by Rodrigo Mesquita at 2023-07-12T09:39:13+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain - - - - - 37ab3b36 by Rodrigo Mesquita at 2023-07-12T09:39:15+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 8a866ee1 by Rodrigo Mesquita at 2023-07-12T09:39:15+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 8a58534a by Rodrigo Mesquita at 2023-07-12T09:39:53+01:00 Use ghc-platform instead of ghc-boot - - - - - bb6627fb by Rodrigo Mesquita at 2023-07-12T09:39:54+01:00 LeftoverS - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60ad3491fc60599afbbb2224145a5adc73c2eddd...bb6627fbd691693966a21ed9923f0891f1966a39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60ad3491fc60599afbbb2224145a5adc73c2eddd...bb6627fbd691693966a21ed9923f0891f1966a39 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 08:54:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 04:54:18 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: ghc-toolchain: Toolchain Selection Message-ID: <64ae6a3af10a5_3f5efc65c9ff8122586@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f93976fc by Rodrigo Mesquita at 2023-07-12T09:52:25+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain leftovers Delete a part - - - - - 48c0a359 by Rodrigo Mesquita at 2023-07-12T09:52:27+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 9eadc87e by Rodrigo Mesquita at 2023-07-12T09:53:11+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - d6d0529c by Rodrigo Mesquita at 2023-07-12T09:53:11+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 2c824a98 by Rodrigo Mesquita at 2023-07-12T09:53:11+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb6627fbd691693966a21ed9923f0891f1966a39...2c824a98ce6ac6b10cc316d2e885567e0f92dc91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb6627fbd691693966a21ed9923f0891f1966a39...2c824a98ce6ac6b10cc316d2e885567e0f92dc91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 08:57:10 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 04:57:10 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] fixup! configure: Create and validate toolchain target file Message-ID: <64ae6ae66126d_3f5efcb36781232f4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 061da9fe by Rodrigo Mesquita at 2023-07-12T09:57:00+01:00 fixup! configure: Create and validate toolchain target file - - - - - 1 changed file: - + default.host.target.in Changes: ===================================== default.host.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtVendor = @HostVendor_CPPMaybeStr@ +, tgtLocallyExecutable = True +, tgtSupportsGnuNonexecStack = False +, tgtSupportsSubsectionsViaSymbols = False +, tgtSupportsIdentDirective = False +, tgtWordSize = WS8 +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = False +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = False +, tgtTablesNextToCode = True +, tgtUseLibffiForAdjustors = True +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CC_OPTS_STAGE0List@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_CXX_OPTS_STAGE0List@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd_STAGE0@", prgFlags = @CONF_CPP_OPTS_STAGE0List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @HaskellCPPArgsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@CC_STAGE0@", prgFlags = @CONF_GCC_LINKER_OPTS_STAGE0List@} +, ccLinkSupportsNoPie = False +, ccLinkSupportsCompactUnwind = False +, ccLinkSupportsFilelist = False +, ccLinkIsGnu = False +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR_STAGE0@", prgFlags = @AR_OPTS_STAGE0List@} +, arIsGnu = False +, arSupportsAtFile = @ArSupportsAtFile_STAGE0Bool@ +, arSupportsDashL = @ArSupportsDashL_STAGE0Bool@ +, arNeedsRanlib = True +} + +, tgtRanlib = Nothing +, tgtNm = Nm {nmProgram = Program {prgPath = "", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@LD_STAGE0@", prgFlags = ["-r"]}, mergeObjsSupportsResponseFiles = False}) +, tgtWindres = Nothing +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/061da9fe8a63054722140b977dceb9d8f66ea3b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/061da9fe8a63054722140b977dceb9d8f66ea3b1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 09:34:15 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 12 Jul 2023 05:34:15 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] Use deb10 for i386 bindists Message-ID: <64ae7397ca6a_3f5efcb368c151247@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: d8f12ee0 by Matthew Pickering at 2023-07-12T10:06:03+01:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: e0874d9716897188a8ba059d2245269ed541bf9d # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false - - job: nightly-i386-linux-deb9-validate + - job: nightly-i386-linux-deb10-validate artifacts: false - job: nightly-x86_64-linux-deb10-validate artifacts: false ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -928,7 +928,7 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -126,7 +126,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -137,7 +137,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -147,14 +147,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -180,11 +180,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -377,7 +377,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -388,7 +388,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -398,14 +398,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -431,11 +431,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2536,7 +2536,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2547,7 +2547,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2557,14 +2557,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2590,13 +2590,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -191,7 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): deb10 = mk(debian("x86_64", 10)) deb11 = mk(debian("x86_64", 11)) deb10_arm64 = mk(debian("aarch64", 10)) - deb9_i386 = mk(debian("i386", 9)) + deb10_i386 = mk(debian("i386", 10)) source = mk_one_metadata(release_mode, version, job_map, source_artifact) test = mk_one_metadata(release_mode, version, job_map, test_artifact) @@ -221,10 +221,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): } - a32 = { "Linux_Debian": { "<10": deb9_i386, "unknown_versioning": deb9_i386 } - , "Linux_Ubuntu": { "unknown_versioning": deb9_i386 } - , "Linux_Mint" : { "unknown_versioning": deb9_i386 } - , "Linux_UnknownLinux" : { "unknown_versioning": deb9_i386 } + a32 = { "Linux_Debian": { "unknown_versioning": deb10_i386 } + , "Linux_Ubuntu": { "unknown_versioning": deb10_i386 } + , "Linux_Mint" : { "unknown_versioning": deb10_i386 } + , "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 } } arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8f12ee0024831eb6cf8442b6f9eb3cc79dbd7fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8f12ee0024831eb6cf8442b6f9eb3cc79dbd7fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 09:44:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 05:44:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Hadrian: enable GHCi support on riscv64 Message-ID: <64ae75f8d7303_3f5efcb318c156919@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - c4264e95 by Josh Meredith at 2023-07-12T05:44:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 531da2bb by Matthew Pickering at 2023-07-12T05:44:13-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 7a61593b by sheaf at 2023-07-12T05:44:16-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - 10 changed files: - .gitlab/ci.sh - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - hadrian/src/Oracles/Setting.hs - rts/js/string.js - testsuite/tests/javascript/js-ffi-string.hs - testsuite/tests/javascript/js-ffi-string.stdout - + testsuite/tests/typecheck/should_fail/T22684.hs - + testsuite/tests/typecheck/should_fail/T22684.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -75,16 +75,6 @@ Environment variables affecting both build systems: (either "x86-64-darwin" or "aarch-darwin") NO_BOOT Whether to run ./boot or not, used when testing the source dist -Environment variables determining build configuration of Make system: - - BUILD_FLAVOUR Which flavour to build. - BUILD_SPHINX_HTML Whether to build Sphinx HTML documentation. - BUILD_SPHINX_PDF Whether to build Sphinx PDF documentation. - INTEGER_LIBRARY Which integer library to use (integer-simple or integer-gmp). - HADDOCK_HYPERLINKED_SOURCES - Whether to build hyperlinked Haddock sources. - TEST_TYPE Which test rule to run. - Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. @@ -390,26 +380,6 @@ function cleanup_submodules() { end_section "clean submodules" } -function prepare_build_mk() { - if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi - if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi - if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi - - cat > mk/build.mk <> mk/build.mk - fi - - - info "build.mk is:" - cat mk/build.mk -} - function configure() { case "${CONFIGURE_WRAPPER:-}" in emconfigure) source "$EMSDK/emsdk_env.sh" ;; ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1563,16 +1563,19 @@ validHoleFits :: SolverReportErrCtxt -- ^ The context we're in, i.e. the -- the valid hole fits. validHoleFits ctxt@(CEC { cec_encl = implics , cec_tidy = lcl_env}) simps hole - = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (map mk_wanted simps) hole + = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (mapMaybe mk_wanted simps) hole ; return (ctxt {cec_tidy = tidy_env}, fits) } where - mk_wanted :: ErrorItem -> CtEvidence - mk_wanted (EI { ei_pred = pred, ei_evdest = Just dest, ei_loc = loc }) - = CtWanted { ctev_pred = pred - , ctev_dest = dest - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet } - mk_wanted item = pprPanic "validHoleFits no evdest" (ppr item) + mk_wanted :: ErrorItem -> Maybe CtEvidence + mk_wanted (EI { ei_pred = pred, ei_evdest = m_dest, ei_loc = loc }) + | Just dest <- m_dest + = Just (CtWanted { ctev_pred = pred + , ctev_dest = dest + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet }) + | otherwise + = Nothing -- The ErrorItem was a Given + -- See Note [Constraints include ...] givenConstraints :: SolverReportErrCtxt -> [(Type, RealSrcSpan)] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4867,7 +4867,9 @@ data ErrorItem = EI { ei_pred :: PredType -- report about this -- The ei_pred field will never be an unboxed equality with -- a (casted) tyvar on the right; this is guaranteed by the solver - , ei_evdest :: Maybe TcEvDest -- for Wanteds, where to put evidence + , ei_evdest :: Maybe TcEvDest + -- ^ for Wanteds, where to put the evidence + -- for Givens, Nothing , ei_flavour :: CtFlavour , ei_loc :: CtLoc , ei_m_reason :: Maybe CtIrredReason -- if this ErrorItem was made from a ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -302,7 +302,8 @@ ghcWithInterpreter = do , "darwin", "kfreebsdgnu" ] goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc" , "arm", "aarch64", "s390x" - , "powerpc64", "powerpc64le" ] + , "powerpc64", "powerpc64le" + , "riscv64" ] return $ goodOs && goodArch -- | Variants of the ARM architecture. ===================================== rts/js/string.js ===================================== @@ -628,7 +628,7 @@ function h$fromHsString(str) { var xs = ''; while(IS_CONS(str)) { var h = CONS_HEAD(str); - xs += String.fromCharCode(UNWRAP_NUMBER(h)); + xs += String.fromCodePoint(UNWRAP_NUMBER(h)); str = CONS_TAIL(str); } return xs; ===================================== testsuite/tests/javascript/js-ffi-string.hs ===================================== @@ -1,13 +1,49 @@ import GHC.JS.Prim +import System.IO foreign import javascript "((x) => { console.log(x); })" log_js_string :: JSVal -> IO () -foreign import javascript "(() => { return 'a string'; })" - a_string :: JSVal +foreign import javascript "((x, y) => { return x === y; })" + eq_JSVal :: JSVal -> JSVal -> Bool + +foreign import javascript "(() => { return 'abc\\uD83D\\uDE0A'; })" + js_utf16_string :: JSVal +foreign import javascript "(() => { return 'abc' + String.fromCodePoint(128522); })" + js_codepoint_string :: JSVal + +-- It's important that this String is defined using a function to avoid rewrite +-- rules optimising away the use of `toJSString` called on a literal. +hsString :: String +hsString = "abc" ++ "\128522" main :: IO () main = do - log_js_string (toJSString "test") - putStrLn (fromJSString a_string) - putStrLn (fromJSString $ toJSString "test") + putStrLn "Does JS `String.fromCodePoint` decode to the expected UTF-16 values? " + print (eq_JSVal js_utf16_string js_codepoint_string) + hFlush stdout + log_js_string js_utf16_string + log_js_string js_codepoint_string + + putStrLn "\nDoes `GHC.JS.fromJSString` convert the JavaScript literal string correctly? " + print (hsString == fromJSString js_utf16_string) + putStrLn hsString + putStrLn (fromJSString js_utf16_string) + + putStrLn "\nDoes `GHC.JS.toJSString` convert the Haskell-defined string correctly? " + print (eq_JSVal js_utf16_string (toJSString hsString)) + hFlush stdout + log_js_string js_utf16_string + log_js_string (toJSString hsString) + + putStrLn "\nDo values survive the Haskell -> JavaScript -> Haskell round-trip? " + print (hsString == fromJSString (toJSString hsString)) + putStrLn hsString + putStrLn (fromJSString js_utf16_string) + + putStrLn "\nDo values survive the JavaScript -> Haskell -> JavaScript round-trip? " + print (eq_JSVal js_utf16_string (toJSString $ fromJSString js_utf16_string)) + hFlush stdout + log_js_string js_utf16_string + log_js_string (toJSString $ fromJSString js_utf16_string) + ===================================== testsuite/tests/javascript/js-ffi-string.stdout ===================================== @@ -1,3 +1,25 @@ -test -a string -test +Does JS `String.fromCodePoint` decode to the expected UTF-16 values? +True +abc😊 +abc😊 + +Does `GHC.JS.fromJSString` convert the JavaScript literal string correctly? +True +abc😊 +abc😊 + +Does `GHC.JS.toJSString` convert the Haskell-defined string correctly? +True +abc😊 +abc😊 + +Do values survive the Haskell -> JavaScript -> Haskell round-trip? +True +abc😊 +abc😊 + +Do values survive the JavaScript -> Haskell -> JavaScript round-trip? +True +abc😊 +abc😊 + ===================================== testsuite/tests/typecheck/should_fail/T22684.hs ===================================== @@ -0,0 +1,19 @@ +module T22684 where + +-- Example 1 from #22684 +p :: (Int ~ Bool => r) -> r +p _ = undefined + +q :: r +q = p _ + +-- Example 3 from #22684 +class Category k where + (.) :: k b c -> k a b -> k a c + +data Free p a b where + Prod :: Free p a (b, c) + Sum :: Free p (Either a b) c + +instance Category (Free p) where + Sum . Prod = _ ===================================== testsuite/tests/typecheck/should_fail/T22684.stderr ===================================== @@ -0,0 +1,35 @@ + +T22684.hs:8:7: error: [GHC-88464] + • Found hole: _ :: r + Where: ‘r’ is a rigid type variable bound by + the type signature for: + q :: forall r. r + at T22684.hs:7:1-6 + • In the first argument of ‘p’, namely ‘_’ + In the expression: p _ + In an equation for ‘q’: q = p _ + • Relevant bindings include q :: r (bound at T22684.hs:8:1) + Constraints include Int ~ Bool (from T22684.hs:8:7) + Valid hole fits include q :: r (bound at T22684.hs:8:1) + +T22684.hs:19:16: error: [GHC-88464] + • Found hole: _ :: Free p a c + Where: ‘k’, ‘p’ are rigid type variables bound by + the instance declaration + at T22684.hs:18:10-26 + ‘a’, ‘c’ are rigid type variables bound by + the type signature for: + (T22684..) :: forall b c a. Free p b c -> Free p a b -> Free p a c + at T22684.hs:19:7 + • In an equation for ‘T22684..’: Sum T22684.. Prod = _ + In the instance declaration for ‘Category (Free p)’ + • Relevant bindings include + (.) :: Free p b c -> Free p a b -> Free p a c + (bound at T22684.hs:19:7) + Constraints include + b ~ (b2, c1) (from T22684.hs:19:9-12) + b ~ Either a1 b1 (from T22684.hs:19:3-5) + Valid hole fits include + q :: forall r. r + with q @(Free p a c) + (bound at T22684.hs:8:1) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -696,4 +696,5 @@ test('VisFlag2', normal, compile_fail, ['']) test('VisFlag3', normal, compile_fail, ['']) test('VisFlag4', normal, compile_fail, ['']) test('VisFlag5', normal, compile_fail, ['']) +test('T22684', normal, compile_fail, ['']) test('T23514a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f897f6908cc970f35fbbdf101bfc57bd55ab9248...7a61593be51d23938fcdbd702ad5aab1a4cd2107 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f897f6908cc970f35fbbdf101bfc57bd55ab9248...7a61593be51d23938fcdbd702ad5aab1a4cd2107 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 09:47:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 12 Jul 2023 05:47:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/revert-js-ci Message-ID: <64ae76bc367a3_3f5efcb368c165856@gitlab.mail> Matthew Pickering pushed new branch wip/revert-js-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/revert-js-ci You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 10:46:33 2023 From: gitlab at gitlab.haskell.org (Sasha Bogicevic (@Bogicevic)) Date: Wed, 12 Jul 2023 06:46:33 -0400 Subject: [Git][ghc/ghc][wip/21101] 1749 commits: Fix isEvaldUnfolding and isValueUnfolding Message-ID: <64ae848935a77_3f5efcb31c8177520@gitlab.mail> Sasha Bogicevic pushed to branch wip/21101 at Glasgow Haskell Compiler / GHC Commits: 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 51ffd009 by Swann Moreau at 2022-08-19T18:29:21-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-04:00 hadrian: Don't duplicate binaries on installation Previously we used `install` on symbolic links, which ended up copying the target file rather than installing a symbolic link. Fixes #22062. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. * And finally, it was the strange treatment of join-point Ids in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 15111af6 by Zubin Duggal at 2022-09-01T01:18:50-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 7d3a055d by Krzysztof Gogolewski at 2022-09-01T01:19:26-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 31a8989a by Tommy Bidne at 2022-09-01T12:01:20-04:00 Change Ord defaults per CLC proposal Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/24#issuecomment-1233331267 - - - - - 7f527f01 by Matthew Pickering at 2022-09-01T12:01:56-04:00 Fix bootstrap with ghc-9.0 It turns out Solo is a very recent addition to base, so for older GHC versions we just defined it inline here the one place we use it in the compiler. - - - - - d2be80fd by Sebastian Graf at 2022-09-05T23:12:14-04:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 25f68ace by Ben Gamari at 2022-09-05T23:12:50-04:00 gitlab-ci: Ensure that ghc derivation is in scope Previously the lint-ci job attempted to use cabal-install (specifically `cabal update`) without a GHC in PATH. However, cabal-install-3.8 appears to want GHC, even for `cabal update`. - - - - - f37b621f by sheaf at 2022-09-06T11:51:53+00:00 Update instances.rst, clarifying InstanceSigs Fixes #22103 - - - - - d4f908f7 by Jan Hrček at 2022-09-06T15:36:58-04:00 Fix :add docs in user guide - - - - - 808bb793 by Cheng Shao at 2022-09-06T15:37:35-04:00 ci: remove unused build_make/test_make in ci script - - - - - d0a2efb2 by Eric Lindblad at 2022-09-07T16:42:45-04:00 typo - - - - - fac0098b by Eric Lindblad at 2022-09-07T16:42:45-04:00 typos - - - - - a581186f by Eric Lindblad at 2022-09-07T16:42:45-04:00 whitespace - - - - - 04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00 CmmToAsm: remove unused ModLocation from NatM_State - - - - - ee1cfaa9 by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Minor SDoc cleanup Change calls to renderWithContext with showSDocOneLine; it's more efficient and explanatory. Remove polyPatSig (unused) - - - - - 7918265d by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Remove Outputable Char instance Use 'text' instead of 'ppr'. Using 'ppr' on the list "hello" rendered as "h,e,l,l,o". - - - - - 77209ab3 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Export liftA2 from Prelude Changes: In order to be warning free and compatible, we hide Applicative(..) from Prelude in a few places and instead import it directly from Control.Applicative. Please see the migration guide at https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md for more details. This means that Applicative is now exported in its entirety from Prelude. Motivation: This change is motivated by a few things: * liftA2 is an often used function, even more so than (<*>) for some people. * When implementing Applicative, the compiler will prompt you for either an implementation of (<*>) or of liftA2, but trying to use the latter ends with an error, without further imports. This could be confusing for newbies. * For teaching, it is often times easier to introduce liftA2 first, as it is a natural generalisation of fmap. * This change seems to have been unanimously and enthusiastically accepted by the CLC members, possibly indicating a lot of love for it. * This change causes very limited breakage, see the linked issue below for an investigation on this. See https://github.com/haskell/core-libraries-committee/issues/50 for the surrounding discussion and more details. - - - - - 442a94e8 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Add changelog entry for liftA2 export from Prelude - - - - - fb968680 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule containers to one with liftA2 warnings fixed - - - - - f54ff818 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule Cabal to one with liftA2 warnings fixed - - - - - a4b34808 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Isolate some Applicative hidings to GHC.Prelude By reexporting the entirety of Applicative from GHC.Prelude, we can save ourselves some `hiding` and importing of `Applicative` in consumers of GHC.Prelude. This also has the benefit of isolating this type of change to GHC.Prelude, so that people in the future don't have to think about it. - - - - - 9c4ea90c by Cheng Shao at 2022-09-08T17:49:47-04:00 CmmToC: enable 64-bit CallishMachOp on 32-bit targets Normally, the unregisterised builds avoid generating 64-bit CallishMachOp in StgToCmm, so CmmToC doesn't support these. However, there do exist cases where we'd like to invoke cmmToC for other cmm inputs which may contain such CallishMachOps, and it's a rather low effort to add support for these since they only require calling into existing ghc-prim cbits. - - - - - 04062510 by Alexis King at 2022-09-11T11:30:32+02:00 Add native delimited continuations to the RTS This patch implements GHC proposal 313, "Delimited continuation primops", by adding native support for delimited continuations to the GHC RTS. All things considered, the patch is relatively small. It almost exclusively consists of changes to the RTS; the compiler itself is essentially unaffected. The primops come with fairly extensive Haddock documentation, and an overview of the implementation strategy is given in the Notes in rts/Continuation.c. This first stab at the implementation prioritizes simplicity over performance. Most notably, every continuation is always stored as a single, contiguous chunk of stack. If one of these chunks is particularly large, it can result in poor performance, as the current implementation does not attempt to cleverly squeeze a subset of the stack frames into the existing stack: it must fit all at once. If this proves to be a performance issue in practice, a cleverer strategy would be a worthwhile target for future improvements. - - - - - ee471dfb by Cheng Shao at 2022-09-12T07:07:33-04:00 rts: fix missing dirty_MVAR argument in stg_writeIOPortzh - - - - - a5f9c35f by Cheng Shao at 2022-09-12T13:29:05-04:00 ci: enable parallel compression for xz - - - - - 3a815f30 by Ryan Scott at 2022-09-12T13:29:41-04:00 Windows: Always define _UCRT when compiling C code As seen in #22159, this is required to ensure correct behavior when MinGW-w64 headers are in the `C_INCLUDE_PATH`. Fixes #22159. - - - - - 65a0bd69 by sheaf at 2022-09-13T10:27:52-04:00 Add diagnostic codes This MR adds diagnostic codes, assigning unique numeric codes to error and warnings, e.g. error: [GHC-53633] Pattern match is redundant This is achieved as follows: - a type family GhcDiagnosticCode that gives the diagnostic code for each diagnostic constructor, - a type family ConRecursInto that specifies whether to recur into an argument of the constructor to obtain a more fine-grained code (e.g. different error codes for different 'deriving' errors), - generics machinery to generate the value-level function assigning each diagnostic its error code; see Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. The upshot is that, to add a new diagnostic code, contributors only need to modify the two type families mentioned above. All logic relating to diagnostic codes is thus contained to the GHC.Types.Error.Codes module, with no code duplication. This MR also refactors error message datatypes a bit, ensuring we can derive Generic for them, and cleans up the logic around constraint solver reports by splitting up 'TcSolverReportInfo' into separate datatypes (see #20772). Fixes #21684 - - - - - 362cca13 by sheaf at 2022-09-13T10:27:53-04:00 Diagnostic codes: acccept test changes The testsuite output now contains diagnostic codes, so many tests need to be updated at once. We decided it was best to keep the diagnostic codes in the testsuite output, so that contributors don't inadvertently make changes to the diagnostic codes. - - - - - 08f6730c by Adam Gundry at 2022-09-13T10:28:29-04:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - c14370d7 by Cheng Shao at 2022-09-13T10:29:07-04:00 ci: remove unused appveyor config - - - - - dc6af9ed by Cheng Shao at 2022-09-13T10:29:45-04:00 compiler: remove unused lazy state monad - - - - - 646d15ad by Eric Lindblad at 2022-09-14T03:13:56-04:00 Fix typos This fixes various typos and spelling mistakes in the compiler. Fixes #21891 - - - - - 7d7e71b0 by Matthew Pickering at 2022-09-14T03:14:32-04:00 hadrian: Bump index state This bumps the index state so a build plan can also be found when booting with 9.4. Fixes #22165 - - - - - 98b62871 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - b42cedbe by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6515c32b by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - e470e91f by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - c4438347 by Matthew Pickering at 2022-09-14T17:17:04-04:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 71d8db86 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add extra implicit dependencies from DeriveLift ghc -M should know that modules which use DeriveLift (or TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have to add these extra edges manually or the modules will be compiled before TH.Lib.Internal is compiled which leads to a desugarer error. - - - - - 43e574f0 by Greg Steuck at 2022-09-14T17:17:43-04:00 Repair c++ probing on OpenBSD Failure without this change: ``` checking C++ standard library flavour... libc++ checking for linkage against 'c++ c++abi'... failed checking for linkage against 'c++ cxxrt'... failed configure: error: Failed to find C++ standard library ``` - - - - - 534b39ee by Douglas Wilson at 2022-09-14T17:18:21-04:00 libraries: template-haskell: vendor filepath differently Vendoring with ../ in hs-source-dirs prevents upload to hackage. (cherry picked from commit 1446be7586ba70f9136496f9b67f792955447842) - - - - - bdd61cd6 by M Farkas-Dyck at 2022-09-14T22:39:34-04:00 Unbreak Hadrian with Cabal 3.8. - - - - - df04d6ec by Krzysztof Gogolewski at 2022-09-14T22:40:09-04:00 Fix typos - - - - - d6ea8356 by Andreas Klebinger at 2022-09-15T10:12:41+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 7cce7007 by Andreas Klebinger at 2022-09-15T10:12:42+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 88c4cbdb by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: enable -fprof-late only for profiling ways - - - - - d7235831 by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: add late_ccs flavour transformer - - - - - ce203753 by Cheng Shao at 2022-09-16T13:58:34-04:00 configure: remove unused program checks - - - - - 9b4c1056 by Pierre Le Marre at 2022-09-16T13:59:16-04:00 Update to Unicode 15.0 - - - - - c6e9b89a by Bodigrim at 2022-09-16T13:59:55-04:00 Avoid partial head and tail in ghc-heap; replace with total pattern-matching - - - - - 616afde3 by Cheng Shao at 2022-09-16T14:00:33-04:00 hadrian: relax Cabal upper bound to allow building with Cabal-3.8 A follow up of !8910. - - - - - df35d994 by Alexis King at 2022-09-16T14:01:11-04:00 Add links to the continuations haddocks in the docs for each primop fixes #22176 - - - - - 383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 5031bf49 by sheaf at 2022-09-16T21:42:49-04:00 Hadrian: Don't try to build terminfo on Windows Commit b42cedbe introduced a dependency on terminfo on Windows, but that package isn't available on Windows. - - - - - c9afe221 by M Farkas-Dyck at 2022-09-17T06:44:47-04:00 Clean up some. In particular: • Delete some dead code, largely under `GHC.Utils`. • Clean up a few definitions in `GHC.Utils.(Misc, Monad)`. • Clean up `GHC.Types.SrcLoc`. • Derive stock `Functor, Foldable, Traversable` for more types. • Derive more instances for newtypes. Bump haddock submodule. - - - - - 85431ac3 by Cheng Shao at 2022-09-17T06:45:25-04:00 driver: pass original Cmm filename in ModLocation When compiling Cmm, the ml_hs_file field is used to indicate Cmm filename when later generating DWARF information. We should pass the original filename here, otherwise for preprocessed Cmm files, the filename will be a temporary filename which is confusing. - - - - - 63aa0069 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: remove legacy logging cabal flag - - - - - bd0f4184 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: make threaded ways optional For certain targets (e.g. wasm32-wasi), the threaded rts is known not to work. This patch adds a "threaded" cabal flag to rts to make threaded rts ways optional. Hadrian enables this flag iff the flavour rtsWays contains threaded ways. - - - - - 8a666ad2 by Ryan Scott at 2022-09-18T08:00:44-04:00 DeriveFunctor: Check for last type variables using dataConUnivTyVars Previously, derived instances of `Functor` (as well as the related classes `Foldable`, `Traversable`, and `Generic1`) would determine which constraints to infer by checking for fields that contain the last type variable. The problem was that this last type variable was taken from `tyConTyVars`. For GADTs, the type variables in each data constructor are _not_ the same type variables as in `tyConTyVars`, leading to #22167. This fixes the issue by instead checking for the last type variable using `dataConUnivTyVars`. (This is very similar in spirit to the fix for #21185, which also replaced an errant use of `tyConTyVars` with type variables from each data constructor.) Fixes #22167. - - - - - 78037167 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: pass updated buffer to actions (#22201) In the lexer, predicates have the following type: { ... } :: user -- predicate state -> AlexInput -- input stream before the token -> Int -- length of the token -> AlexInput -- input stream after the token -> Bool -- True <=> accept the token This is documented in the Alex manual. There is access to the input stream both before and after the token. But when the time comes to construct the token, GHC passes only the initial string buffer to the lexer action. This patch fixes it: - type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token) + type Action = PsSpan -> StringBuffer -> Int -> StringBuffer -> P (PsLocated Token) Now lexer actions have access to the string buffer both before and after the token, just like the predicates. It's just a matter of passing an additional function parameter throughout the lexer. - - - - - 75746594 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: define varsym without predicates (#22201) Before this patch, the varsym lexing rules were defined as follows: <0> { @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix } @varsym / { followedByOpeningToken } { varsym_prefix } @varsym / { precededByClosingToken } { varsym_suffix } @varsym { varsym_loose_infix } } Unfortunately, this meant that the predicates 'precededByClosingToken' and 'followedByOpeningToken' were recomputed several times before we could figure out the whitespace context. With this patch, we check for whitespace context directly in the lexer action: <0> { @varsym { with_op_ws varsym } } The checking for opening/closing tokens happens in 'with_op_ws' now, which is part of the lexer action rather than the lexer predicate. - - - - - c1f81b38 by M Farkas-Dyck at 2022-09-19T09:07:05-04:00 Scrub partiality about `NewOrData`. Rather than a list of constructors and a `NewOrData` flag, we define `data DataDefnCons a = NewTypeCon a | DataTypeCons [a]`, which enforces a newtype to have exactly one constructor. Closes #22070. Bump haddock submodule. - - - - - 1e1ed8c5 by Cheng Shao at 2022-09-19T09:07:43-04:00 CmmToC: emit __builtin_unreachable() after noreturn ccalls Emit a __builtin_unreachable() call after a foreign call marked as CmmNeverReturns. This is crucial to generate correctly typed code for wasm; as for other archs, this is also beneficial for the C compiler optimizations. - - - - - 19f45a25 by Jan Hrček at 2022-09-20T03:49:29-04:00 Document :unadd GHCi command in user guide - - - - - 545ff490 by sheaf at 2022-09-20T03:50:06-04:00 Hadrian: merge archives even in stage 0 We now always merge .a archives when ar supports -L. This change is necessary in order to bootstrap GHC using GHC 9.4 on Windows, as nested archives aren't supported. Not doing so triggered bug #21990 when trying to use the Win32 package, with errors such as: Not a x86_64 PE+ file. Unknown COFF 4 type in getHeaderInfo. ld.lld: error: undefined symbol: Win32zm2zi12zi0zi0_SystemziWin32ziConsoleziCtrlHandler_withConsoleCtrlHandler1_info We have to be careful about which ar is meant: in stage 0, the check should be done on the system ar (system-ar in system.config). - - - - - 59fe128c by Vladislav Zavialov at 2022-09-20T03:50:42-04:00 Fix -Woperator-whitespace for consym (part of #19372) Due to an oversight, the initial specification and implementation of -Woperator-whitespace focused on varsym exclusively and completely ignored consym. This meant that expressions such as "x+ y" would produce a warning, while "x:+ y" would not. The specification was corrected in ghc-proposals pull request #404, and this patch updates the implementation accordingly. Regression test included. - - - - - c4c2cca0 by John Ericson at 2022-09-20T13:11:49-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 7beb356e by John Ericson at 2022-09-20T13:11:50-04:00 Relax instances for Functor combinators; put superclass on Class1 and Class2 to make non-breaking This change is approved by the Core Libraries commitee in https://github.com/haskell/core-libraries-committee/issues/10 The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 6a8c6b5e by Tom Ellis at 2022-09-20T13:12:27-04:00 Add notes to ghc-prim Haddocks that users should not import it - - - - - ee9d0f5c by matoro at 2022-09-20T13:13:06-04:00 docs: clarify that LLVM codegen is not available in unregisterised mode The current docs are misleading and suggest that it is possible to use LLVM codegen from an unregisterised build. This is not the case; attempting to pass `-fllvm` to an unregisterised build warns: ``` when making flags consistent: warning: Target platform uses unregisterised ABI, so compiling via C ``` and uses the C codegen anyway. - - - - - 854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00 rts: remove copy-paste error from `cabal.rts.in` This was, likely accidentally, introduced in 4bf542bf1c. See: 4bf542bf1cdf2fa468457fc0af21333478293476 - - - - - c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00 hadrian: Add extra_dependencies edges for all different ways The hack to add extra dependencies needed by DeriveLift extension missed the cases for profiles and dynamic ways. For the profiled way this leads to errors like: ``` GHC error in desugarer lookup in Data.IntSet.Internal: Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’ Perhaps you haven't installed the profiling libraries for package ‘template-haskell’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. ghc: panic! (the 'impossible' happened) GHC version 9.5.20220916: initDs ``` Therefore the fix is to add these extra edges in. Fixes #22197 - - - - - a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00 users-guide: fix incorrect ghcappdata folder for unix and windows - - - - - 06ccad0d by sheaf at 2022-09-21T08:28:49-04:00 Don't use isUnliftedType in isTagged The function GHC.Stg.InferTags.Rewrite.isTagged can be given the Id of a join point, which might be representation polymorphic. This would cause the call to isUnliftedType to crash. It's better to use typeLevity_maybe instead. Fixes #22212 - - - - - c0ba775d by Teo Camarasu at 2022-09-21T14:30:37-04:00 Add fragmentation statistic to GHC.Stats Implements #21537 - - - - - 2463df2f by Torsten Schmits at 2022-09-21T14:31:24-04:00 Rename Solo[constructor] to MkSolo Part of proposal 475 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst) Moves all tuples to GHC.Tuple.Prim Updates ghc-prim version (and bumps bounds in dependents) updates haddock submodule updates deepseq submodule updates text submodule - - - - - 9034fada by Matthew Pickering at 2022-09-22T09:25:29-04:00 Update filepath to filepath-1.4.100.0 Updates submodule * Always rely on vendored filepath * filepath must be built as stage0 dependency because it uses template-haskell. Towards #22098 - - - - - 615e2278 by Krzysztof Gogolewski at 2022-09-22T09:26:05-04:00 Minor refactor around Outputable * Replace 'text . show' and 'ppr' with 'int'. * Remove Outputable.hs-boot, no longer needed * Use pprWithCommas * Factor out instructions in AArch64 codegen - - - - - aeafdba5 by Sebastian Graf at 2022-09-27T15:14:54+02:00 Demand: Clear distinction between Call SubDmd and eval Dmd (#21717) In #21717 we saw a reportedly unsound strictness signature due to an unsound definition of plusSubDmd on Calls. This patch contains a description and the fix to the unsoundness as outlined in `Note [Call SubDemand vs. evaluation Demand]`. This fix means we also get rid of the special handling of `-fpedantic-bottoms` in eta-reduction. Thanks to less strict and actually sound strictness results, we will no longer eta-reduce the problematic cases in the first place, even without `-fpedantic-bottoms`. So fixing the unsoundness also makes our eta-reduction code simpler with less hacks to explain. But there is another, more unfortunate side-effect: We *unfix* #21085, but fortunately we have a new fix ready: See `Note [mkCall and plusSubDmd]`. There's another change: I decided to make `Note [SubDemand denotes at least one evaluation]` a lot simpler by using `plusSubDmd` (instead of `lubPlusSubDmd`) even if both argument demands are lazy. That leads to less precise results, but in turn rids ourselves from the need for 4 different `OpMode`s and the complication of `Note [Manual specialisation of lub*Dmd/plus*Dmd]`. The result is simpler code that is in line with the paper draft on Demand Analysis. I left the abandoned idea in `Note [Unrealised opportunity in plusDmd]` for posterity. The fallout in terms of regressions is negligible, as the testsuite and NoFib shows. ``` Program Allocs Instrs -------------------------------------------------------------------------------- hidden +0.2% -0.2% linear -0.0% -0.7% -------------------------------------------------------------------------------- Min -0.0% -0.7% Max +0.2% +0.0% Geometric Mean +0.0% -0.0% ``` Fixes #21717. - - - - - 9b1595c8 by Ross Paterson at 2022-09-27T14:12:01-04:00 implement proposal 106 (Define Kinds Without Promotion) (fixes #6024) includes corresponding changes to haddock submodule - - - - - c2d73cb4 by Andreas Klebinger at 2022-09-28T15:07:30-04:00 Apply some tricks to speed up core lint. Below are the noteworthy changes and if given their impact on compiler allocations for a type heavy module: * Use the oneShot trick on LintM * Use a unboxed tuple for the result of LintM: ~6% reduction * Avoid a thunk for the result of typeKind in lintType: ~5% reduction * lint_app: Don't allocate the error msg in the hot code path: ~4% reduction * lint_app: Eagerly force the in scope set: ~4% * nonDetCmpType: Try to short cut using reallyUnsafePtrEquality#: ~2% * lintM: Use a unboxed maybe for the `a` result: ~12% * lint_app: make go_app tail recursive to avoid allocating the go function as heap closure: ~7% * expandSynTyCon_maybe: Use a specialized data type For a less type heavy module like nofib/spectral/simple compiled with -O -dcore-lint allocations went down by ~24% and compile time by ~9%. ------------------------- Metric Decrease: T1969 ------------------------- - - - - - b74b6191 by sheaf at 2022-09-28T15:08:10-04:00 matchLocalInst: do domination analysis When multiple Given quantified constraints match a Wanted, and there is a quantified constraint that dominates all others, we now pick it to solve the Wanted. See Note [Use only the best matching quantified constraint]. For example: [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b [G] d2: forall a . C a Int => D a Int [W] {w}: D a Int When solving the Wanted, we find that both Givens match, but we pick the second, because it has a weaker precondition, C a Int, compared to (Eq a, Num Int, C a Int). We thus say that d2 dominates d1; see Note [When does a quantified instance dominate another?]. This domination test is done purely in terms of superclass expansion, in the function GHC.Tc.Solver.Interact.impliedBySCs. We don't attempt to do a full round of constraint solving; this simple check suffices for now. Fixes #22216 and #22223 - - - - - 2a53ac18 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that module * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times. This is compiler/perf, showing only changes over 1%: Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -50.2% GOOD ManyConstructors(normal) +1.0% MultiLayerModulesTH_OneShot(normal) +2.6% PmSeriesG(normal) -1.1% T10547(normal) -1.2% T11195(normal) -1.2% T11276(normal) -1.0% T11303b(normal) -1.6% T11545(normal) -1.4% T11822(normal) -1.3% T12150(optasm) -1.0% T12234(optasm) -1.2% T13056(optasm) -9.3% GOOD T13253(normal) -3.8% GOOD T15164(normal) -3.6% GOOD T16190(normal) -2.1% T16577(normal) -2.8% GOOD T16875(normal) -1.6% T17836(normal) +2.2% T17977b(normal) -1.0% T18223(normal) -33.3% GOOD T18282(normal) -3.4% GOOD T18304(normal) -1.4% T18698a(normal) -1.4% GOOD T18698b(normal) -1.3% GOOD T19695(normal) -2.5% GOOD T5837(normal) -2.3% T9630(normal) -33.0% GOOD WWRec(normal) -9.7% GOOD hard_hole_fits(normal) -2.1% GOOD hie002(normal) +1.6% geo. mean -2.2% minimum -50.2% maximum +2.6% I diligently investigated some of the big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlessly specialising wrappers LargeRecord, T9630 For runtimes, here is perf/should+_run: Metrics: runtime/bytes allocated -------------------------------- T12990(normal) -3.8% T5205(normal) -1.3% T9203(normal) -10.7% GOOD haddock.Cabal(normal) +0.1% haddock.base(normal) -1.1% haddock.compiler(normal) -0.3% lazy-bs-alloc(normal) -0.2% ------------------------------------------ geo. mean -0.3% minimum -10.7% maximum +0.1% I did not investigate exactly what happens in T9203. Nofib is a wash: +-------------------------------++--+-----------+-----------+ | || | tsv (rel) | std. err. | +===============================++==+===========+===========+ | real/anna || | -0.13% | 0.0% | | real/fem || | +0.13% | 0.0% | | real/fulsom || | -0.16% | 0.0% | | real/lift || | -1.55% | 0.0% | | real/reptile || | -0.11% | 0.0% | | real/smallpt || | +0.51% | 0.0% | | spectral/constraints || | +0.20% | 0.0% | | spectral/dom-lt || | +1.80% | 0.0% | | spectral/expert || | +0.33% | 0.0% | +===============================++==+===========+===========+ | geom mean || | | | +-------------------------------++--+-----------+-----------+ I spent quite some time investigating dom-lt, but it's pretty complicated. See my note on !7847. Conclusion: it's just a delicate inlining interaction, and we have plenty of those. Metric Decrease: LargeRecord T13056 T13253 T15164 T16577 T18223 T18282 T18698a T18698b T19695 T9630 WWRec hard_hole_fits T9203 - - - - - addeefc0 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Refactor UnfoldingSource and IfaceUnfolding I finally got tired of the way that IfaceUnfolding reflected a previous structure of unfoldings, not the current one. This MR refactors UnfoldingSource and IfaceUnfolding to be simpler and more consistent. It's largely just a refactor, but in UnfoldingSource (which moves to GHC.Types.Basic, since it is now used in IfaceSyn too), I distinguish between /user-specified/ and /system-generated/ stable unfoldings. data UnfoldingSource = VanillaSrc | StableUserSrc -- From a user-specified pragma | StableSystemSrc -- From a system-generated unfolding | CompulsorySrc This has a minor effect in CSE (see the use of isisStableUserUnfolding in GHC.Core.Opt.CSE), which I tripped over when working on specialisation, but it seems like a Good Thing to know anyway. - - - - - 7be6f9a4 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 INLINE/INLINEABLE pragmas in Foreign.Marshal.Array Foreign.Marshal.Array contains many small functions, all of which are overloaded, and which are critical for performance. Yet none of them had pragmas, so it was a fluke whether or not they got inlined. This patch makes them all either INLINE (small ones) or INLINEABLE and hence specialisable (larger ones). See Note [Specialising array operations] in that module. - - - - - b0c89dfa by Jade Lovelace at 2022-09-28T17:49:49-04:00 Export OnOff from GHC.Driver.Session I was working on fixing an issue where HLS was trying to pass its DynFlags to HLint, but didn't pass any of the disabled language extensions, which HLint would then assume are on because of their default values. Currently it's not possible to get any of the "No" flags because the `DynFlags.extensions` field can't really be used since it is [OnOff Extension] and OnOff is not exported. So let's export it. - - - - - 2f050687 by Bodigrim at 2022-09-28T17:50:28-04:00 Avoid Data.List.group; prefer Data.List.NonEmpty.group This allows to avoid further partiality, e. g., map head . group is replaced by map NE.head . NE.group, and there are less panic calls. - - - - - bc0020fa by M Farkas-Dyck at 2022-09-28T22:51:59-04:00 Clean up `findWiredInUnit`. In particular, avoid `head`. - - - - - 6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00 Eliminate headFS, use unconsFS instead A small step towards #22185 to avoid partial functions + safe implementation of `startsWithUnderscore`. - - - - - 5a535172 by Sebastian Graf at 2022-09-29T17:04:20+02:00 Demand: Format Call SubDemands `Cn(sd)` as `C(n,sd)` (#22231) Justification in #22231. Short form: In a demand like `1C1(C1(L))` it was too easy to confuse which `1` belongs to which `C`. Now that should be more obvious. Fixes #22231 - - - - - ea0083bf by Bryan Richter at 2022-09-29T15:48:38-04:00 Revert "ci: enable parallel compression for xz" Combined wxth XZ_OPT=9, this blew the memory capacity of CI runners. This reverts commit a5f9c35f5831ef5108e87813a96eac62803852ab. - - - - - f5e8f493 by Sebastian Graf at 2022-09-30T18:42:13+02:00 Boxity: Don't update Boxity unless worker/wrapper follows (#21754) A small refactoring in our Core Opt pipeline and some new functions for transfering argument boxities from one signature to another to facilitate `Note [Don't change boxity without worker/wrapper]`. Fixes #21754. - - - - - 4baf7b1c by M Farkas-Dyck at 2022-09-30T17:45:47-04:00 Scrub various partiality involving empty lists. Avoids some uses of `head` and `tail`, and some panics when an argument is null. - - - - - 95ead839 by Alexis King at 2022-10-01T00:37:43-04:00 Fix a bug in continuation capture across multiple stack chunks - - - - - 22096652 by Bodigrim at 2022-10-01T00:38:22-04:00 Enforce internal invariant of OrdList and fix bugs in viewCons / viewSnoc `viewCons` used to ignore `Many` constructor completely, returning `VNothing`. `viewSnoc` violated internal invariant of `Many` being a non-empty list. - - - - - 48ab9ca5 by Nicolas Trangez at 2022-10-04T20:34:10-04:00 chore: extend `.editorconfig` for C files - - - - - b8df5c72 by Brandon Chinn at 2022-10-04T20:34:46-04:00 Fix docs for pattern synonyms - - - - - 463ffe02 by Oleg Grenrus at 2022-10-04T20:35:24-04:00 Use sameByteArray# in sameByteArray - - - - - fbe1e86e by Pierre Le Marre at 2022-10-05T15:58:43+02:00 Minor fixes following Unicode 15.0.0 update - Fix changelog for Unicode 15.0.0 - Fix the checksums of the downloaded Unicode files, in base's tool: "ucd2haskell". - - - - - 8a31d02e by Cheng Shao at 2022-10-05T20:40:41-04:00 rts: don't enforce aligned((8)) on 32-bit targets We simply need to align to the word size for pointer tagging to work. On 32-bit targets, aligned((8)) is wasteful. - - - - - 532de368 by Ryan Scott at 2022-10-06T07:45:46-04:00 Export symbolSing, SSymbol, and friends (CLC#85) This implements this Core Libraries Proposal: https://github.com/haskell/core-libraries-committee/issues/85 In particular, it: 1. Exposes the `symbolSing` method of `KnownSymbol`, 2. Exports the abstract `SSymbol` type used in `symbolSing`, and 3. Defines an API for interacting with `SSymbol`. This also makes corresponding changes for `natSing`/`KnownNat`/`SNat` and `charSing`/`KnownChar`/`SChar`. This fixes #15183 and addresses part (2) of #21568. - - - - - d83a92e6 by sheaf at 2022-10-07T07:36:30-04:00 Remove mention of make from README.md - - - - - 945e8e49 by Bodigrim at 2022-10-10T17:13:31-04:00 Add a newline before since pragma in Data.Array.Byte - - - - - 44fcdb04 by Vladislav Zavialov at 2022-10-10T17:14:06-04:00 Parser/PostProcess: rename failOp* functions There are three functions named failOp* in the parser: failOpNotEnabledImportQualifiedPost failOpImportQualifiedTwice failOpFewArgs Only the last one has anything to do with operators. The other two were named this way either by mistake or due to a misunderstanding of what "op" stands for. This small patch corrects this. - - - - - 96d32ff2 by Simon Peyton Jones at 2022-10-10T22:30:21+01:00 Make rewrite rules "win" over inlining If a rewrite rule and a rewrite rule compete in the simplifier, this patch makes sure that the rewrite rule "win". That is, in general a bit fragile, but it's a huge help when making specialisation work reliably, as #21851 and #22097 showed. The change is fairly straightforwad, and documented in Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration. Compile-times change, up and down a bit -- in some cases because we get better specialisation. But the payoff (more reliable specialisation) is large. Metrics: compile_time/bytes allocated ----------------------------------------------- T10421(normal) +3.7% BAD T10421a(normal) +5.5% T13253(normal) +1.3% T14052(ghci) +1.8% T15304(normal) -1.4% T16577(normal) +3.1% BAD T17516(normal) +2.3% T17836(normal) -1.9% T18223(normal) -1.8% T8095(normal) -1.3% T9961(normal) +2.5% BAD geo. mean +0.0% minimum -1.9% maximum +5.5% Nofib results are (bytes allocated) +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || +0.27% | | imaginary/rfib || -0.04% | | real/anna || +0.02% | | real/fem || -0.04% | | real/fluid || +1.68% | | real/gamteb || -0.34% | | real/gg || +1.54% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/infer || -0.03% | | real/prolog || +0.02% | | real/veritas || -0.47% | | shootout/fannkuch-redux || -0.03% | | shootout/k-nucleotide || -0.02% | | shootout/n-body || -0.06% | | shootout/spectral-norm || -0.01% | | spectral/cryptarithm2 || +1.25% | | spectral/fibheaps || +18.33% | | spectral/last-piece || -0.34% | +===============================++==========+ | geom mean || +0.17% | There are extensive notes in !8897 about the regressions. Briefly * fibheaps: there was a very delicately balanced inlining that tipped over the wrong way after this change. * cryptarithm2 and paraffins are caused by #22274, which is a separate issue really. (I.e. the right fix is *not* to make inlining "win" over rules.) So I'm accepting these changes Metric Increase: T10421 T16577 T9961 - - - - - ed4b5885 by Joachim Breitner at 2022-10-10T23:16:11-04:00 Utils.JSON: do not escapeJsonString in ToJson String instance as `escapeJsonString` is used in `renderJSON`, so the `JSString` constructor is meant to carry the unescaped string. - - - - - fbb88740 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - e058b138 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Interface Files with Core Definitions This commit adds three new flags * -fwrite-if-simplified-core: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for including the core bindings in an interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of these extended interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 9789ea8e by Matthew Pickering at 2022-10-11T12:48:45-04:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - caced757 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Don't keep exit join points so much We were religiously keeping exit join points throughout, which had some bad effects (#21148, #22084). This MR does two things: * Arranges that exit join points are inhibited from inlining only in /one/ Simplifier pass (right after Exitification). See Note [Be selective about not-inlining exit join points] in GHC.Core.Opt.Exitify It's not a big deal, but it shaves 0.1% off compile times. * Inline used-once non-recursive join points very aggressively Given join j x = rhs in joinrec k y = ....j x.... where this is the only occurrence of `j`, we want to inline `j`. (Unless sm_keep_exits is on.) See Note [Inline used-once non-recursive join points] in GHC.Core.Opt.Simplify.Utils This is just a tidy-up really. It doesn't change allocation, but getting rid of a binding is always good. Very effect on nofib -- some up and down. - - - - - 284cf387 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Make SpecConstr bale out less often When doing performance debugging on #22084 / !8901, I found that the algorithm in SpecConstr.decreaseSpecCount was so aggressive that if there were /more/ specialisations available for an outer function, that could more or less kill off specialisation for an /inner/ function. (An example was in nofib/spectral/fibheaps.) This patch makes it a bit more aggressive, by dividing by 2, rather than by the number of outer specialisations. This makes the program bigger, temporarily: T19695(normal) ghc/alloc +11.3% BAD because we get more specialisation. But lots of other programs compile a bit faster and the geometric mean in perf/compiler is 0.0%. Metric Increase: T19695 - - - - - 66af1399 by Cheng Shao at 2022-10-11T12:49:59-04:00 CmmToC: emit explicit tail calls when the C compiler supports it Clang 13+ supports annotating a return statement using the musttail attribute, which guarantees that it lowers to a tail call if compilation succeeds. This patch takes advantage of that feature for the unregisterised code generator. The configure script tests availability of the musttail attribute, if it's available, the Cmm tail calls will become C tail calls that avoids the mini interpreter trampoline overhead. Nothing is affected if the musttail attribute is not supported. Clang documentation: https://clang.llvm.org/docs/AttributeReference.html#musttail - - - - - 7f0decd5 by Matthew Pickering at 2022-10-11T12:50:40-04:00 Don't include BufPos in interface files Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162 - - - - - dce9f320 by Cheng Shao at 2022-10-11T12:51:19-04:00 CLabel: fix isInfoTableLabel isInfoTableLabel does not take Cmm info table into account. This patch is required for data section layout of wasm32 NCG to work. - - - - - da679f2e by Bodigrim at 2022-10-11T18:02:59-04:00 Extend documentation for Data.List, mostly wrt infinite lists - - - - - 9c099387 by jwaldmann at 2022-10-11T18:02:59-04:00 Expand comment for Data.List.permutations - - - - - d3863cb7 by Bodigrim at 2022-10-11T18:03:37-04:00 ByteArray# is unlifted, not unboxed - - - - - f6260e8b by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 69ccec2c by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6e8feb4 by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 866c736e by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Refactor IPE tracing support - - - - - 6b0d2022 by Ben Gamari at 2022-10-11T23:45:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 9b572d54 by Ben Gamari at 2022-10-11T23:45:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 27978ceb by Krzysztof Gogolewski at 2022-10-11T23:45:46-04:00 Make Cmm Lint messages use dump style Lint errors indicate an internal error in GHC, so it makes sense to use it instead of the user style. This is consistent with Core Lint and STG Lint: https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Core/Lint.hs#L429 https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Stg/Lint.hs#L144 Fixes #22218. - - - - - 64a390d9 by Bryan Richter at 2022-10-12T09:52:51+03:00 Mark T7919 as fragile On x86_64-linux, T7919 timed out ~30 times during July 2022. And again ~30 times in September 2022. - - - - - 481467a5 by Ben Gamari at 2022-10-12T08:08:37-04:00 rts: Don't hint inlining of appendToRunQueue These hints have resulted in compile-time warnings due to failed inlinings for quite some time. Moreover, it's quite unlikely that inlining them is all that beneficial given that they are rather sizeable functions. Resolves #22280. - - - - - 81915089 by Curran McConnell at 2022-10-12T16:32:26-04:00 remove name shadowing - - - - - 626652f7 by Tamar Christina at 2022-10-12T16:33:13-04:00 winio: do not re-translate input when handle is uncooked - - - - - 5172789a by Charles Taylor at 2022-10-12T16:33:57-04:00 Unrestricted OverloadedLabels (#11671) Implements GHC proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - ce293908 by Andreas Klebinger at 2022-10-13T05:58:19-04:00 Add a perf test for the generics code pattern from #21839. This code showed a strong shift between compile time (got worse) and run time (got a lot better) recently which is perfectly acceptable. However it wasn't clear why the compile time regression was happening initially so I'm adding this test to make it easier to track such changes in the future. - - - - - 78ab7afe by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 44692713 by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Add support for .fini sections - - - - - beebf546 by Simon Hengel at 2022-10-13T05:59:37-04:00 Update phases.rst (the name of the original source file is $1, not $2) - - - - - eda6c05e by Finley McIlwaine at 2022-10-13T06:00:17-04:00 Clearer error msg for newtype GADTs with defaulted kind When a newtype introduces GADT eq_specs due to a defaulted RuntimeRep, we detect this and print the error message with explicit kinds. This also refactors newtype type checking to use the new diagnostic infra. Fixes #21447 - - - - - 43ab435a by Pierre Le Marre at 2022-10-14T07:45:43-04:00 Add standard Unicode case predicates isUpperCase and isLowerCase. These predicates use the standard Unicode case properties and are more intuitive than isUpper and isLower. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/90#issuecomment-1276649403. Fixes #14589 - - - - - aec5a443 by Bodigrim at 2022-10-14T07:46:21-04:00 Add type signatures in where-clause of Data.List.permutations The type of interleave' is very much revealing, otherwise it's extremely tough to decipher. - - - - - ee0deb80 by Ben Gamari at 2022-10-14T18:29:20-04:00 rts: Use pthread_setname_np correctly on Darwin As noted in #22206, pthread_setname_np on Darwin only supports setting the name of the calling thread. Consequently we must introduce a trampoline which first sets the thread name before entering the thread entrypoint. - - - - - 8eff62a4 by Ben Gamari at 2022-10-14T18:29:57-04:00 testsuite: Add test for #22282 This will complement mpickering's more general port of foundation's numerical testsuite, providing a test for the specific case found in #22282. - - - - - 62a55001 by Ben Gamari at 2022-10-14T18:29:57-04:00 ncg/aarch64: Fix sub-word sign extension yet again In adc7f108141a973b6dcb02a7836eed65d61230e8 we fixed a number of issues to do with sign extension in the AArch64 NCG found by ghc/test-primops>. However, this patch made a critical error, assuming that getSomeReg would allocate a fresh register for the result of its evaluation. However, this is not the case as `getSomeReg (CmmReg r) == r`. Consequently, any mutation of the register returned by `getSomeReg` may have unwanted side-effects on other expressions also mentioning `r`. In the fix listed above, this manifested as the registers containing the operands of binary arithmetic operations being incorrectly sign-extended. This resulted in #22282. Sadly, the rather simple structure of the tests generated by `test-primops` meant that this particular case was not exercised. Even more surprisingly, none of our testsuite caught this case. Here we fix this by ensuring that intermediate sign extension is performed in a fresh register. Fixes #22282. - - - - - 54e41b16 by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: ensure we are below maxHeapSize after returning megablocks When the heap is heavily block fragmented the live byte size might be low while the memory usage is high. We want to ensure that heap overflow triggers in these cases. We do so by checking that we can return enough megablocks to under maxHeapSize at the end of GC. - - - - - 29bb90db by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: trigger a major collection if megablock usage exceeds maxHeapSize When the heap is suffering from block fragmentation, live bytes might be low while megablock usage is high. If megablock usage exceeds maxHeapSize, we want to trigger a major GC to try to recover some memory otherwise we will die from a heapOverflow at the end of the GC. Fixes #21927 - - - - - 4a4641ca by Teo Camarasu at 2022-10-15T18:11:29+01:00 Add realease note for #21927 - - - - - c1e5719a by Sebastian Graf at 2022-10-17T11:58:46-04:00 DmdAnal: Look through unfoldings of DataCon wrappers (#22241) Previously, the demand signature we computed upfront for a DataCon wrapper lacked boxity information and was much less precise than the demand transformer for the DataCon worker. In this patch we adopt the solution to look through unfoldings of DataCon wrappers during Demand Analysis, but still attach a demand signature for other passes such as the Simplifier. See `Note [DmdAnal for DataCon wrappers]` for more details. Fixes #22241. - - - - - 8c72411d by Gergo ERDI at 2022-10-17T19:20:04-04:00 Add `Enum (Down a)` instance that swaps `succ` and `pred` See https://github.com/haskell/core-libraries-committee/issues/51 for discussion. The key points driving the implementation are the following two ideas: * For the `Int` type, `comparing (complement @Int)` behaves exactly as an order-swapping `compare @Int`. * `enumFrom @(Down a)` can be implemented in terms of `enumFromThen @a`, if only the corner case of starting at the very end is handled specially - - - - - d80ad2f4 by Alan Zimmerman at 2022-10-17T19:20:40-04:00 Update the check-exact infrastructure to match ghc-exactprint GHC tests the exact print annotations using the contents of utils/check-exact. The same functionality is provided via https://github.com/alanz/ghc-exactprint The latter was updated to ensure it works with all of the files on hackage when 9.2 was released, as well as updated to ensure users of the library could work properly (apply-refact, retrie, etc). This commit brings the changes from ghc-exactprint into GHC/utils/check-exact, adapting for the changes to master. Once it lands, it will form the basis for the 9.4 version of ghc-exactprint. See also discussion around this process at #21355 - - - - - 08ab5419 by Andreas Klebinger at 2022-10-17T19:21:15-04:00 Avoid allocating intermediate lists for non recursive bindings. We do so by having an explicit folding function that doesn't need to allocate intermediate lists first. Fixes #22196 - - - - - ff6275ef by Andreas Klebinger at 2022-10-17T19:21:52-04:00 Testsuite: Add a new tables_next_to_code predicate. And use it to avoid T21710a failing on non-tntc archs. Fixes #22169 - - - - - abb82f38 by Eric Lindblad at 2022-10-17T19:22:33-04:00 example rewrite - - - - - 39beb801 by Eric Lindblad at 2022-10-17T19:22:33-04:00 remove redirect - - - - - 0d9fb651 by Eric Lindblad at 2022-10-17T19:22:33-04:00 use heredoc - - - - - 0fa2d185 by Matthew Pickering at 2022-10-17T19:23:10-04:00 testsuite: Fix typo when setting llvm_ways Since 2014 llvm_ways has been set to [] so none of the tests which use only_ways(llvm_ways) have worked as expected. Hopefully the tests still pass with this typo fix! - - - - - ced664a2 by Krzysztof Gogolewski at 2022-10-17T19:23:10-04:00 Fix T15155l not getting -fllvm - - - - - 0ac60423 by Andreas Klebinger at 2022-10-18T03:34:47-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 9ecd1ac0 by M Farkas-Dyck at 2022-10-18T03:35:38-04:00 Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions. - - - - - f60244d7 by Ben Gamari at 2022-10-18T03:36:15-04:00 configure: Bump minimum bootstrap GHC version Fixes #22245 - - - - - ba4bd4a4 by Matthew Pickering at 2022-10-18T03:36:55-04:00 Build System: Remove out-of-date comment about make build system Both make and hadrian interleave compilation of modules of different modules and don't respect the package boundaries. Therefore I just remove this comment which points out this "difference". Fixes #22253 - - - - - e1bbd368 by Matthew Pickering at 2022-10-18T16:15:49+02:00 Allow configuration of error message printing This MR implements the idea of #21731 that the printing of a diagnostic method should be configurable at the printing time. The interface of the `Diagnostic` class is modified from: ``` class Diagnostic a where diagnosticMessage :: a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` to ``` class Diagnostic a where type DiagnosticOpts a defaultDiagnosticOpts :: DiagnosticOpts a diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` and so each `Diagnostic` can implement their own configuration record which can then be supplied by a client in order to dictate how to print out the error message. At the moment this only allows us to implement #21722 nicely but in future it is more natural to separate the configuration of how much information we put into an error message and how much we decide to print out of it. Updates Haddock submodule - - - - - 99dc3e3d by Matthew Pickering at 2022-10-18T16:15:53+02:00 Add -fsuppress-error-contexts to disable printing error contexts in errors In many development environments, the source span is the primary means of seeing what an error message relates to, and the In the expression: and In an equation for: clauses are not particularly relevant. However, they can grow to be quite long, which can make the message itself both feel overwhelming and interact badly with limited-space areas. It's simple to implement this flag so we might as well do it and give the user control about how they see their messages. Fixes #21722 - - - - - 5b3a992f by Dai at 2022-10-19T10:45:45-04:00 Add VecSlot for unboxed sums of SIMD vectors This patch adds the missing `VecRep` case to `primRepSlot` function and all the necessary machinery to carry this new `VecSlot` through code generation. This allows programs involving unboxed sums of SIMD vectors to be written and compiled. Fixes #22187 - - - - - 6d7d9181 by sheaf at 2022-10-19T10:45:45-04:00 Remove SIMD conversions This patch makes it so that packing/unpacking SIMD vectors always uses the right sized types, e.g. unpacking a Word16X4# will give a tuple of Word16#s. As a result, we can get rid of the conversion instructions that were previously required. Fixes #22296 - - - - - 3be48877 by sheaf at 2022-10-19T10:45:45-04:00 Cmm Lint: relax SIMD register assignment check As noted in #22297, SIMD vector registers can be used to store different kinds of values, e.g. xmm1 can be used both to store integer and floating point values. The Cmm type system doesn't properly account for this, so we weaken the Cmm register assignment lint check to only compare widths when comparing a vector type with its allocated vector register. - - - - - f7b7a312 by sheaf at 2022-10-19T10:45:45-04:00 Disable some SIMD tests on non-X86 architectures - - - - - 83638dce by M Farkas-Dyck at 2022-10-19T10:46:29-04:00 Scrub various partiality involving lists (again). Lets us avoid some use of `head` and `tail`, and some panics. - - - - - c3732c62 by M Farkas-Dyck at 2022-10-19T10:47:13-04:00 Enforce invariant of `ListBag` constructor. - - - - - 488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00 More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches` and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches` contains a single instance, but these invariants are immediately lost afterwards and not encoded in types. This patch enforces the invariants by pattern matching and makes types more precise, avoiding asserts and partial functions such as `head`. - - - - - 607ce263 by sheaf at 2022-10-19T10:47:52-04:00 Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap - - - - - 1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00 Add SpliceTypes test for hie files This test checks that typed splices and quotes get the right type information when used in hiefiles. See #21619 - - - - - a8b52786 by Jan Hrček at 2022-10-19T10:49:09-04:00 Small language fixes in 'Using GHC' - - - - - 1dab1167 by Gergő Érdi at 2022-10-19T10:49:51-04:00 Fix typo in `Opt_WriteIfSimplifiedCore`'s name - - - - - b17cfc9c by sheaf at 2022-10-19T10:50:37-04:00 TyEq:N assertion: only for saturated applications The assertion that checked TyEq:N in canEqCanLHSFinish incorrectly triggered in the case of an unsaturated newtype TyCon heading the RHS, even though we can't unwrap such an application. Now, we only trigger an assertion failure in case of a saturated application of a newtype TyCon. Fixes #22310 - - - - - ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - e15f60fe by Sasha Bogicevic at 2023-07-12T12:40:28+02:00 WIP 21101 Error message text for invalid record wildcard match - - - - - c73abe41 by Sasha Bogicevic at 2023-07-12T12:40:31+02:00 21101 Error message text for invalid record wildcard match - - - - - 20 changed files: - − .appveyor.sh - .editorconfig - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5772bcc0a65715a9ec4ca972e114cc84b6cf5e5...c73abe415ba658eb68adc0238f6b635a611682f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b5772bcc0a65715a9ec4ca972e114cc84b6cf5e5...c73abe415ba658eb68adc0238f6b635a611682f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 10:51:12 2023 From: gitlab at gitlab.haskell.org (Sasha Bogicevic (@Bogicevic)) Date: Wed, 12 Jul 2023 06:51:12 -0400 Subject: [Git][ghc/ghc][wip/21101] 21101 Error message text for invalid record wildcard match Message-ID: <64ae85a0ce836_3f5efcb368c17778b@gitlab.mail> Sasha Bogicevic pushed to branch wip/21101 at Glasgow Haskell Compiler / GHC Commits: 33d2dcdb by Sasha Bogicevic at 2023-07-12T12:51:01+02:00 21101 Error message text for invalid record wildcard match - - - - - 1 changed file: - compiler/GHC/Tc/Errors/Ppr.hs Changes: ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -278,9 +278,15 @@ instance Diagnostic TcRnMessage where -> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c <> char '\'' TcRnIllegalWildcardsInConstructor con -> mkSimpleDecorated $ - vcat [ text "Illegal `{..}' notation for constructor" <+> quotes (ppr con) - , nest 2 (text "Record wildcards may not be used for constructors with unlabelled fields.") - , nest 2 (text "Possible fix: Remove the `{..}' and add a match for each field of the constructor.") + vcat [ text "The data constructor" + <+> quotes (ppr con) + <+> text "does not have named record fields, so a pattern match" + <+> quotes (ppr con) + <+> text " { .. } is incorrect." + , text "Possible fixes:" + , nest 2 (text "* Replace the pattern '" <+> quotes (ppr con) <+> text "'{ .. }' with" <+> quotes (ppr con)) + , nest 2 (text "* Replace the pattern '" <+> quotes (ppr con) <+> text "'{ .. }' with" <+> quotes (ppr con) <+> text "{}") + , nest 4 (text "This version works even if you add/remove fields to " <+> quotes (ppr con) <+> text "later") ] TcRnIgnoringAnnotations anns -> mkSimpleDecorated $ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33d2dcdb6344a12f18e131986bbfad923a941537 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33d2dcdb6344a12f18e131986bbfad923a941537 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 12:16:42 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 12 Jul 2023 08:16:42 -0400 Subject: [Git][ghc/ghc][wip/T17521] Add test Message-ID: <64ae99aaa4503_3f5efcb32a42074e7@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 2e59dd79 by Jaro Reinders at 2023-07-12T14:16:32+02:00 Add test - - - - - 4 changed files: - + testsuite/tests/unlifted-datatypes/should_run/TopLevel.hs - + testsuite/tests/unlifted-datatypes/should_run/TopLevel.stdout - + testsuite/tests/unlifted-datatypes/should_run/TopLevela.hs - testsuite/tests/unlifted-datatypes/should_run/all.T Changes: ===================================== testsuite/tests/unlifted-datatypes/should_run/TopLevel.hs ===================================== @@ -0,0 +1,7 @@ +import TopLevela + +toInt UZero = 0 +toInt (USucc x) = 1 + toInt x + +main = case x of + Box y -> print (toInt y) ===================================== testsuite/tests/unlifted-datatypes/should_run/TopLevel.stdout ===================================== @@ -0,0 +1 @@ +3 \ No newline at end of file ===================================== testsuite/tests/unlifted-datatypes/should_run/TopLevela.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE UnliftedDatatypes #-} +module TopLevela where + +import GHC.Exts (UnliftedType) +import Data.Kind (Type) + +type UNat :: UnliftedType +data UNat = UZero | USucc UNat + +type Box :: UnliftedType -> Type +data Box a = Box a + +x = Box (USucc (USucc (USucc UZero))) ===================================== testsuite/tests/unlifted-datatypes/should_run/all.T ===================================== @@ -1,3 +1,4 @@ test('UnlData1', normal, compile_and_run, ['']) test('UnlGadt1', [exit_code(1), expect_broken_for(23060, ghci_ways)], compile_and_run, ['']) test('T23549', normal, multimod_compile_and_run, ['T23549', '']) +test('TopLevel', normal, multimod_compile_and_run, ['TopLevel', '-O']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e59dd7947ae0da96da5b60ff7d3042ae7cd54de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e59dd7947ae0da96da5b60ff7d3042ae7cd54de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 12:38:31 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 12 Jul 2023 08:38:31 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 2 commits: gitlab-ci: Bump ci-images Message-ID: <64ae9ec76921c_3f5efcb31c82146d3@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: aa78d6c3 by Ben Gamari at 2023-07-12T08:35:59-04:00 gitlab-ci: Bump ci-images To freeze emsdk, avoiding #23641. - - - - - 5facb3db by Ben Gamari at 2023-07-12T08:37:28-04:00 Accept performance wibbles These tests seem to have regressed in compiler allocations on Windows only. Metric Increase: T16875 T20049 T9198 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: c29d97c469a23db1c77ac1184eebbb2fd86ef623 + DOCKER_REV: e0874d9716897188a8ba059d2245269ed541bf9d # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8aa9a7ad5f159f068c06a064328d03ab8e71916b...5facb3dbff3c97414082b58f15b94e5587d47acd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8aa9a7ad5f159f068c06a064328d03ab8e71916b...5facb3dbff3c97414082b58f15b94e5587d47acd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 12:55:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 12 Jul 2023 08:55:09 -0400 Subject: [Git][ghc/ghc][wip/base-stability] base: Eliminate module reexport in GHC.Exception Message-ID: <64aea2ad3deff_3f5efcb31a02184b1@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: e3b267c3 by Ben Gamari at 2023-07-12T08:54:33-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T13386 - - - - - 1 changed file: - libraries/base/GHC/Exception.hs Changes: ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3b267c3ea760c5cde2676e915adb20807a9f2a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3b267c3ea760c5cde2676e915adb20807a9f2a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 13:42:57 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 12 Jul 2023 09:42:57 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 29 commits: base: Bump version to 4.19 Message-ID: <64aeade1d9026_3f5efc365dcec23714c@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 433d99a3 by Ben Gamari at 2023-07-12T09:42:25-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 89cb22c2 by Matthew Pickering at 2023-07-12T09:42:25-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 (cherry picked from commit 6295416ba0bc3e729b1f3dea56ef5d722f98ee9d) - - - - - 44b3c6d4 by Matthew Pickering at 2023-07-12T09:42:25-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 (cherry picked from commit 75b8b39a860a643b78405787bac582ba7cc3cb21) - - - - - b934a05f by Ben Gamari at 2023-07-12T09:42:25-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. (cherry picked from commit 46c9bcd6a47bdaa70869ed64da315315974b8b1d) - - - - - 8a6eb56a by Ben Gamari at 2023-07-12T09:42:25-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. (cherry picked from commit ec55035f8fe901b5d369221975fb1a741c677acb) - - - - - 7a5a1163 by Ben Gamari at 2023-07-12T09:42:25-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. (cherry picked from commit 3a09b789102dc0ea20a9af0912bc817ac5cb8c59) - - - - - ea1fb768 by Bryan Richter at 2023-07-12T09:42:25-04:00 Add missing void prototypes to rts functions See #23561. (cherry picked from commit 82ac6bf113526f61913943b911089534705984fb) - - - - - a474caef by Ben Gamari at 2023-07-12T09:42:25-04:00 gitlab-ci: Bump DOCKER_REV Ensuring that we bootstrap with GHC 9.4 universally. - - - - - 024861af by Ben Gamari at 2023-07-12T09:42:26-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. - - - - - 3b12e852 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. (cherry picked from commit 5b6612bc4f6b0a7ecc9868750bee1c359ffca871) - - - - - d72181cd by Ben Gamari at 2023-07-12T09:42:26-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files (cherry picked from commit 8b35e8caafeeccbf06b7faa70e807028a3f0ff43) - - - - - 594525fa by Ben Gamari at 2023-07-12T09:42:26-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. (cherry picked from commit d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8) - - - - - 555ad690 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. (cherry picked from commit 7c7d1f66d35f73a2faa898a33aa80cd276159dc2) - - - - - c4bb9e3e by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Various warnings fixes (cherry picked from commit cb92051e3d85575ff6abd753c9b135930cc50cf8) - - - - - f484169c by Ben Gamari at 2023-07-12T09:42:26-04:00 hadrian: Ignore warnings in unix and semaphore-compat (cherry picked from commit dec81dd1fd0475dde4929baae625d155387300bb) - - - - - 9922b77c by Matthew Pickering at 2023-07-12T09:42:26-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 (cherry picked from commit d7f6448aa06bbf26173a06ee5c624f5b734786c5) - - - - - ab74326f by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. (cherry picked from commit fd8c57694a00f6359bd66365f1284388c869ac60) - - - - - 9d9d9bc5 by Luite Stegeman at 2023-07-12T09:42:26-04:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 (cherry picked from commit 564164ef323a9f2cdeb8c69dcb2cf6df6382de4e) - - - - - a6ebaa83 by Torsten Schmits at 2023-07-12T09:42:26-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 (cherry picked from commit 40f4ef7c40e747dfea491d297475458d2ccaf860) - - - - - 3d6bd455 by Torsten Schmits at 2023-07-12T09:42:26-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 (cherry picked from commit 6fdcf969db85f3fe64123ba150e9226a0d2995cd) - - - - - a814fb6d by Ben Bellick at 2023-07-12T09:42:26-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure (cherry picked from commit 03f941f45607a5ee52ca53a358333bbb41ddb1bc) - - - - - cee76805 by aadaa_fgtaa at 2023-07-12T09:42:26-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts (cherry picked from commit b3e1436f968c0c36a27ea0339ee2554970b329fe) - - - - - 445dc082 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Add failing test case for #23492 (cherry picked from commit 6074cc3cda9b9836c784942a1aa7f766fb142787) - - - - - c505474d by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. (cherry picked from commit 356a269258a50bf67811fe0edb193fc9f82dfad1) - - - - - 765c1de8 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils (cherry picked from commit 3efe7f399a53ec7930c8a333ad2c114d956f0c2a) - - - - - 809f9b81 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors (cherry picked from commit dd782343f131cfd983a7fb2431d9d4a9ae497551) - - - - - 76668b6e by Ben Gamari at 2023-07-12T09:42:26-04:00 Fix breakpoint - - - - - 2b3da4c4 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. (cherry picked from commit bb0ed354b9b05c0774c1e9379823bceb785987ce) - - - - - 92d4e42a by Ben Gamari at 2023-07-12T09:42:26-04:00 gitlab-ci: Bump ci-images To freeze emsdk, avoiding #23641. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - hadrian/src/Flavour.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Settings/Warnings.hs - libraries/array - libraries/base/base.cabal - libraries/base/include/HsBase.h - libraries/base/tests/IO/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5facb3dbff3c97414082b58f15b94e5587d47acd...92d4e42ae6cbb4c038e4ea959ba24c91b35f30f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5facb3dbff3c97414082b58f15b94e5587d47acd...92d4e42ae6cbb4c038e4ea959ba24c91b35f30f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 14:55:26 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 10:55:26 -0400 Subject: [Git][ghc/ghc][wip/romes/ghc-platform] 129 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <64aebedee1a57_3f5efc152f6c6825384b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/ghc-platform at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - a483f769 by Rodrigo Mesquita at 2023-07-12T15:55:11+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51b64549b55ab53b66b93a9a16cbcb5af76bfc0e...a483f7699cc5c920b37481de6bdff2f8f178cc9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/51b64549b55ab53b66b93a9a16cbcb5af76bfc0e...a483f7699cc5c920b37481de6bdff2f8f178cc9d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:05:46 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 11:05:46 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-dllwrap] configure: Drop DllWrap command Message-ID: <64aec14ae0c99_3f5efcb31a02648bb@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/drop-dllwrap at Glasgow Haskell Compiler / GHC Commits: d7e10530 by Rodrigo Mesquita at 2023-07-12T16:05:33+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 12 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - configure.ac - docs/users_guide/phases.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - testsuite/tests/safeHaskell/flags/Flags02.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_a, sPgm_l, sPgm_lm, - sPgm_dll, sPgm_T, sPgm_windres, sPgm_ar, @@ -136,7 +135,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -404,8 +403,6 @@ pgm_l :: DynFlags -> (String,[Option]) pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags -pgm_dll :: DynFlags -> (String,[Option]) -pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags pgm_T :: DynFlags -> String pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String @@ -1080,8 +1077,6 @@ dynamic_flags_deps = [ } , make_ord_flag defFlag "pgml-supports-no-pie" $ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True } - , make_ord_flag defFlag "pgmdll" - $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) } , make_ord_flag defFlag "pgmwindres" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f } , make_ord_flag defFlag "pgmar" ===================================== compiler/GHC/Settings.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Settings , sPgm_a , sPgm_l , sPgm_lm - , sPgm_dll , sPgm_T , sPgm_windres , sPgm_ar @@ -108,7 +107,6 @@ data ToolSettings = ToolSettings -- ^ N.B. On Windows we don't have a linker which supports object -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. - , toolSettings_pgm_dll :: (String, [Option]) , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String @@ -218,8 +216,6 @@ sPgm_l :: Settings -> (String, [Option]) sPgm_l = toolSettings_pgm_l . sToolSettings sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings -sPgm_dll :: Settings -> (String, [Option]) -sPgm_dll = toolSettings_pgm_dll . sToolSettings sPgm_T :: Settings -> String sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -127,9 +127,6 @@ initSettings top_dir = do touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" - let mkdll_args = [] - -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -189,7 +186,6 @@ initSettings top_dir = do , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r - , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path ===================================== configure.ac ===================================== @@ -328,14 +328,12 @@ else AC_PATH_TOOL([AR],[ar]) AC_PATH_TOOL([RANLIB],[ranlib]) AC_PATH_TOOL([OBJDUMP],[objdump]) - AC_PATH_TOOL([DllWrap],[dllwrap]) AC_PATH_TOOL([Windres],[windres]) AC_PATH_TOOL([Genlib],[genlib]) HAVE_GENLIB=False if test "$HostOS" = "mingw32"; then AC_CHECK_TARGET_TOOL([Windres],[windres]) - AC_CHECK_TARGET_TOOL([DllWrap],[dllwrap]) AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump]) if test "$Genlib" != ""; then @@ -346,9 +344,7 @@ else fi if test "$HostOS" = "mingw32"; then - DllWrapCmd="$DllWrap" WindresCmd="$Windres" - AC_SUBST([DllWrapCmd]) AC_SUBST([WindresCmd]) AC_SUBST([GenlibCmd]) AC_SUBST([HAVE_GENLIB]) @@ -1238,7 +1234,6 @@ echo "\ otool : $OtoolCmd install_name_tool : $InstallNameToolCmd windres : $WindresCmd - dllwrap : $DllWrapCmd genlib : $GenlibCmd Happy : $HappyCmd ($HappyVersion) Alex : $AlexCmd ($AlexVersion) ===================================== docs/users_guide/phases.rst ===================================== @@ -88,13 +88,6 @@ given compilation phase: Use ⟨cmd⟩ as the linker when merging object files (e.g. when generating joined objects for loading into GHCi). -.. ghc-flag:: -pgmdll ⟨cmd⟩ - :shortdesc: Use ⟨cmd⟩ as the DLL generator - :type: dynamic - :category: phase-programs - - Use ⟨cmd⟩ as the DLL generator. - .. ghc-flag:: -pgmF ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only) :type: dynamic ===================================== hadrian/bindist/Makefile ===================================== @@ -103,7 +103,6 @@ lib/settings : config.mk @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ - @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -271,7 +271,6 @@ SettingsArCommand = @SettingsArCommand@ SettingsOtoolCommand = @SettingsOtoolCommand@ SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ -SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -155,7 +155,6 @@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ -settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ settings-llc-command = @SettingsLlcCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -123,7 +123,6 @@ data SettingsFileSetting | SettingsFileSetting_RanlibCommand | SettingsFileSetting_OtoolCommand | SettingsFileSetting_InstallNameToolCommand - | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand | SettingsFileSetting_LlcCommand @@ -220,7 +219,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" SettingsFileSetting_OtoolCommand -> "settings-otool-command" SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -462,7 +462,6 @@ generateSettings = do , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) - , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) ===================================== m4/fp_settings.m4 ===================================== @@ -23,7 +23,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsFlags="" SettingsArCommand="${mingw_bin_prefix}llvm-ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" - SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" SettingsTouchCommand='$$topdir/bin/touchy.exe' @@ -45,11 +44,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsCommand="$MergeObjsCmd" SettingsMergeObjectsFlags="$MergeObjsArgs" - if test -z "$DllWrapCmd"; then - SettingsDllWrapCommand="/bin/false" - else - SettingsDllWrapCommand="$DllWrapCmd" - fi if test -z "$WindresCmd"; then SettingsWindresCommand="/bin/false" else @@ -70,7 +64,6 @@ AC_DEFUN([FP_SETTINGS], SettingsLdCommand="$(basename $SettingsLdCommand)" SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" SettingsArCommand="$(basename $SettingsArCommand)" - SettingsDllWrapCommand="$(basename $SettingsDllWrapCommand)" SettingsWindresCommand="$(basename $SettingsWindresCommand)" fi fi @@ -115,7 +108,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsOtoolCommand) AC_SUBST(SettingsInstallNameToolCommand) - AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsLlcCommand) ===================================== testsuite/tests/safeHaskell/flags/Flags02.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# OPTIONS_GHC -pgmdll pgmdll, -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} +{-# OPTIONS_GHC -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} -- | These are all flags that should be allowed module Flags02 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7e1053034ff1746a07b581c66d2bb18359c361c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7e1053034ff1746a07b581c66d2bb18359c361c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:08:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 11:08:49 -0400 Subject: [Git][ghc/ghc][wip/romes/ghc-platform] Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Message-ID: <64aec201ef6f0_3f5efcf6618cc265798@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/ghc-platform at Glasgow Haskell Compiler / GHC Commits: f5a347e6 by Rodrigo Mesquita at 2023-07-12T16:08:30+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - 8 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -84,6 +84,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,7 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` + package into this reinstallable standalone package which abides by the PVP, + in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.15.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== @@ -1,17 +1,19 @@ {-# LANGUAGE LambdaCase, ScopedTypeVariables #-} -- | Platform architecture and OS --- --- We need it in ghc-boot because ghc-pkg needs it. module GHC.Platform.ArchOS ( ArchOS(..) + + -- * Architectures , Arch(..) - , OS(..) , ArmISA(..) , ArmISAExt(..) , ArmABI(..) , PPC_64ABI(..) , stringEncodeArch + + -- * Operating systems + , OS(..) , stringEncodeOS ) where @@ -27,10 +29,6 @@ data ArchOS deriving (Read, Show, Eq, Ord) -- | Architectures --- --- TODO: It might be nice to extend these constructors with information about --- what instruction set extensions an architecture might support. --- data Arch = ArchUnknown | ArchX86 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5a347e6c8eb5112057e8b2ad3fe245827c62cbb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5a347e6c8eb5112057e8b2ad3fe245827c62cbb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:14:19 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 11:14:19 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Message-ID: <64aec34bd9040_3f5efcb31b4268893@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 3ee743a8 by Rodrigo Mesquita at 2023-07-12T16:10:54+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - 0433c2e4 by Ben Gamari at 2023-07-12T16:10:54+01:00 ghc-toolchain: Initial commit - - - - - 3896743c by Rodrigo Mesquita at 2023-07-12T16:14:01+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain leftovers Delete a part Use ghc-platform instead of ghc-boot - - - - - 9563ad0f by Rodrigo Mesquita at 2023-07-12T16:14:02+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - fcc549d9 by Rodrigo Mesquita at 2023-07-12T16:14:02+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.host.target.in - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/061da9fe8a63054722140b977dceb9d8f66ea3b1...fcc549d9456584f263607d34204658231746b2d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/061da9fe8a63054722140b977dceb9d8f66ea3b1...fcc549d9456584f263607d34204658231746b2d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:23:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 11:23:14 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 6 commits: configure: Drop DllWrap command Message-ID: <64aec561f2858_3f5efc65c9ff8273768@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: d7e10530 by Rodrigo Mesquita at 2023-07-12T16:05:33+01:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 0f1366d7 by Rodrigo Mesquita at 2023-07-12T16:20:10+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - 9dea63c1 by Ben Gamari at 2023-07-12T16:20:10+01:00 ghc-toolchain: Initial commit - - - - - c9c03a16 by Rodrigo Mesquita at 2023-07-12T16:20:10+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain leftovers Delete a part Use ghc-platform instead of ghc-boot - - - - - ad84b040 by Rodrigo Mesquita at 2023-07-12T16:20:10+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 1e7431ef by Rodrigo Mesquita at 2023-07-12T16:20:10+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - + TODO - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - configure.ac - + default.host.target.in - + default.target.in - distrib/configure.ac.in - docs/users_guide/phases.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcc549d9456584f263607d34204658231746b2d1...1e7431ef598a117763a2bcf4429c103978443fe3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcc549d9456584f263607d34204658231746b2d1...1e7431ef598a117763a2bcf4429c103978443fe3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:24:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 11:24:57 -0400 Subject: [Git][ghc/ghc][master] Hadrian: enable GHCi support on riscv64 Message-ID: <64aec5c9ea28_3f5efc365dcec28108f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 1 changed file: - hadrian/src/Oracles/Setting.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -302,7 +302,8 @@ ghcWithInterpreter = do , "darwin", "kfreebsdgnu" ] goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc" , "arm", "aarch64", "s390x" - , "powerpc64", "powerpc64le" ] + , "powerpc64", "powerpc64le" + , "riscv64" ] return $ goodOs && goodArch -- | Variants of the ARM architecture. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd38aca95ac25adc9888083669b32ff551151259 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd38aca95ac25adc9888083669b32ff551151259 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:25:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 11:25:34 -0400 Subject: [Git][ghc/ghc][master] JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) Message-ID: <64aec5eea38fa_3f5efcb31b4284393@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 3 changed files: - rts/js/string.js - testsuite/tests/javascript/js-ffi-string.hs - testsuite/tests/javascript/js-ffi-string.stdout Changes: ===================================== rts/js/string.js ===================================== @@ -628,7 +628,7 @@ function h$fromHsString(str) { var xs = ''; while(IS_CONS(str)) { var h = CONS_HEAD(str); - xs += String.fromCharCode(UNWRAP_NUMBER(h)); + xs += String.fromCodePoint(UNWRAP_NUMBER(h)); str = CONS_TAIL(str); } return xs; ===================================== testsuite/tests/javascript/js-ffi-string.hs ===================================== @@ -1,13 +1,49 @@ import GHC.JS.Prim +import System.IO foreign import javascript "((x) => { console.log(x); })" log_js_string :: JSVal -> IO () -foreign import javascript "(() => { return 'a string'; })" - a_string :: JSVal +foreign import javascript "((x, y) => { return x === y; })" + eq_JSVal :: JSVal -> JSVal -> Bool + +foreign import javascript "(() => { return 'abc\\uD83D\\uDE0A'; })" + js_utf16_string :: JSVal +foreign import javascript "(() => { return 'abc' + String.fromCodePoint(128522); })" + js_codepoint_string :: JSVal + +-- It's important that this String is defined using a function to avoid rewrite +-- rules optimising away the use of `toJSString` called on a literal. +hsString :: String +hsString = "abc" ++ "\128522" main :: IO () main = do - log_js_string (toJSString "test") - putStrLn (fromJSString a_string) - putStrLn (fromJSString $ toJSString "test") + putStrLn "Does JS `String.fromCodePoint` decode to the expected UTF-16 values? " + print (eq_JSVal js_utf16_string js_codepoint_string) + hFlush stdout + log_js_string js_utf16_string + log_js_string js_codepoint_string + + putStrLn "\nDoes `GHC.JS.fromJSString` convert the JavaScript literal string correctly? " + print (hsString == fromJSString js_utf16_string) + putStrLn hsString + putStrLn (fromJSString js_utf16_string) + + putStrLn "\nDoes `GHC.JS.toJSString` convert the Haskell-defined string correctly? " + print (eq_JSVal js_utf16_string (toJSString hsString)) + hFlush stdout + log_js_string js_utf16_string + log_js_string (toJSString hsString) + + putStrLn "\nDo values survive the Haskell -> JavaScript -> Haskell round-trip? " + print (hsString == fromJSString (toJSString hsString)) + putStrLn hsString + putStrLn (fromJSString js_utf16_string) + + putStrLn "\nDo values survive the JavaScript -> Haskell -> JavaScript round-trip? " + print (eq_JSVal js_utf16_string (toJSString $ fromJSString js_utf16_string)) + hFlush stdout + log_js_string js_utf16_string + log_js_string (toJSString $ fromJSString js_utf16_string) + ===================================== testsuite/tests/javascript/js-ffi-string.stdout ===================================== @@ -1,3 +1,25 @@ -test -a string -test +Does JS `String.fromCodePoint` decode to the expected UTF-16 values? +True +abc😊 +abc😊 + +Does `GHC.JS.fromJSString` convert the JavaScript literal string correctly? +True +abc😊 +abc😊 + +Does `GHC.JS.toJSString` convert the Haskell-defined string correctly? +True +abc😊 +abc😊 + +Do values survive the Haskell -> JavaScript -> Haskell round-trip? +True +abc😊 +abc😊 + +Do values survive the JavaScript -> Haskell -> JavaScript round-trip? +True +abc😊 +abc😊 + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09a5c6cccf8f1b517bc01e8cc924e151d9cbae49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/09a5c6cccf8f1b517bc01e8cc924e151d9cbae49 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:26:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 11:26:22 -0400 Subject: [Git][ghc/ghc][master] Remove references to make build system in mk/build.mk Message-ID: <64aec61e8e548_3f5efcb31a028923@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -75,16 +75,6 @@ Environment variables affecting both build systems: (either "x86-64-darwin" or "aarch-darwin") NO_BOOT Whether to run ./boot or not, used when testing the source dist -Environment variables determining build configuration of Make system: - - BUILD_FLAVOUR Which flavour to build. - BUILD_SPHINX_HTML Whether to build Sphinx HTML documentation. - BUILD_SPHINX_PDF Whether to build Sphinx PDF documentation. - INTEGER_LIBRARY Which integer library to use (integer-simple or integer-gmp). - HADDOCK_HYPERLINKED_SOURCES - Whether to build hyperlinked Haddock sources. - TEST_TYPE Which test rule to run. - Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. @@ -390,26 +380,6 @@ function cleanup_submodules() { end_section "clean submodules" } -function prepare_build_mk() { - if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi - if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi - if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi - - cat > mk/build.mk <> mk/build.mk - fi - - - info "build.mk is:" - cat mk/build.mk -} - function configure() { case "${CONFIGURE_WRAPPER:-}" in emconfigure) source "$EMSDK/emsdk_env.sh" ;; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29fbbd4e9fe7ab82483d1700823715a9ff4092cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29fbbd4e9fe7ab82483d1700823715a9ff4092cf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:27:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 11:27:08 -0400 Subject: [Git][ghc/ghc][master] Valid hole fits: don't panic on a Given Message-ID: <64aec64c1e8b8_3f5efc365dcec294529@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - 5 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - + testsuite/tests/typecheck/should_fail/T22684.hs - + testsuite/tests/typecheck/should_fail/T22684.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1563,16 +1563,19 @@ validHoleFits :: SolverReportErrCtxt -- ^ The context we're in, i.e. the -- the valid hole fits. validHoleFits ctxt@(CEC { cec_encl = implics , cec_tidy = lcl_env}) simps hole - = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (map mk_wanted simps) hole + = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (mapMaybe mk_wanted simps) hole ; return (ctxt {cec_tidy = tidy_env}, fits) } where - mk_wanted :: ErrorItem -> CtEvidence - mk_wanted (EI { ei_pred = pred, ei_evdest = Just dest, ei_loc = loc }) - = CtWanted { ctev_pred = pred - , ctev_dest = dest - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet } - mk_wanted item = pprPanic "validHoleFits no evdest" (ppr item) + mk_wanted :: ErrorItem -> Maybe CtEvidence + mk_wanted (EI { ei_pred = pred, ei_evdest = m_dest, ei_loc = loc }) + | Just dest <- m_dest + = Just (CtWanted { ctev_pred = pred + , ctev_dest = dest + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet }) + | otherwise + = Nothing -- The ErrorItem was a Given + -- See Note [Constraints include ...] givenConstraints :: SolverReportErrCtxt -> [(Type, RealSrcSpan)] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4867,7 +4867,9 @@ data ErrorItem = EI { ei_pred :: PredType -- report about this -- The ei_pred field will never be an unboxed equality with -- a (casted) tyvar on the right; this is guaranteed by the solver - , ei_evdest :: Maybe TcEvDest -- for Wanteds, where to put evidence + , ei_evdest :: Maybe TcEvDest + -- ^ for Wanteds, where to put the evidence + -- for Givens, Nothing , ei_flavour :: CtFlavour , ei_loc :: CtLoc , ei_m_reason :: Maybe CtIrredReason -- if this ErrorItem was made from a ===================================== testsuite/tests/typecheck/should_fail/T22684.hs ===================================== @@ -0,0 +1,19 @@ +module T22684 where + +-- Example 1 from #22684 +p :: (Int ~ Bool => r) -> r +p _ = undefined + +q :: r +q = p _ + +-- Example 3 from #22684 +class Category k where + (.) :: k b c -> k a b -> k a c + +data Free p a b where + Prod :: Free p a (b, c) + Sum :: Free p (Either a b) c + +instance Category (Free p) where + Sum . Prod = _ ===================================== testsuite/tests/typecheck/should_fail/T22684.stderr ===================================== @@ -0,0 +1,35 @@ + +T22684.hs:8:7: error: [GHC-88464] + • Found hole: _ :: r + Where: ‘r’ is a rigid type variable bound by + the type signature for: + q :: forall r. r + at T22684.hs:7:1-6 + • In the first argument of ‘p’, namely ‘_’ + In the expression: p _ + In an equation for ‘q’: q = p _ + • Relevant bindings include q :: r (bound at T22684.hs:8:1) + Constraints include Int ~ Bool (from T22684.hs:8:7) + Valid hole fits include q :: r (bound at T22684.hs:8:1) + +T22684.hs:19:16: error: [GHC-88464] + • Found hole: _ :: Free p a c + Where: ‘k’, ‘p’ are rigid type variables bound by + the instance declaration + at T22684.hs:18:10-26 + ‘a’, ‘c’ are rigid type variables bound by + the type signature for: + (T22684..) :: forall b c a. Free p b c -> Free p a b -> Free p a c + at T22684.hs:19:7 + • In an equation for ‘T22684..’: Sum T22684.. Prod = _ + In the instance declaration for ‘Category (Free p)’ + • Relevant bindings include + (.) :: Free p b c -> Free p a b -> Free p a c + (bound at T22684.hs:19:7) + Constraints include + b ~ (b2, c1) (from T22684.hs:19:9-12) + b ~ Either a1 b1 (from T22684.hs:19:3-5) + Valid hole fits include + q :: forall r. r + with q @(Free p a c) + (bound at T22684.hs:8:1) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -696,4 +696,5 @@ test('VisFlag2', normal, compile_fail, ['']) test('VisFlag3', normal, compile_fail, ['']) test('VisFlag4', normal, compile_fail, ['']) test('VisFlag5', normal, compile_fail, ['']) +test('T22684', normal, compile_fail, ['']) test('T23514a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/630e302617a4a3e00d86d0650cb86fa9e6913e44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/630e302617a4a3e00d86d0650cb86fa9e6913e44 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 15:58:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 11:58:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) Message-ID: <64aecdaeece76_3f5efc365dcec324591@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - 3625e510 by Matthew Pickering at 2023-07-12T11:58:18-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - 0df66682 by Krzysztof Gogolewski at 2023-07-12T11:58:18-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 09efcdd9 by Bartłomiej Cieślar at 2023-07-12T11:58:23-04:00 Comments - - - - - 3e3a242c by Bartłomiej Cieślar at 2023-07-12T11:58:23-04:00 updates to comments - - - - - baaa2882 by Bartłomiej Cieślar at 2023-07-12T11:58:23-04:00 changes - - - - - 20 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Name.hs - rts/js/string.js - testsuite/tests/javascript/js-ffi-string.hs - testsuite/tests/javascript/js-ffi-string.stdout - + testsuite/tests/simplCore/should_compile/T23567.hs - + testsuite/tests/simplCore/should_compile/T23567A.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_fail/T22684.hs - + testsuite/tests/typecheck/should_fail/T22684.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: e0874d9716897188a8ba059d2245269ed541bf9d # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false - - job: nightly-i386-linux-deb9-validate + - job: nightly-i386-linux-deb10-validate artifacts: false - job: nightly-x86_64-linux-deb10-validate artifacts: false ===================================== .gitlab/ci.sh ===================================== @@ -75,16 +75,6 @@ Environment variables affecting both build systems: (either "x86-64-darwin" or "aarch-darwin") NO_BOOT Whether to run ./boot or not, used when testing the source dist -Environment variables determining build configuration of Make system: - - BUILD_FLAVOUR Which flavour to build. - BUILD_SPHINX_HTML Whether to build Sphinx HTML documentation. - BUILD_SPHINX_PDF Whether to build Sphinx PDF documentation. - INTEGER_LIBRARY Which integer library to use (integer-simple or integer-gmp). - HADDOCK_HYPERLINKED_SOURCES - Whether to build hyperlinked Haddock sources. - TEST_TYPE Which test rule to run. - Environment variables determining build configuration of Hadrian system: BUILD_FLAVOUR Which flavour to build. @@ -390,26 +380,6 @@ function cleanup_submodules() { end_section "clean submodules" } -function prepare_build_mk() { - if [[ -z "$BUILD_FLAVOUR" ]]; then fail "BUILD_FLAVOUR is not set"; fi - if [[ -z ${BUILD_SPHINX_HTML:-} ]]; then BUILD_SPHINX_HTML=YES; fi - if [[ -z ${BUILD_SPHINX_PDF:-} ]]; then BUILD_SPHINX_PDF=YES; fi - - cat > mk/build.mk <> mk/build.mk - fi - - - info "build.mk is:" - cat mk/build.mk -} - function configure() { case "${CONFIGURE_WRAPPER:-}" in emconfigure) source "$EMSDK/emsdk_env.sh" ;; ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -928,7 +928,7 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -126,7 +126,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -137,7 +137,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -147,14 +147,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -180,11 +180,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -377,7 +377,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -388,7 +388,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -398,14 +398,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -431,11 +431,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2536,7 +2536,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2547,7 +2547,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2557,14 +2557,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2590,13 +2590,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -191,7 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): deb10 = mk(debian("x86_64", 10)) deb11 = mk(debian("x86_64", 11)) deb10_arm64 = mk(debian("aarch64", 10)) - deb9_i386 = mk(debian("i386", 9)) + deb10_i386 = mk(debian("i386", 10)) source = mk_one_metadata(release_mode, version, job_map, source_artifact) test = mk_one_metadata(release_mode, version, job_map, test_artifact) @@ -221,10 +221,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): } - a32 = { "Linux_Debian": { "<10": deb9_i386, "unknown_versioning": deb9_i386 } - , "Linux_Ubuntu": { "unknown_versioning": deb9_i386 } - , "Linux_Mint" : { "unknown_versioning": deb9_i386 } - , "Linux_UnknownLinux" : { "unknown_versioning": deb9_i386 } + a32 = { "Linux_Debian": { "unknown_versioning": deb10_i386 } + , "Linux_Ubuntu": { "unknown_versioning": deb10_i386 } + , "Linux_Mint" : { "unknown_versioning": deb10_i386 } + , "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 } } arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 } ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1495,7 +1495,9 @@ specBind top_lvl env (NonRec fn rhs) do_body -- Destroying demand info is not terrible; specialisation is -- always followed soon by demand analysis. - body_env2 = body_env1 `extendInScope` fn3 + body_env2 = body_env1 `bringFloatedDictsIntoScope` ud_binds rhs_uds + `extendInScope` fn3 + -- bringFloatedDictsIntoScope: see #23567 ; (body', body_uds) <- do_body body_env2 ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -8,7 +8,34 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} --- | Tidying up Core +{-| Tidying up Core + +This module's purpose is to prepare the Core program for two distinct purposes: +* To be serialised into the module's interface file +* To feed to the code generator + +The most important tasks are: +* Determine which `Name`s should ultimately be `Internal` and `External` + (which may differ to whether they were originally `Internal` or `External`). + See `Note [About the NameSorts]` in GHC.Types.Name. + For example, in: + module M where + f x = x + y + where y = factorial 4 + could be optimized during the Core pass to: + module M where + y = factorial 4 + f x = x + y + in which case `y` would be changed from `Internal` to `External`. + +* Rename local identifiers to avoid name clashes, so that unfoldings etc can + be serialialised using the OccName, without Uniques. + + For example (`x_5` means `x` with a `Unique` of `5`): + f x_12 x_23 = x_12 + would be changed to: + f x_12 x1_23 = x_12 +-} module GHC.Iface.Tidy ( TidyOpts (..) , UnfoldingExposure (..) ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1563,16 +1563,19 @@ validHoleFits :: SolverReportErrCtxt -- ^ The context we're in, i.e. the -- the valid hole fits. validHoleFits ctxt@(CEC { cec_encl = implics , cec_tidy = lcl_env}) simps hole - = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (map mk_wanted simps) hole + = do { (tidy_env, fits) <- findValidHoleFits lcl_env implics (mapMaybe mk_wanted simps) hole ; return (ctxt {cec_tidy = tidy_env}, fits) } where - mk_wanted :: ErrorItem -> CtEvidence - mk_wanted (EI { ei_pred = pred, ei_evdest = Just dest, ei_loc = loc }) - = CtWanted { ctev_pred = pred - , ctev_dest = dest - , ctev_loc = loc - , ctev_rewriters = emptyRewriterSet } - mk_wanted item = pprPanic "validHoleFits no evdest" (ppr item) + mk_wanted :: ErrorItem -> Maybe CtEvidence + mk_wanted (EI { ei_pred = pred, ei_evdest = m_dest, ei_loc = loc }) + | Just dest <- m_dest + = Just (CtWanted { ctev_pred = pred + , ctev_dest = dest + , ctev_loc = loc + , ctev_rewriters = emptyRewriterSet }) + | otherwise + = Nothing -- The ErrorItem was a Given + -- See Note [Constraints include ...] givenConstraints :: SolverReportErrCtxt -> [(Type, RealSrcSpan)] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4867,7 +4867,9 @@ data ErrorItem = EI { ei_pred :: PredType -- report about this -- The ei_pred field will never be an unboxed equality with -- a (casted) tyvar on the right; this is guaranteed by the solver - , ei_evdest :: Maybe TcEvDest -- for Wanteds, where to put evidence + , ei_evdest :: Maybe TcEvDest + -- ^ for Wanteds, where to put the evidence + -- for Givens, Nothing , ei_flavour :: CtFlavour , ei_loc :: CtLoc , ei_m_reason :: Maybe CtIrredReason -- if this ErrorItem was made from a ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -143,12 +143,16 @@ data Name = Name -- See Note [About the NameSorts] data NameSort = External Module + -- Either an import from another module + -- or a top-level name + -- See Note [About the NameSorts] | WiredIn Module TyThing BuiltInSyntax -- A variant of External, for wired-in things - | Internal -- A user-defined Id or TyVar + | Internal -- A user-defined local Id or TyVar -- defined in the module being compiled + -- See Note [About the NameSorts] | System -- A system-defined Id or TyVar. Typically the -- OccName is very uninformative (like 's') @@ -213,21 +217,32 @@ TL;DR: we make the `n_occ` field lazy. {- Note [About the NameSorts] ~~~~~~~~~~~~~~~~~~~~~~~~~~ - -1. Initially, top-level Ids (including locally-defined ones) get External names, - and all other local Ids get Internal names - -2. In any invocation of GHC, an External Name for "M.x" has one and only one +1. Initially: + * All types, classes, data constructors get Extenal Names + * Top-level Ids (including locally-defined ones) get External Names, + * All other local (non-top-level) Ids get Internal names + +2. In the Tidy phase (GHC.Iface.Tidy): + * An Id that is "externally-visible" is given an External Name, + even if the name was Internal up to that point + * An Id that is not externally visible is given an Internal Name. + even if the name was External up to that point + See GHC.Iface.Tidy.tidyTopName + + An Id is externally visible if it is mentioned in the interface file; e.g. + - it is exported + - it is mentioned in an unfolding + See GHC.Iface.Tidy.chooseExternalIds + +3. In any invocation of GHC, an External Name for "M.x" has one and only one unique. This unique association is ensured via the Name Cache; see Note [The Name Cache] in GHC.Iface.Env. -3. Things with a External name are given C static labels, so they finally - appear in the .o file's symbol table. They appear in the symbol table - in the form M.n. If originally-local things have this property they - must be made @External@ first. +4. In code generation, things with a External name are given C static + labels, so they finally appear in the .o file's symbol table. They + appear in the symbol table in the form M.n. That is why + externally-visible things are made External (see (2) above). -4. In the tidy-core phase, a External that is not visible to an importer - is changed to Internal, and a Internal that is visible is changed to External 5. A System Name differs in the following ways: a) has unique attached when printing dumps @@ -239,13 +254,13 @@ Note [About the NameSorts] If any desugarer sys-locals have survived that far, they get changed to "ds1", "ds2", etc. -Built-in syntax => It's a syntactic form, not "in scope" (e.g. []) +6. A WiredIn Name is used for things (Id, TyCon) that are fully known to the compiler, + not read from an interface file. E.g. Bool, True, Int, Float, and many others. -Wired-in thing => The thing (Id, TyCon) is fully known to the compiler, - not read from an interface file. - E.g. Bool, True, Int, Float, and many others + A WiredIn Name contains contains a TyThing, so we don't have to look it up. -All built-in syntax is for wired-in things. + The BuiltInSyntax flag => It's a syntactic form, not "in scope" (e.g. []) + All built-in syntax thigs are WiredIn. -} instance HasOccName Name where ===================================== rts/js/string.js ===================================== @@ -628,7 +628,7 @@ function h$fromHsString(str) { var xs = ''; while(IS_CONS(str)) { var h = CONS_HEAD(str); - xs += String.fromCharCode(UNWRAP_NUMBER(h)); + xs += String.fromCodePoint(UNWRAP_NUMBER(h)); str = CONS_TAIL(str); } return xs; ===================================== testsuite/tests/javascript/js-ffi-string.hs ===================================== @@ -1,13 +1,49 @@ import GHC.JS.Prim +import System.IO foreign import javascript "((x) => { console.log(x); })" log_js_string :: JSVal -> IO () -foreign import javascript "(() => { return 'a string'; })" - a_string :: JSVal +foreign import javascript "((x, y) => { return x === y; })" + eq_JSVal :: JSVal -> JSVal -> Bool + +foreign import javascript "(() => { return 'abc\\uD83D\\uDE0A'; })" + js_utf16_string :: JSVal +foreign import javascript "(() => { return 'abc' + String.fromCodePoint(128522); })" + js_codepoint_string :: JSVal + +-- It's important that this String is defined using a function to avoid rewrite +-- rules optimising away the use of `toJSString` called on a literal. +hsString :: String +hsString = "abc" ++ "\128522" main :: IO () main = do - log_js_string (toJSString "test") - putStrLn (fromJSString a_string) - putStrLn (fromJSString $ toJSString "test") + putStrLn "Does JS `String.fromCodePoint` decode to the expected UTF-16 values? " + print (eq_JSVal js_utf16_string js_codepoint_string) + hFlush stdout + log_js_string js_utf16_string + log_js_string js_codepoint_string + + putStrLn "\nDoes `GHC.JS.fromJSString` convert the JavaScript literal string correctly? " + print (hsString == fromJSString js_utf16_string) + putStrLn hsString + putStrLn (fromJSString js_utf16_string) + + putStrLn "\nDoes `GHC.JS.toJSString` convert the Haskell-defined string correctly? " + print (eq_JSVal js_utf16_string (toJSString hsString)) + hFlush stdout + log_js_string js_utf16_string + log_js_string (toJSString hsString) + + putStrLn "\nDo values survive the Haskell -> JavaScript -> Haskell round-trip? " + print (hsString == fromJSString (toJSString hsString)) + putStrLn hsString + putStrLn (fromJSString js_utf16_string) + + putStrLn "\nDo values survive the JavaScript -> Haskell -> JavaScript round-trip? " + print (eq_JSVal js_utf16_string (toJSString $ fromJSString js_utf16_string)) + hFlush stdout + log_js_string js_utf16_string + log_js_string (toJSString $ fromJSString js_utf16_string) + ===================================== testsuite/tests/javascript/js-ffi-string.stdout ===================================== @@ -1,3 +1,25 @@ -test -a string -test +Does JS `String.fromCodePoint` decode to the expected UTF-16 values? +True +abc😊 +abc😊 + +Does `GHC.JS.fromJSString` convert the JavaScript literal string correctly? +True +abc😊 +abc😊 + +Does `GHC.JS.toJSString` convert the Haskell-defined string correctly? +True +abc😊 +abc😊 + +Do values survive the Haskell -> JavaScript -> Haskell round-trip? +True +abc😊 +abc😊 + +Do values survive the JavaScript -> Haskell -> JavaScript round-trip? +True +abc😊 +abc😊 + ===================================== testsuite/tests/simplCore/should_compile/T23567.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -funfolding-use-threshold=111640 -fmax-simplifier-iterations=2 #-} + +module T23567 where + +import T23567A + +instance (MonadIO m) => CacheRWM2 (ReaderT (StateT m)) where + p = runCacheBuildM + {-# NOINLINE p #-} ===================================== testsuite/tests/simplCore/should_compile/T23567A.hs ===================================== @@ -0,0 +1,27 @@ +module T23567A where + +class Appl f where + pur :: f + ast :: f -> f + +class Appl f => Mona f where + unused :: f + +class Mona f => MonadIO f where + unused2 :: f + +newtype StateT m = StateT { runStateT :: m } + deriving (Mona, MonadIO) + +instance (Appl m, Appl m) => Appl (StateT m) where + pur = pur + ast x = x + +newtype ReaderT m = ReaderT { runReaderT :: m } + deriving (Appl, Mona, MonadIO) + +class CacheRWM2 m where + p :: m + +runCacheBuildM :: (MonadIO m) => m +runCacheBuildM = ast pur ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -490,3 +490,4 @@ test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], mul test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) test('T23074', normal, compile, ['-O -ddump-rules']) test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) +test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0']) ===================================== testsuite/tests/typecheck/should_fail/T22684.hs ===================================== @@ -0,0 +1,19 @@ +module T22684 where + +-- Example 1 from #22684 +p :: (Int ~ Bool => r) -> r +p _ = undefined + +q :: r +q = p _ + +-- Example 3 from #22684 +class Category k where + (.) :: k b c -> k a b -> k a c + +data Free p a b where + Prod :: Free p a (b, c) + Sum :: Free p (Either a b) c + +instance Category (Free p) where + Sum . Prod = _ ===================================== testsuite/tests/typecheck/should_fail/T22684.stderr ===================================== @@ -0,0 +1,35 @@ + +T22684.hs:8:7: error: [GHC-88464] + • Found hole: _ :: r + Where: ‘r’ is a rigid type variable bound by + the type signature for: + q :: forall r. r + at T22684.hs:7:1-6 + • In the first argument of ‘p’, namely ‘_’ + In the expression: p _ + In an equation for ‘q’: q = p _ + • Relevant bindings include q :: r (bound at T22684.hs:8:1) + Constraints include Int ~ Bool (from T22684.hs:8:7) + Valid hole fits include q :: r (bound at T22684.hs:8:1) + +T22684.hs:19:16: error: [GHC-88464] + • Found hole: _ :: Free p a c + Where: ‘k’, ‘p’ are rigid type variables bound by + the instance declaration + at T22684.hs:18:10-26 + ‘a’, ‘c’ are rigid type variables bound by + the type signature for: + (T22684..) :: forall b c a. Free p b c -> Free p a b -> Free p a c + at T22684.hs:19:7 + • In an equation for ‘T22684..’: Sum T22684.. Prod = _ + In the instance declaration for ‘Category (Free p)’ + • Relevant bindings include + (.) :: Free p b c -> Free p a b -> Free p a c + (bound at T22684.hs:19:7) + Constraints include + b ~ (b2, c1) (from T22684.hs:19:9-12) + b ~ Either a1 b1 (from T22684.hs:19:3-5) + Valid hole fits include + q :: forall r. r + with q @(Free p a c) + (bound at T22684.hs:8:1) ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -696,4 +696,5 @@ test('VisFlag2', normal, compile_fail, ['']) test('VisFlag3', normal, compile_fail, ['']) test('VisFlag4', normal, compile_fail, ['']) test('VisFlag5', normal, compile_fail, ['']) +test('T22684', normal, compile_fail, ['']) test('T23514a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a61593be51d23938fcdbd702ad5aab1a4cd2107...baaa288294fd7145fce18be1cba5b95e2b199e86 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a61593be51d23938fcdbd702ad5aab1a4cd2107...baaa288294fd7145fce18be1cba5b95e2b199e86 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 16:01:31 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 12 Jul 2023 12:01:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23645 Message-ID: <64aece5bc1270_3f5efcb31c8331437@gitlab.mail> Jaro Reinders pushed new branch wip/T23645 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23645 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 16:43:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 12 Jul 2023 12:43:08 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 6 commits: Several improvements to the handling of coercions Message-ID: <64aed81c170d9_3f5efc365dcec34835d@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: e04b7b3a by Simon Peyton Jones at 2023-07-12T13:17:17+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - e79e49da by Simon Peyton Jones at 2023-07-12T14:29:14+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The net result is good: a 2% improvement in compile time. The table below shows changes over 1%. The main changes are: * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * When making join points, don't do so if the join point is so small it will immediately be inlined. See Note [Duplicating alternatives] * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * Many new or rewritten Notes. E.g. Note [Avoiding simplifying repeatedly] I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I added an INLINE pragma to it. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -4.3% GOOD LargeRecord(normal) -23.3% GOOD PmSeriesS(normal) -2.4% T11195(normal) -1.7% T12227(normal) -20.0% GOOD T12545(normal) -5.4% T13253-spj(normal) -50.7% GOOD T13386(normal) -5.1% GOOD T14766(normal) -2.4% GOOD T15164(normal) -1.7% T15304(normal) +1.0% T15630(normal) -7.7% T15630a(normal) NEW T15703(normal) -7.5% GOOD T16577(normal) -5.1% GOOD T17516(normal) -3.6% T18223(normal) -16.8% GOOD T18282(normal) -1.5% T18304(normal) +1.9% T21839c(normal) -3.5% GOOD T3064(normal) -1.5% T5030(normal) -16.2% GOOD T5321Fun(normal) -1.6% T6048(optasm) -2.1% GOOD T8095(normal) -6.1% GOOD T9630(normal) -5.1% GOOD WWRec(normal) -1.6% geo. mean -2.1% minimum -50.7% maximum +1.9% Metric Decrease: CoOpt_Singletons LargeRecord T12227 T13253-spj T13386 T14766 T15703 T16577 T18223 T21839c T5030 T6048 T8095 T9630 - - - - - f32ad188 by Simon Peyton Jones at 2023-07-12T17:35:45+01:00 No postInlineUnconditionally for strict bindings Does not save allocation! - - - - - c9b06dfa by Simon Peyton Jones at 2023-07-12T17:37:05+01:00 No preInlineConditionally for join points Does not save allocation! - - - - - 90d96f33 by Simon Peyton Jones at 2023-07-12T17:37:31+01:00 Don't use Plan A for a case continuation See carryPropagate in digits-of-e2 Really I'm moving more towards Plan B. - - - - - be385269 by Simon Peyton Jones at 2023-07-12T17:39:07+01:00 Half way attempt at inlining join points My idea here is to be more parsimonious about inlining join points. I was thinking that even join j x = I# x in case v of p1 -> j x1 p2 -> j x2 ... might not inline. Better for consumers. Also don't inline even in FinalPhase beause we want importing modules to see this. - - - - - 21 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - testsuite/tests/perf/compiler/T15630.hs - + testsuite/tests/perf/compiler/T15630a.hs - testsuite/tests/simplCore/should_compile/T18730.hs → testsuite/tests/perf/compiler/T18730.hs - testsuite/tests/simplCore/should_compile/T18730_A.hs → testsuite/tests/perf/compiler/T18730_A.hs - testsuite/tests/perf/compiler/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkSelCo, getNthFun, getNthFromType, mkLRCo, + mkSelCo, mkSelCoResRole, getNthFun, getNthFromType, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo, mkNakedFunCo, @@ -556,20 +556,28 @@ splitFunCo_maybe (FunCo { fco_arg = arg, fco_res = res }) = Just (arg, res) splitFunCo_maybe _ = Nothing splitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, Coercion, Coercion) -splitForAllCo_maybe (ForAllCo tv k_co co) = Just (tv, k_co, co) -splitForAllCo_maybe _ = Nothing +splitForAllCo_maybe (ForAllCo tv k_co co) + = Just (tv, k_co, co) +splitForAllCo_maybe co + | Just (ty, r) <- isReflCo_maybe co + , Just (tcv, body_ty) <- splitForAllTyCoVar_maybe ty + = Just (tcv, mkNomReflCo (varType tcv), mkReflCo r body_ty) +splitForAllCo_maybe _ + = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder splitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion) -splitForAllCo_ty_maybe (ForAllCo tv k_co co) - | isTyVar tv = Just (tv, k_co, co) -splitForAllCo_ty_maybe _ = Nothing +splitForAllCo_ty_maybe co + | Just stuff@(tv,_,_) <- splitForAllCo_maybe co + , isTyVar tv = Just stuff + | otherwise = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for covar binder splitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion) -splitForAllCo_co_maybe (ForAllCo cv k_co co) - | isCoVar cv = Just (cv, k_co, co) -splitForAllCo_co_maybe _ = Nothing +splitForAllCo_co_maybe co + | Just stuff@(cv,_,_) <- splitForAllCo_maybe co + , isCoVar cv = Just stuff + | otherwise = Nothing ------------------------------------------------------- -- and some coercion kind stuff @@ -1126,12 +1134,17 @@ mkUnivCo prov role ty1 ty2 -- a kind of @t1 ~ t2@ becomes the kind @t2 ~ t1 at . mkSymCo :: Coercion -> Coercion --- Do a few simple optimizations, but don't bother pushing occurrences --- of symmetry to the leaves; the optimizer will take care of that. -mkSymCo co | isReflCo co = co -mkSymCo (SymCo co) = co -mkSymCo (SubCo (SymCo co)) = SubCo co -mkSymCo co = SymCo co +-- Do a few simple optimizations, mainly to expose the underlying +-- constructors to other 'mk' functions. E.g. +-- mkInstCo (mkSymCo (ForAllCo ...)) ty +-- We want to push the SymCo inside the ForallCo, so that we can instantiate +-- This can make a big difference. E.g without coercion optimisation, GHC.Read +-- totally explodes; but when we push Sym inside ForAll, it's fine. +mkSymCo co | isReflCo co = co +mkSymCo (SymCo co) = co +mkSymCo (SubCo (SymCo co)) = SubCo co +mkSymCo (ForAllCo tcv kco co) = ForAllCo tcv (mkSymCo kco) (mkSymCo co) +mkSymCo co = SymCo co -- | Create a new 'Coercion' by composing the two given 'Coercion's transitively. -- (co1 ; co2) @@ -1142,6 +1155,7 @@ mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2) mkTransCo co1 co2 = TransCo co1 co2 +-------------------- mkSelCo :: HasDebugCallStack => CoSel -> Coercion @@ -1161,7 +1175,7 @@ mkSelCo_maybe cs co go cs co | Just (ty, r) <- isReflCo_maybe co - = Just (mkReflCo r (getNthFromType cs ty)) + = Just (mkReflCo (mkSelCoResRole cs r) (getNthFromType cs ty)) go SelForAll (ForAllCo _ kind_co _) = Just kind_co @@ -1212,6 +1226,14 @@ mkSelCo_maybe cs co good_call _ = False +mkSelCoResRole :: CoSel -> Role -> Role +-- What is the role of (SelCo cs co), if co has role 'r'? +-- It is not just 'r'! +-- c.f. the SelCo case of coercionRole +mkSelCoResRole SelForAll _ = Nominal +mkSelCoResRole (SelTyCon _ r') _ = r' +mkSelCoResRole (SelFun fs) r = funRole r fs + -- | Extract the nth field of a FunCo getNthFun :: FunSel -> a -- ^ multiplicity @@ -1222,6 +1244,24 @@ getNthFun SelMult mult _ _ = mult getNthFun SelArg _ arg _ = arg getNthFun SelRes _ _ res = res +getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type +getNthFromType (SelFun fs) ty + | Just (_af, mult, arg, res) <- splitFunTy_maybe ty + = getNthFun fs mult arg res + +getNthFromType (SelTyCon n _) ty + | Just args <- tyConAppArgs_maybe ty + = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $ + args `getNth` n + +getNthFromType SelForAll ty -- Works for both tyvar and covar + | Just (tv,_) <- splitForAllTyCoVar_maybe ty + = tyVarKind tv + +getNthFromType cs ty + = pprPanic "getNthFromType" (ppr cs $$ ppr ty) + +-------------------- mkLRCo :: LeftOrRight -> Coercion -> Coercion mkLRCo lr co | Just (ty, eq) <- isReflCo_maybe co @@ -1230,11 +1270,14 @@ mkLRCo lr co = LRCo lr co -- | Instantiates a 'Coercion'. +-- Works for both tyvar and covar mkInstCo :: Coercion -> CoercionN -> Coercion -mkInstCo (ForAllCo tcv _kind_co body_co) co - | Just (arg, _) <- isReflCo_maybe co - -- works for both tyvar and covar - = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co +mkInstCo co_fun co_arg + | Just (tcv, kind_co, body_co) <- splitForAllCo_maybe co_fun + , Just (arg, _) <- isReflCo_maybe co_arg + = assertPpr (isReflexiveCo kind_co) (ppr co_fun $$ ppr co_arg) $ + -- If the arg is Refl, then kind_co must be reflexive too + substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co mkInstCo co arg = InstCo co arg -- | Given @ty :: k1@, @co :: k1 ~ k2@, @@ -2433,23 +2476,6 @@ coercionLKind co go_app (InstCo co arg) args = go_app co (go arg:args) go_app co args = piResultTys (go co) args -getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type -getNthFromType (SelFun fs) ty - | Just (_af, mult, arg, res) <- splitFunTy_maybe ty - = getNthFun fs mult arg res - -getNthFromType (SelTyCon n _) ty - | Just args <- tyConAppArgs_maybe ty - = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $ - args `getNth` n - -getNthFromType SelForAll ty -- Works for both tyvar and covar - | Just (tv,_) <- splitForAllTyCoVar_maybe ty - = tyVarKind tv - -getNthFromType cs ty - = pprPanic "getNthFromType" (ppr cs $$ ppr ty) - coercionRKind :: Coercion -> Type coercionRKind co = go co ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Core.Unify import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Types.Unique.Set +-- import GHC.Types.Unique.Set import GHC.Data.Pair import GHC.Data.List.SetOps ( getNth ) @@ -132,45 +132,52 @@ optCoercion :: OptCoercionOpts -> Subst -> Coercion -> NormalCo optCoercion opts env co | optCoercionEnabled opts = optCoercion' env co + {- - = pprTrace "optCoercion {" (text "Co:" <+> ppr co) $ + = pprTrace "optCoercion {" (text "Co:" <> ppr (coercionSize co)) $ let result = optCoercion' env co in - pprTrace "optCoercion }" (vcat [ text "Co:" <+> ppr co - , text "Optco:" <+> ppr result ]) $ + pprTrace "optCoercion }" + (vcat [ text "Co:" <+> ppr (coercionSize co) + , text "Optco:" <+> ppWhen (isReflCo result) (text "(refl)") + <+> ppr (coercionSize result) ]) $ result -} | otherwise = substCo env co - optCoercion' :: Subst -> Coercion -> NormalCo optCoercion' env co | debugIsOn = let out_co = opt_co1 lc False co (Pair in_ty1 in_ty2, in_role) = coercionKindRole co (Pair out_ty1 out_ty2, out_role) = coercionKindRole out_co + + details = vcat [ text "in_co:" <+> ppr co + , text "in_ty1:" <+> ppr in_ty1 + , text "in_ty2:" <+> ppr in_ty2 + , text "out_co:" <+> ppr out_co + , text "out_ty1:" <+> ppr out_ty1 + , text "out_ty2:" <+> ppr out_ty2 + , text "in_role:" <+> ppr in_role + , text "out_role:" <+> ppr out_role +-- , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co +-- , text "subst:" <+> ppr env + ] in + warnPprTrace (not (isReflCo out_co) && isReflexiveCo out_co) + "optCoercion: reflexive but not refl" details $ assertPpr (substTyUnchecked env in_ty1 `eqType` out_ty1 && substTyUnchecked env in_ty2 `eqType` out_ty2 && in_role == out_role) - (hang (text "optCoercion changed types!") - 2 (vcat [ text "in_co:" <+> ppr co - , text "in_ty1:" <+> ppr in_ty1 - , text "in_ty2:" <+> ppr in_ty2 - , text "out_co:" <+> ppr out_co - , text "out_ty1:" <+> ppr out_ty1 - , text "out_ty2:" <+> ppr out_ty2 - , text "in_role:" <+> ppr in_role - , text "out_role:" <+> ppr out_role - , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co - , text "subst:" <+> ppr env ])) - out_co - - | otherwise = opt_co1 lc False co + (hang (text "optCoercion changed types!") 2 details) $ + out_co + + | otherwise + = opt_co1 lc False co where lc = mkSubstLiftingContext env - ppr_one cv = ppr cv <+> dcolon <+> ppr (coVarKind cv) +-- ppr_one cv = ppr cv <+> dcolon <+> ppr (coVarKind cv) type NormalCo = Coercion @@ -215,23 +222,37 @@ opt_co3 env sym _ r co = opt_co4_wrap env sym False r co -- | Optimize a non-phantom coercion. opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag -> Role -> Coercion -> NormalCo --- Precondition: In every call (opt_co4 lc sym rep role co) --- we should have role = coercionRole co +-- Precondition: In every call (opt_co4 lc sym rep role co) +-- we should have role = coercionRole co +-- Postcondition: The resulting coercion is equivalant to +-- wrapsub (wrapsym (mksub co) +-- where wrapsym is SymCo if sym=True +-- wrapsub is SubCo if rep=True + +-- opt_co4_wrap is there just to support tracing, when debugging +-- Usually it just goes straight to opt_co4 opt_co4_wrap = opt_co4 {- opt_co4_wrap env sym rep r co = pprTrace "opt_co4_wrap {" - ( vcat [ text "Sym:" <+> ppr sym - , text "Rep:" <+> ppr rep - , text "Role:" <+> ppr r - , text "Co:" <+> ppr co ]) $ - assert (r == coercionRole co ) $ - let result = opt_co4 env sym rep r co in - pprTrace "opt_co4_wrap }" (ppr co $$ text "---" $$ ppr result) $ - result --} + ( vcat [ text "Sym:" <+> ppr sym + , text "Rep:" <+> ppr rep + , text "Role:" <+> ppr r + , text "Co:" <+> ppr co ]) $ + assert (r == coercionRole co ) $ + let result = opt_co4 env sym rep r co in + pprTrace "opt_co4_wrap }" (ppr co $$ text "---" $$ ppr result) $ + assertPpr (res_role == coercionRole result) + (vcat [ text "Role:" <+> ppr r + , text "Result: " <+> ppr result + , text "Result type:" <+> ppr (coercionType result) ]) $ + result + where + res_role | rep = Representational + | otherwise = r +-} opt_co4 env _ rep r (Refl ty) = assertPpr (r == Nominal) @@ -379,11 +400,17 @@ opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo _ eta _)) -- works for both tyvar and covar = opt_co4_wrap env sym rep Nominal eta -opt_co4 env sym rep r (SelCo n co) - | Just nth_co <- case (co', n) of - (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n) - (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) - (ForAllCo _ eta _, SelForAll) -> Just eta +-- So the /input/ coercion isn't ForAllCo or Refl; +-- instead look at the /output/ coercion +opt_co4 env sym rep r (SelCo cs co) + | Just (ty, co_role) <- isReflCo_maybe co' + = mkReflCo (chooseRole rep (mkSelCoResRole cs co_role)) + (getNthFromType cs ty) + + | Just nth_co <- case (co', cs) of + (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n) + (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) + (ForAllCo _ eta _, SelForAll) -> Just eta _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo @@ -391,7 +418,7 @@ opt_co4 env sym rep r (SelCo n co) else nth_co | otherwise - = wrapRole rep r $ SelCo n co' + = wrapRole rep r $ SelCo cs co' where co' = opt_co1 env sym co @@ -586,7 +613,6 @@ opt_univ env sym prov role oty1 oty2 (env', tv1', eta') = optForAllCoBndr env sym tv1 eta in mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2') - | Just (cv1, ty1) <- splitForAllCoVar_maybe oty1 , Just (cv2, ty2) <- splitForAllCoVar_maybe oty2 -- NB: prov isn't interesting here either @@ -628,8 +654,25 @@ opt_transList :: HasDebugCallStack => InScopeSet -> [NormalCo] -> [NormalCo] -> opt_transList is = zipWithEqual "opt_transList" (opt_trans is) -- The input lists must have identical length. -opt_trans :: InScopeSet -> NormalCo -> NormalCo -> NormalCo +opt_trans, opt_trans' :: InScopeSet -> NormalCo -> NormalCo -> NormalCo + +-- opt_trans just allows us to add some debug tracing +-- Usually it just goes to opt_trans' +opt_trans is co1 co2 = opt_trans' is co1 co2 + +{- opt_trans is co1 co2 + = assertPpr (r1==r2) (vcat [ ppr r1 <+> ppr co1, ppr r2 <+> ppr co2]) $ + assertPpr (rres == r1) (vcat [ ppr r1 <+> ppr co1, ppr r2 <+> ppr co2, text "res" <+> ppr rres <+> ppr res ]) $ + res + where + res = opt_trans' is co1 co2 + rres = coercionRole res + r1 = coercionRole co1 + r2 = coercionRole co1 +-} + +opt_trans' is co1 co2 | isReflCo co1 = co2 -- optimize when co1 is a Refl Co | otherwise = opt_trans1 is co1 co2 @@ -803,10 +846,37 @@ opt_trans_rule is co1 co2 -- Push transitivity inside axioms opt_trans_rule is co1 co2 + -- TrPushAxSym/TrPushSymAx + -- Put this first! Otherwise (#23619) we get + -- newtype N a = MkN a + -- axN :: forall a. N a ~ a + -- Now consider (axN ty ; sym (axN ty)) + -- If we put TrPushSymAxR first, we'll get + -- (axN ty ; sym (axN ty)) :: N ty ~ N ty -- Obviously Refl + -- --> axN (sym (axN ty)) :: N ty ~ N ty -- Very stupid + | Just (sym1, ax1, ind1, cos1) <- isAxiom_maybe co1 + , Just (sym2, ax2, ind2, cos2) <- isAxiom_maybe co2 + , ax1 == ax2 + , ind1 == ind2 + , sym1 == not sym2 + , let branch = coAxiomNthBranch ax1 ind1 + role = coAxiomRole ax1 + qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch + lhs = coAxNthLHS ax1 ind1 + rhs = coAxBranchRHS branch + pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs) + , all (`elemVarSet` pivot_tvs) qtvs + = fireTransRule "TrPushAxSym" co1 co2 $ + if sym2 + -- TrPushAxSym + then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs + -- TrPushSymAx + else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs + -- See Note [Push transitivity inside axioms] and -- Note [Push transitivity inside newtype axioms only] -- TrPushSymAxR - | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + | Just (sym, con, ind, cos1) <- isAxiom_maybe co1 , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos2 <- matchAxiom sym con ind co2 @@ -814,7 +884,7 @@ opt_trans_rule is co1 co2 = fireTransRule "TrPushSymAxR" co1 co2 $ SymCo newAxInst -- TrPushAxR - | Just (sym, con, ind, cos1) <- co1_is_axiom_maybe + | Just (sym, con, ind, cos1) <- isAxiom_maybe co1 , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos2 <- matchAxiom sym con ind co2 @@ -822,7 +892,7 @@ opt_trans_rule is co1 co2 = fireTransRule "TrPushAxR" co1 co2 newAxInst -- TrPushSymAxL - | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + | Just (sym, con, ind, cos2) <- isAxiom_maybe co2 , isNewTyCon (coAxiomTyCon con) , True <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 @@ -830,35 +900,13 @@ opt_trans_rule is co1 co2 = fireTransRule "TrPushSymAxL" co1 co2 $ SymCo newAxInst -- TrPushAxL - | Just (sym, con, ind, cos2) <- co2_is_axiom_maybe + | Just (sym, con, ind, cos2) <- isAxiom_maybe co2 , isNewTyCon (coAxiomTyCon con) , False <- sym , Just cos1 <- matchAxiom (not sym) con ind co1 , let newAxInst = AxiomInstCo con ind (opt_transList is cos1 cos2) = fireTransRule "TrPushAxL" co1 co2 newAxInst - -- TrPushAxSym/TrPushSymAx - | Just (sym1, con1, ind1, cos1) <- co1_is_axiom_maybe - , Just (sym2, con2, ind2, cos2) <- co2_is_axiom_maybe - , con1 == con2 - , ind1 == ind2 - , sym1 == not sym2 - , let branch = coAxiomNthBranch con1 ind1 - qtvs = coAxBranchTyVars branch ++ coAxBranchCoVars branch - lhs = coAxNthLHS con1 ind1 - rhs = coAxBranchRHS branch - pivot_tvs = exactTyCoVarsOfType (if sym2 then rhs else lhs) - , all (`elemVarSet` pivot_tvs) qtvs - = fireTransRule "TrPushAxSym" co1 co2 $ - if sym2 - -- TrPushAxSym - then liftCoSubstWith role qtvs (opt_transList is cos1 (map mkSymCo cos2)) lhs - -- TrPushSymAx - else liftCoSubstWith role qtvs (opt_transList is (map mkSymCo cos1) cos2) rhs - where - co1_is_axiom_maybe = isAxiom_maybe co1 - co2_is_axiom_maybe = isAxiom_maybe co2 - role = coercionRole co1 -- should be the same as coercionRole co2! opt_trans_rule _ co1 co2 -- Identity rule | let ty1 = coercionLKind co1 @@ -1108,11 +1156,13 @@ chooseRole _ r = r ----------- isAxiom_maybe :: Coercion -> Maybe (Bool, CoAxiom Branched, Int, [Coercion]) -isAxiom_maybe (SymCo co) - | Just (sym, con, ind, cos) <- isAxiom_maybe co - = Just (not sym, con, ind, cos) -isAxiom_maybe (AxiomInstCo con ind cos) - = Just (False, con, ind, cos) +-- We don't expect to see nested SymCo; and that lets us write a simple, +-- non-recursive function. (If we see a nested SymCo we'll just fail, +-- which is ok.) +isAxiom_maybe (SymCo (AxiomInstCo ax ind cos)) + = Just (True, ax, ind, cos) +isAxiom_maybe (AxiomInstCo ax ind cos) + = Just (False, ax, ind, cos) isAxiom_maybe _ = Nothing matchAxiom :: Bool -- True = match LHS, False = match RHS ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -23,6 +23,7 @@ module GHC.Core.Opt.Simplify.Env ( getInScope, setInScopeFromE, setInScopeFromF, setInScopeSet, modifyInScope, addNewInScopeIds, getSimplRules, enterRecGroupRHSs, + reSimplifying, -- * Substitution results SimplSR(..), mkContEx, substId, lookupRecBndr, @@ -61,27 +62,31 @@ import GHC.Core.Utils import GHC.Core.Multiplicity ( scaleScaled ) import GHC.Core.Unfold import GHC.Core.TyCo.Subst (emptyIdSubstEnv) -import GHC.Types.Var -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Data.OrdList -import GHC.Data.Graph.UnVar -import GHC.Types.Id as Id import GHC.Core.Make ( mkWildValBinder, mkCoreLet ) -import GHC.Builtin.Types -import qualified GHC.Core.Type as Type import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo , extendTvSubst, extendCvSubst ) import qualified GHC.Core.Coercion as Coercion import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr ) -import GHC.Platform ( Platform ) +import qualified GHC.Core.Type as Type + +import GHC.Types.Var +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Id as Id import GHC.Types.Basic +import GHC.Types.Unique.FM ( pprUniqFM ) + +import GHC.Builtin.Types + +import GHC.Data.OrdList +import GHC.Data.Graph.UnVar +import GHC.Platform ( Platform ) + import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc -import GHC.Types.Unique.FM ( pprUniqFM ) import Data.List ( intersperse, mapAccumL ) @@ -151,6 +156,17 @@ following table: | Set by user | SimplMode | TopEnvConfig | | Computed on initialization | SimplEnv | SimplTopEnv | +Note [Inline depth] +~~~~~~~~~~~~~~~~~~~ +When we inline an /already-simplified/ unfolding, we +* Zap the substitution environment; the inlined thing is an OutExpr +* Bump the seInlineDepth in the SimplEnv +Both these tasks are done in zapSubstEnv. + +The seInlineDepth tells us how deep in inlining we are. Currently, +seInlineDepth is used for just one purpose: when we encounter a +coercion we don't apply optCoercion to it if seInlineDepth>0. +Reason: it has already been optimised once, no point in doing so again. -} data SimplEnv @@ -180,7 +196,11 @@ data SimplEnv -- They are all OutVars, and all bound in this module , seInScope :: !InScopeSet -- OutVars only - , seCaseDepth :: !Int -- Depth of multi-branch case alternatives + , seCaseDepth :: !Int -- Depth of multi-branch case alternatives + + , seInlineDepth :: !Int -- 0 initially, 1 when we inline an already-simplified + -- unfolding, and simplify again; and so on + -- See Note [Inline depth] } seArityOpts :: SimplEnv -> ArityOpts @@ -488,14 +508,15 @@ points we're substituting. -} mkSimplEnv :: SimplMode -> (FamInstEnv, FamInstEnv) -> SimplEnv mkSimplEnv mode fam_envs - = SimplEnv { seMode = mode - , seFamEnvs = fam_envs - , seInScope = init_in_scope - , seTvSubst = emptyVarEnv - , seCvSubst = emptyVarEnv - , seIdSubst = emptyVarEnv - , seRecIds = emptyUnVarSet - , seCaseDepth = 0 } + = SimplEnv { seMode = mode + , seFamEnvs = fam_envs + , seInScope = init_in_scope + , seTvSubst = emptyVarEnv + , seCvSubst = emptyVarEnv + , seIdSubst = emptyVarEnv + , seRecIds = emptyUnVarSet + , seCaseDepth = 0 + , seInlineDepth = 0 } -- The top level "enclosing CC" is "SUBSUMED". init_in_scope :: InScopeSet @@ -531,6 +552,9 @@ updMode upd env bumpCaseDepth :: SimplEnv -> SimplEnv bumpCaseDepth env = env { seCaseDepth = seCaseDepth env + 1 } +reSimplifying :: SimplEnv -> Bool +reSimplifying (SimplEnv { seInlineDepth = n }) = n>0 + --------------------- extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res @@ -616,7 +640,12 @@ setInScopeFromE. --------------------- zapSubstEnv :: SimplEnv -> SimplEnv -zapSubstEnv env = env {seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv} +-- See Note [Inline depth] +-- We call zapSubstEnv precisely when we are about to +-- simplify an already-simplified term +zapSubstEnv env@(SimplEnv { seInlineDepth = n }) + = env { seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv + , seInlineDepth = n+1 } setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids } ===================================== compiler/GHC/Core/Opt/Simplify/Inline.hs ===================================== @@ -89,14 +89,18 @@ StrictAnal.addStrictnessInfoToTopId callSiteInline :: Logger -> UnfoldingOpts - -> Int -- Case depth + -> Int -> Int -- Case depth and inline depth -> Id -- The Id -> Bool -- True <=> unfolding is active -> Bool -- True if there are no arguments at all (incl type args) -> [ArgSummary] -- One for each value arg; True if it is interesting -> CallCtxt -- True <=> continuation is interesting -> Maybe CoreExpr -- Unfolding, if any -callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_infos cont_info +callSiteInline logger opts + !case_depth -- See Note [Avoid inlining into deeply nested cases] + !inline_depth -- Currently not used to control inlining + -- but we pass it for debug-logging purposes + id active_unfolding lone_variable arg_infos cont_info = case idUnfolding id of -- idUnfolding checks for loop-breakers, returning NoUnfolding -- Things with an INLINE pragma may have an unfolding *and* @@ -104,7 +108,7 @@ callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_inf CoreUnfolding { uf_tmpl = unf_template , uf_cache = unf_cache , uf_guidance = guidance } - | active_unfolding -> tryUnfolding logger opts case_depth id lone_variable + | active_unfolding -> tryUnfolding logger opts case_depth inline_depth id lone_variable arg_infos cont_info unf_template unf_cache guidance | otherwise -> traceInline logger opts id "Inactive unfolding:" (ppr id) Nothing @@ -133,8 +137,9 @@ traceInline logger opts inline_id str doc result {- Note [Avoid inlining into deeply nested cases] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Also called "exponential inlining". -Consider a function f like this: +Consider a function f like this: (#18730) f arg1 arg2 = case ... @@ -145,46 +150,44 @@ This function is small. So should be safe to inline. However sometimes this doesn't quite work out like that. Consider this code: -f1 arg1 arg2 ... = ... - case _foo of - alt1 -> ... f2 arg1 ... - alt2 -> ... f2 arg2 ... + f1 arg1 arg2 ... = ... + case _foo of + alt1 -> ... f2 arg1 ... + alt2 -> ... f2 arg2 ... -f2 arg1 arg2 ... = ... - case _foo of - alt1 -> ... f3 arg1 ... - alt2 -> ... f3 arg2 ... + f2 arg1 arg2 ... = ... + case _foo of + alt1 -> ... f3 arg1 ... + alt2 -> ... f3 arg2 ... -f3 arg1 arg2 ... = ... + f3 arg1 arg2 ... = ... -... repeats up to n times. And then f1 is -applied to some arguments: + ... repeats up to n times. And then f1 is + applied to some arguments: -foo = ... f1 ... + foo = ... f1 ... -Initially f2..fn are not interesting to inline so we don't. -However we see that f1 is applied to interesting args. -So it's an obvious choice to inline those: +Initially f2..fn are not interesting to inline so we don't. However we see +that f1 is applied to interesting args. So it's an obvious choice to inline +those: -foo = - ... - case _foo of - alt1 -> ... f2 ... - alt2 -> ... f2 ... + foo = ... + case _foo of + alt1 -> ... f2 ... + alt2 -> ... f2 ... -As a result we go and inline f2 both mentions of f2 in turn are now applied to interesting -arguments and f2 is small: +As a result we go and inline f2 both mentions of f2 in turn are now applied to +interesting arguments and f2 is small: -foo = - ... - case _foo of - alt1 -> ... case _foo of - alt1 -> ... f3 ... - alt2 -> ... f3 ... + foo = ... + case _foo of + alt1 -> ... case _foo of + alt1 -> ... f3 ... + alt2 -> ... f3 ... - alt2 -> ... case _foo of - alt1 -> ... f3 ... - alt2 -> ... f3 ... + alt2 -> ... case _foo of + alt1 -> ... f3 ... + alt2 -> ... f3 ... The same thing happens for each binding up to f_n, duplicating the amount of inlining done in each step. Until at some point we are either done or run out of simplifier @@ -201,19 +204,73 @@ The heuristic can be tuned in two ways: * We can ignore the first n levels of case nestings for inlining decisions using -funfolding-case-threshold. -* The penalty grows linear with the depth. It's computed as size*(depth-threshold)/scaling. + +* The penalty grows linear with the depth. It's computed as + size*(depth-threshold)/scaling. Scaling can be set with -funfolding-case-scaling. +Reflections and wrinkles + +* See also Note [Do not add unfoldings to join points at birth] in + GHC.Core.Opt.Simplify.Iteration + +* The case total case depth is really the wrong thing; it will inhibit inlining of a + local function, just because there is some giant case nest further out. What we + want is the /difference/ in case-depth between the binding site and the call site. + That could be done quite easily by adding the case-depth to the Unfolding of the + function. + +* What matters more than /depth/ is total /width/; that is how many alternatives + are in the tree. We could perhaps multiply depth by width at each case expression. + +* There might be a case nest with many alternatives, but the function is called in + only a handful of them. So maybe we should ignore case-depth, and instead penalise + funtions that are called many times -- after all, inlining them bloats code. + + But in the scenario above, we are simplifying an inlined fuction, without doing a + global occurrence analysis each time. So if we based the penalty on multiple + occurences, we should /also/ add a penalty when simplifying an already-simplified + expression. We do track this (seInlineDepth) but currently we barely use it. + + An advantage of using occurrences+inline depth is that it'll work when no + case expressions are involved. See #15488. + +* Test T18730 did not involve join points. But join points are very prone to + the same kind of thing. For exampe in #13253, and several related tickets, + we got an exponential blowup in code size from a program that looks like + this. + + let j1a x = case f y of { True -> p; False -> q } + j1b x = case f y of { True -> q; False -> p } + j2a x = case f (y+1) of { True -> j1a x; False -> j1b x} + j2b x = case f (y+1) of { True -> j1b x; False -> j1a x} + ... + in case f (y+10) of { True -> j10a 7; False -> j10b 8 } + + The first danger is this: in Simplifier iteration 1 postInlineUnconditionally + inlines the last functions, j10a and j10b (they are both small). Now we have + two calls to j9a and two to j9b. In the next Simplifer iteration, + postInlineUnconditionally inlines all four of these calls, leaving four calls + to j8a and j8b. Etc. + + Happily, this probably /won't/ happen because the Simplifier works top down, so it'll + inline j1a/j1b into j2a/j2b, which will make the latter bigger; so the process + will stop. But we still need to stop the inline cascade described at the head + of this Note. + Some guidance on setting these defaults: * A low treshold (<= 2) is needed to prevent exponential cases from spiraling out of control. We picked 2 for no particular reason. + * Scaling the penalty by any more than 30 means the reproducer from T18730 won't compile even with reasonably small values of n. Instead it will run out of runs/ticks. This means to positively affect the reproducer a scaling <= 30 is required. + * A scaling of >= 15 still causes a few very large regressions on some nofib benchmarks. (+80% for gc/fulsom, +90% for real/ben-raytrace, +20% for spectral/fibheaps) + * A scaling of >= 25 showed no regressions on nofib. However it showed a number of (small) regression for compiler perf benchmarks. @@ -222,15 +279,15 @@ This gives us minimal compiler perf regressions. No nofib runtime regressions an will still avoid this pattern sometimes. This is a "safe" default, where we err on the side of compiler blowup instead of risking runtime regressions. -For cases where the default falls short the flag can be changed to allow more/less inlining as -needed on a per-module basis. +For cases where the default falls short the flag can be changed to allow +more/less inlining as needed on a per-module basis. -} -tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt +tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt -> CoreExpr -> UnfoldingCache -> UnfoldingGuidance -> Maybe CoreExpr -tryUnfolding logger opts !case_depth id lone_variable arg_infos +tryUnfolding logger opts !case_depth !inline_depth id lone_variable arg_infos cont_info unf_template unf_cache guidance = case guidance of UnfNever -> traceInline logger opts id str (text "UnfNever") Nothing @@ -263,8 +320,7 @@ tryUnfolding logger opts !case_depth id lone_variable arg_infos small_enough = adjusted_size <= unfoldingUseThreshold opts discount = computeDiscount arg_discounts res_discount arg_infos cont_info - extra_doc = vcat [ text "case depth =" <+> int case_depth - , text "depth based penalty =" <+> int depth_penalty + extra_doc = vcat [ text "depth based penalty =" <+> int depth_penalty , text "discounted size =" <+> int adjusted_size ] where -- Unpack the UnfoldingCache lazily because it may not be needed, and all @@ -281,6 +337,8 @@ tryUnfolding logger opts !case_depth id lone_variable arg_infos , text "is exp:" <+> ppr is_exp , text "is work-free:" <+> ppr is_wf , text "guidance" <+> ppr guidance + , text "case depth =" <+> int case_depth + , text "inline depth =" <+> int inline_depth , extra_doc , text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"] ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -13,14 +13,12 @@ module GHC.Core.Opt.Simplify.Iteration ( simplTopBinds, simplExpr, simplImpRules import GHC.Prelude -import GHC.Platform - import GHC.Driver.Flags import GHC.Core import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.ConstantFold -import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) +import GHC.Core.Type hiding ( substCo, substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Inline @@ -45,6 +43,7 @@ import GHC.Core.Opt.Arity ( ArityType, exprArity, arityTypeBotSigs_maybe , pushCoTyArg, pushCoValArg, exprIsDeadEnd , typeArity, arityTypeArity, etaExpandAT ) import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe ) +-- import GHC.Core.FVs ( mkRuleInfo, exprsFreeIds ) import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules ) import GHC.Core.Multiplicity @@ -60,10 +59,12 @@ import GHC.Types.Unique ( hasKey ) import GHC.Types.Basic import GHC.Types.Tickish import GHC.Types.Var ( isTyCoVar ) +-- import GHC.Types.Var.Set import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) +-- import GHC.Data.Maybe ( isNothing, isJust, orElse, mapMaybe ) import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) @@ -399,7 +400,8 @@ simplJoinBind env is_rec cont old_bndr new_bndr rhs rhs_se ; completeBind env (BC_Join is_rec cont) old_bndr new_bndr rhs' } -------------------------- -simplAuxBind :: SimplEnv +simplAuxBind :: String + -> SimplEnv -> InId -- Old binder; not a JoinId -> OutExpr -- Simplified RHS -> SimplM (SimplFloats, SimplEnv) @@ -411,17 +413,22 @@ simplAuxBind :: SimplEnv -- -- Precondition: rhs satisfies the let-can-float invariant -simplAuxBind env bndr new_rhs +simplAuxBind _str env bndr new_rhs | assertPpr (isId bndr && not (isJoinId bndr)) (ppr bndr) $ isDeadBinder bndr -- Not uncommon; e.g. case (a,b) of c { (p,q) -> p } = return (emptyFloats env, env) -- Here c is dead, and we avoid -- creating the binding c = (a,b) -- The cases would be inlined unconditionally by completeBind: - -- but it seems not uncommon, and avoids faff to do it here - -- This is safe because it's only used for auxiliary bindings, which - -- have no NOLINE pragmas, nor RULEs + -- but it seems not uncommon, and it turns to be a little more + -- efficient (in compile time allocations) to do it here. + -- Effectively this is just a poor man's postInlineUnconditionally + -- See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils + -- Note: auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings | exprIsTrivial new_rhs -- Short-cut for let x = y in ... + || case (idOccInfo bndr) of + OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> True + _ -> False = return ( emptyFloats env , case new_rhs of Coercion co -> extendCvSubst env bndr co @@ -587,11 +594,10 @@ Note [Concrete types] in GHC.Tc.Utils.Concrete. -} tryCastWorkerWrapper :: SimplEnv -> BindContext - -> InId -> OccInfo - -> OutId -> OutExpr + -> InId -> OutId -> OutExpr -> SimplM (SimplFloats, SimplEnv) -- See Note [Cast worker/wrapper] -tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) +tryCastWorkerWrapper env bind_cxt old_bndr bndr (Cast rhs co) | BC_Let top_lvl is_rec <- bind_cxt -- Not join points , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform -- a DFunUnfolding in mk_worker_unfolding @@ -617,7 +623,7 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) triv_rhs = Cast (Var work_id_w_unf) co - ; if postInlineUnconditionally env bind_cxt bndr occ_info triv_rhs + ; if postInlineUnconditionally env bind_cxt old_bndr bndr triv_rhs -- Almost always True, because the RHS is trivial -- In that case we want to eliminate the binding fast -- We conservatively use postInlineUnconditionally so that we @@ -660,7 +666,7 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) | isStableSource src -> return (unf { uf_tmpl = mkCast unf_rhs (mkSymCo co) }) _ -> mkLetUnfolding uf_opts top_lvl VanillaSrc work_id work_rhs -tryCastWorkerWrapper env _ _ _ bndr rhs -- All other bindings +tryCastWorkerWrapper env _ _ bndr rhs -- All other bindings = do { traceSmpl "tcww:no" (vcat [ text "bndr:" <+> ppr bndr , text "rhs:" <+> ppr rhs ]) ; return (mkFloatBind env (NonRec bndr rhs)) } @@ -939,7 +945,6 @@ completeBind env bind_cxt old_bndr new_bndr new_rhs = assert (isId new_bndr) $ do { let old_info = idInfo old_bndr old_unf = realUnfoldingInfo old_info - occ_info = occInfo old_info -- Do eta-expansion on the RHS of the binding -- See Note [Eta-expanding at let bindings] in GHC.Core.Opt.Simplify.Utils @@ -952,7 +957,7 @@ completeBind env bind_cxt old_bndr new_bndr new_rhs ; let new_bndr_w_info = addLetBndrInfo new_bndr new_arity new_unfolding -- See Note [In-scope set as a substitution] - ; if postInlineUnconditionally env bind_cxt new_bndr_w_info occ_info eta_rhs + ; if postInlineUnconditionally env bind_cxt old_bndr new_bndr_w_info eta_rhs then -- Inline and discard the binding do { tick (PostInlineUnconditionally old_bndr) @@ -966,8 +971,9 @@ completeBind env bind_cxt old_bndr new_bndr new_rhs -- substitution will happen, since we are going to discard the binding else -- Keep the binding; do cast worker/wrapper - -- pprTrace "Binding" (ppr new_bndr <+> ppr new_unfolding) $ - tryCastWorkerWrapper env bind_cxt old_bndr occ_info new_bndr_w_info eta_rhs } +-- simplTrace "completeBind" (vcat [ text "bndrs" <+> ppr old_bndr <+> ppr new_bndr +-- , text "eta_rhs" <+> ppr eta_rhs ]) $ + tryCastWorkerWrapper env bind_cxt old_bndr new_bndr_w_info eta_rhs } addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId addLetBndrInfo new_bndr new_arity_type new_unf @@ -1331,10 +1337,16 @@ simplCoercionF env co cont simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co - = do { let opt_co = optCoercion opts (getSubst env) co + = do { let opt_co | reSimplifying env = substCo env co + | otherwise = optCoercion opts subst co + -- If (reSimplifying env) is True we have already + -- simplified this coercion once, and we don't + -- want do so again; doing so repeatedly risks + -- non-linear behaviour ; seqCo opt_co `seq` return opt_co } where - opts = seOptCoercionOpts env + subst = getSubst env + opts = seOptCoercionOpts env ----------------------------------- -- | Push a TickIt context outwards past applications and cases, as @@ -1443,8 +1455,8 @@ simplTick env tickish expr cont splitCont :: SimplCont -> (SimplCont, SimplCont) splitCont cont@(ApplyToTy { sc_cont = tail }) = (cont { sc_cont = inc }, outc) where (inc,outc) = splitCont tail - splitCont (CastIt co c) = (CastIt co inc, outc) - where (inc,outc) = splitCont c + splitCont cont@(CastIt { sc_cont = tail }) = (cont { sc_cont = inc }, outc) + where (inc,outc) = splitCont tail splitCont other = (mkBoringStop (contHoleType other), other) getDoneId (DoneId id) = Just id @@ -1500,8 +1512,11 @@ rebuild env expr cont = case cont of Stop {} -> return (emptyFloats env, expr) TickIt t cont -> rebuild env (mkTick t expr) cont - CastIt co cont -> rebuild env (mkCast expr co) cont - -- NB: mkCast implements the (Coercion co |> g) optimisation + CastIt { sc_co = co, sc_opt = opt, sc_cont = cont } + -> rebuild env (mkCast expr co') cont + -- NB: mkCast implements the (Coercion co |> g) optimisation + where + co' = optOutCoercion env co opt Select { sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont } -> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont @@ -1552,7 +1567,7 @@ completeBindX env from_what bndr rhs body cont bndr2 (emptyFloats env) rhs -- NB: it makes a surprisingly big difference (5% in compiler allocation -- in T9630) to pass 'env' rather than 'env1'. It's fine to pass 'env', - -- because this is simplNonRecX, so bndr is not in scope in the RHS. + -- because this is completeBindX, so bndr is not in scope in the RHS. ; (bind_float, env2) <- completeBind (env2 `setInScopeFromF` rhs_floats) (BC_Let NotTopLevel NonRecursive) @@ -1600,36 +1615,73 @@ isReflexiveCo In investigating this I saw missed opportunities for on-the-fly coercion shrinkage. See #15090. + +Note [Avoid re-simplifying coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In some benchmarks (with deeply nested cases) we successively push +casts onto the SimplCont. We don't want to call the coercion optimiser +on each successive composition -- that's at least quadratic. So: + +* The CastIt constructor in SimplCont has a `sc_opt :: Bool` flag to + record whether the coercion optimiser has been applied to the coercion. + +* In `simplCast`, when we see (Cast e co), we simplify `co` to get + an OutCoercion, and built a CastIt with sc_opt=True. + + Actually not quite: if we are simplifying the result of inlining an + unfolding (seInlineDepth > 0), then instead of /optimising/ it again, + just /substitute/ which is cheaper. See `simplCoercion`. + +* In `addCoerce` (in `simplCast`) if we combine this new coercion with + an existing once, we build a CastIt for (co1 ; co2) with sc_opt=False. + +* When unpacking a CastIt, in `rebuildCall` and `rebuild`, we optimise + the (presumably composed) coercion if sc_opt=False; this is done + by `optOutCoercion`. + +* When duplicating a continuation in `mkDupableContWithDmds`, before + duplicating a CastIt, optimise the coercion. Otherwise we'll end up + optimising it separately in the duplicate copies. -} -simplCast :: SimplEnv -> InExpr -> Coercion -> SimplCont +optOutCoercion :: SimplEnv -> OutCoercion -> Bool -> OutCoercion +-- See Note [Avoid re-simplifying coercions] +optOutCoercion env co already_optimised + | already_optimised = co -- See Note [Avoid re-simplifying coercions] + | otherwise = optCoercion opts empty_subst co + where + empty_subst = mkEmptySubst (seInScope env) + opts = seOptCoercionOpts env + +simplCast :: SimplEnv -> InExpr -> InCoercion -> SimplCont -> SimplM (SimplFloats, OutExpr) simplCast env body co0 cont0 = do { co1 <- {-#SCC "simplCast-simplCoercion" #-} simplCoercion env co0 ; cont1 <- {-#SCC "simplCast-addCoerce" #-} if isReflCo co1 then return cont0 -- See Note [Optimising reflexivity] - else addCoerce co1 cont0 + else addCoerce co1 True cont0 + -- True <=> co1 is optimised ; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 } where + -- If the first parameter is MRefl, then simplifying revealed a -- reflexive coercion. Omit. - addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont - addCoerceM MRefl cont = return cont - addCoerceM (MCo co) cont = addCoerce co cont - - addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont - addCoerce co1 (CastIt co2 cont) -- See Note [Optimising reflexivity] - | isReflexiveCo co' = return cont - | otherwise = addCoerce co' cont - where - co' = mkTransCo co1 co2 - - addCoerce co (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) + addCoerceM :: MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont + addCoerceM MRefl _ cont = return cont + addCoerceM (MCo co) opt cont = addCoerce co opt cont + + addCoerce :: OutCoercion -> Bool -> SimplCont -> SimplM SimplCont + addCoerce co1 _ (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity] + = addCoerce (mkTransCo co1 co2) False cont + -- False: (mkTransCo co1 co2) is not fully optimised + -- See Note [Avoid re-simplifying coercions] + + addCoerce co opt (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty = {-#SCC "addCoerce-pushCoTyArg" #-} - do { tail' <- addCoerceM m_co' tail + do { tail' <- addCoerceM m_co' opt tail ; return (ApplyToTy { sc_arg_ty = arg_ty' , sc_cont = tail' , sc_hole_ty = coercionLKind co }) } @@ -1640,18 +1692,20 @@ simplCast env body co0 cont0 -- where co :: (s1->s2) ~ (t1->t2) -- co1 :: t1 ~ s1 -- co2 :: s2 ~ t2 - addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_dup = dup, sc_cont = tail - , sc_hole_ty = fun_ty }) + addCoerce co opt cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se + , sc_dup = dup, sc_cont = tail + , sc_hole_ty = fun_ty }) + | not opt -- pushCoValArg duplicates the coercion, so optimise first + = addCoerce (optOutCoercion env co opt) True cont + | Just (m_co1, m_co2) <- pushCoValArg co , fixed_rep m_co1 = {-#SCC "addCoerce-pushCoValArg" #-} - do { tail' <- addCoerceM m_co2 tail + do { tail' <- addCoerceM m_co2 opt tail ; case m_co1 of { MRefl -> return (cont { sc_cont = tail' , sc_hole_ty = coercionLKind co }) ; - -- Avoid simplifying if possible; - -- See Note [Avoiding exponential behaviour] + -- See Note [Avoiding simplifying repeatedly] MCo co1 -> do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg @@ -1666,11 +1720,11 @@ simplCast env body co0 cont0 , sc_cont = tail' , sc_hole_ty = coercionLKind co }) } } } - addCoerce co cont - | isReflexiveCo co = return cont -- Having this at the end makes a huge - -- difference in T12227, for some reason - -- See Note [Optimising reflexivity] - | otherwise = return (CastIt co cont) + addCoerce co opt cont + | isReflCo co = return cont -- Having this at the end makes a huge + -- difference in T12227, for some reason + -- See Note [Optimising reflexivity] + | otherwise = return (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }) fixed_rep :: MCoercionR -> Bool fixed_rep MRefl = True @@ -1732,7 +1786,7 @@ simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se ; let arg_ty = funArgTy fun_ty ; if | isSimplified dup -- Don't re-simplify if we've simplified it once -- Including don't preInlineUnconditionally - -- See Note [Avoiding exponential behaviour] + -- See Note [Avoiding simplifying repeatedly] -> completeBindX env (FromBeta arg_ty) bndr arg body cont | Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se @@ -1866,27 +1920,35 @@ Simplifier without first calling SimpleOpt, so anything involving GHCi or TH and operator sections will fall over if we don't take care here. -Note [Avoiding exponential behaviour] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Avoiding simplifying repeatedly] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression (#13379). That is why simplNonRecX does not try -preInlineUnconditionally (unlike simplNonRecE). +an expression (#13379). Example: f BIG, where f has a RULE Then * We simplify BIG before trying the rule; but the rule does not fire - * We inline f = \x. x True - * So if we did preInlineUnconditionally we'd re-simplify (BIG True) + (forcing this simplification is why we have the RULE in this example) + * We inline f = \x. g x, in `simpl_lam` + * So if `simpl_lam` did preInlineUnconditionally we get (g BIG) + * Now if g has a RULE we'll simplify BIG again, and this whole thing can + iterate. + * However, if `f` did not have a RULE, so that BIG has /not/ already been + simplified, we /want/ to do preInlineUnconditionally in simpl_lam. -However, if BIG has /not/ already been simplified, we'd /like/ to -simplify BIG True; maybe good things happen. That is why +So we go to some effort to avoid repeatedly simplifying the same thing: -* simplLam has - - a case for (isSimplified dup), which goes via simplNonRecX, and - - a case for the un-simplified case, which goes via simplNonRecE +* ApplyToVal has a (sc_dup :: DupFlag) field which records if the argument + has been evaluated. + +* simplArg checks this flag to avoid re-simplifying. + +* simpl_lam has: + - a case for (isSimplified dup), which goes via completeBindX, and + - a case for an un-simplified argument, which tries preInlineUnconditionally * We go to some efforts to avoid unnecessarily simplifying ApplyToVal, in at least two places @@ -1894,6 +1956,11 @@ simplify BIG True; maybe good things happen. That is why - In rebuildCall we avoid simplifying arguments before we have to (see Note [Trying rewrite rules]) +All that said /postInlineUnconditionally/ (called in `completeBind`) does +fire in the above (f BIG) situation. See Note [Post-inline for single-use +things] in Simplify.Utils. This certainly risks repeated simplification, but +in practice seems to be a small win. + ************************************************************************ * * @@ -2214,8 +2281,10 @@ rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args _ -> True ---------- Simplify type applications and casts -------------- -rebuildCall env info (CastIt co cont) - = rebuildCall env (addCastTo info co) cont +rebuildCall env info (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }) + = rebuildCall env (addCastTo info co') cont + where + co' = optOutCoercion env co opt rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont }) = rebuildCall env (addTyArgTo info arg_ty hole_ty) cont @@ -2297,7 +2366,7 @@ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont ----------------------------------- tryInlining :: SimplEnv -> Logger -> OutId -> SimplCont -> SimplM (Maybe OutExpr) tryInlining env logger var cont - | Just expr <- callSiteInline logger uf_opts case_depth var active_unf + | Just expr <- callSiteInline logger uf_opts case_depth inline_depth var active_unf lone_variable arg_infos interesting_cont = do { dump_inline expr cont ; return (Just expr) } @@ -2308,6 +2377,7 @@ tryInlining env logger var cont where uf_opts = seUnfoldingOpts env case_depth = seCaseDepth env + inline_depth = seInlineDepth env (lone_variable, arg_infos, call_cont) = contArgs cont interesting_cont = interestingCallContext env call_cont active_unf = activeUnfolding (seMode env) var @@ -2345,7 +2415,7 @@ Then given (f Int e1) we rewrite to (\x. x True) e1 without simplifying e1. Now we can inline x into its unique call site, and absorb the True into it all in the same pass. If we simplified -e1 first, we couldn't do that; see Note [Avoiding exponential behaviour]. +e1 first, we couldn't do that; see Note [Avoiding simplifying repeatedly]. So we try to apply rules if either (a) no_more_args: we've run out of argument that the rules can "see" @@ -2961,7 +3031,7 @@ rebuildCase env scrut case_bndr alts cont where simple_rhs env wfloats case_bndr_rhs bs rhs = assert (null bs) $ - do { (floats1, env') <- simplAuxBind env case_bndr case_bndr_rhs + do { (floats1, env') <- simplAuxBind "rebuildCase" env case_bndr case_bndr_rhs -- scrut is a constructor application, -- hence satisfies let-can-float invariant ; (floats2, expr') <- simplExprF env' rhs cont @@ -3028,7 +3098,7 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont | all_dead_bndrs , doCaseToLet scrut case_bndr = do { tick (CaseElim case_bndr) - ; (floats1, env') <- simplAuxBind env case_bndr scrut + ; (floats1, env') <- simplAuxBind "rebuildCaseAlt1" env case_bndr scrut ; (floats2, expr') <- simplExprF env' rhs cont ; return (floats1 `addFloats` floats2, expr') } @@ -3241,7 +3311,6 @@ simplAlts env0 scrut case_bndr alts cont' -- See Note [Shadowing in prepareAlts] in GHC.Core.Opt.Simplify.Utils ; alts' <- mapM (simplAlt alt_env' (Just scrut') imposs_deflt_cons case_bndr' cont') in_alts --- ; pprTrace "simplAlts" (ppr case_bndr $$ ppr alts $$ ppr cont') $ return () ; let alts_ty' = contResultType cont' -- See Note [Avoiding space leaks in OutType] @@ -3528,8 +3597,8 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont -- occur in the RHS; and simplAuxBind may therefore discard it. -- Nevertheless we must keep it if the case-binder is alive, -- because it may be used in the con_app. See Note [knownCon occ info] - ; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant - ; (floats2, env3) <- bind_args env2 bs' args + ; (floats1, env2) <- simplAuxBind "knownCon" env' b' arg -- arg satisfies let-can-float invariant + ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } bind_args _ _ _ = @@ -3554,7 +3623,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont ; let con_app = Var (dataConWorkId dc) `mkTyApps` dc_ty_args `mkApps` dc_args - ; simplAuxBind env bndr con_app } + ; simplAuxBind "case-bndr" env bndr con_app } ------------------- missingAlt :: SimplEnv -> Id -> [InAlt] -> SimplCont @@ -3651,9 +3720,11 @@ mkDupableContWithDmds env _ cont mkDupableContWithDmds _ _ (Stop {}) = panic "mkDupableCont" -- Handled by previous eqn -mkDupableContWithDmds env dmds (CastIt ty cont) +mkDupableContWithDmds env dmds (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }) = do { (floats, cont') <- mkDupableContWithDmds env dmds cont - ; return (floats, CastIt ty cont') } + ; return (floats, CastIt { sc_co = optOutCoercion env co opt + , sc_opt = True, sc_cont = cont' }) } + -- optOutCoercion: see Note [Avoid re-simplifying coercions] -- Duplicating ticks for now, not sure if this is good or not mkDupableContWithDmds env dmds (TickIt t cont) @@ -3684,6 +3755,7 @@ mkDupableContWithDmds env _ | isNothing (isDataConId_maybe (ai_fun fun)) , thumbsUpPlanA cont -- See point (3) of Note [Duplicating join points] = -- Use Plan A of Note [Duplicating StrictArg] +-- pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $ do { let (_ : dmds) = ai_dmds fun ; (floats1, cont') <- mkDupableContWithDmds env dmds cont -- Use the demands from the function to add the right @@ -3707,14 +3779,15 @@ mkDupableContWithDmds env _ ; (floats, join_rhs) <- rebuildCall env' (addValArgTo fun (Var arg_bndr) fun_ty) cont ; mkDupableStrictBind env' arg_bndr (wrapFloats floats join_rhs) rhs_ty } where + thumbsUpPlanA (StrictBind {}) = True + thumbsUpPlanA (Stop {}) = True + thumbsUpPlanA (Select {}) = False -- Not quite sure of this one, but it + -- benefits nofib digits-of-e1 quite a bit thumbsUpPlanA (StrictArg {}) = False - thumbsUpPlanA (CastIt _ k) = thumbsUpPlanA k + thumbsUpPlanA (CastIt { sc_cont = k }) = thumbsUpPlanA k thumbsUpPlanA (TickIt _ k) = thumbsUpPlanA k thumbsUpPlanA (ApplyToVal { sc_cont = k }) = thumbsUpPlanA k thumbsUpPlanA (ApplyToTy { sc_cont = k }) = thumbsUpPlanA k - thumbsUpPlanA (Select {}) = True - thumbsUpPlanA (StrictBind {}) = True - thumbsUpPlanA (Stop {}) = True mkDupableContWithDmds env dmds (ApplyToTy { sc_cont = cont, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) @@ -3775,8 +3848,7 @@ mkDupableContWithDmds env _ -- NB: we don't use alt_env further; it has the substEnv for -- the alternatives, and we don't want that - ; let platform = sePlatform env - ; (join_floats, alts'') <- mapAccumLM (mkDupableAlt platform case_bndr') + ; (join_floats, alts'') <- mapAccumLM (mkDupableAlt env case_bndr') emptyJoinFloats alts' ; let all_floats = floats `addJoinFloats` join_floats @@ -3817,11 +3889,11 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty , sc_cont = mkBoringStop res_ty } ) } -mkDupableAlt :: Platform -> OutId +mkDupableAlt :: SimplEnv -> OutId -> JoinFloats -> OutAlt -> SimplM (JoinFloats, OutAlt) -mkDupableAlt _platform case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) - | exprIsTrivial alt_rhs_in -- See point (2) of Note [Duplicating join points] +mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) + | ok_to_dup_alt case_bndr alt_bndrs alt_rhs_in -- See point (2) of Note [Duplicating join points] = return (jfloats, Alt con alt_bndrs alt_rhs_in) | otherwise @@ -3852,7 +3924,7 @@ mkDupableAlt _platform case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) filtered_binders = map fst abstracted_binders -- We want to make any binder with an evaldUnfolding strict in the rhs. -- See Note [Call-by-value for worker args] (which also applies to join points) - (rhs_with_seqs) = mkStrictFieldSeqs abstracted_binders alt_rhs_in + rhs_with_seqs = mkStrictFieldSeqs abstracted_binders alt_rhs_in final_args = varsToCoreExprs filtered_binders -- Note [Join point abstraction] @@ -3870,15 +3942,98 @@ mkDupableAlt _platform case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) join_rhs = mkLams (map zapIdUnfolding final_bndrs) rhs_with_seqs ; join_bndr <- newJoinId filtered_binders rhs_ty' - - ; let join_call = mkApps (Var join_bndr) final_args + ; let -- join_bndr_w_unf = join_bndr `setIdUnfolding` + -- mkUnfolding uf_opts VanillaSrc False False join_rhs Nothing + -- See Note [Do not add unfoldings to join points at birth] + join_call = mkApps (Var join_bndr) final_args alt' = Alt con alt_bndrs join_call ; return ( jfloats `addJoinFlts` unitJoinFloat (NonRec join_bndr join_rhs) , alt') } -- See Note [Duplicated env] +ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool +-- See Note [Duplicating alternatives] +ok_to_dup_alt _case_bndr _alt_bndrs alt_rhs + | (Var v, args) <- collectArgs alt_rhs + , all exprIsTrivial args + = isNothing (isDataConId_maybe v) + | otherwise + = False + {- +Note [Do not add unfoldings to join points at birth] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider this (#15360) + + case (case (case (case ...))) of + Left x -> e1 + Right y -> e2 + +We will make a join point for e1, e2, thus + $j1a x = e1 + $j1b y = e2 + +Now those join points count as "duplicable" , so we feel free to duplicate +them into the loop nest. And each of those calls are then subject to +callSiteInline, which might inline them, if e1, e2 are reasonably small. Now, +if this applies recursive to the next `case` inwards, and so on, the net +effect is that we can get an exponential number of calls to $j1a and $j1b, and +an exponential number of inlinings (since each is done independently). + +This hit #15360 (not a complicated program!) badly. Our simple solution is this: +when a join point is born, we don't give it an unfolding. So we end up with + $j1a x = e1 + $j1b y = e2 + $j2a x = ...$j1a ... $j1b... + $j2b x = ...$j1a ... $j1b... + ... and so on... + +Now we are into Note [Avoid inlining into deeply nested cases] in Simplify.Inline, +which is still a challenge. But at least we have a chance. If we add inlinings at +birth we never get that chance. + +Wrinkle + +(JU1) It turns out that the same problem shows up in a different guise, via + Note [Post-inline for single-use things] in Simplify.Utils. I think + we have something like + case K (join $j x = in jblah) of K y{OneOcc} -> blah + where $j is a freshly-born join point. After case-of-known-constructor + wo we end up substituting (join $j x = in jblah) for `y` in `blah`; + and thus we re-simplify that join binding. In test T15630 this results in + masssive duplication. + + So in `simplLetUnfolding` we spot this case a bit hackily; a freshly-born + join point will have OccInfo of ManyOccs, unlike an existing join point which + will have OneOcc. So in simplLetUnfolding we kill the unfolding of a freshly + born join point. + +I can't quite articulate precisely why this is so important. But it makes a MASSIVE +difference in T15630 (a fantastic test case); and at worst it'll merely delay inlining +join points by one simplifier iteration. + +Note [Duplicating alternatives] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When should we duplicate an alternative, and when should we make a join point? +We don't want to make a join point if it will /definitely/ be inlined; that +takes extra work to build, and an extra Simplifier iteration to do the inlining. +So consider + + case (case x of True -> e2; False -> e2) of + K1 a b -> f b a + K2 x -> g x v + K3 v -> Just v + +The (f b a) would turn into a join point like + $j1 a b = f b a +which would immediately inline again because the call is not smaller than the RHS. +On the other hand, the (g x v) turns into + $j2 x = g x v +which won't imediately inline. Finally the (Just v) would turn into + $j3 v = Just v +and you might think that would immediately inline. + Note [Fusing case continuations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important to fuse two successive case continuations when the @@ -3923,7 +4078,7 @@ inlining join points. Consider Here the join-point RHS is very small, just a constructor application (K x y). So we might inline it to get - case (case v of ) + case (case v of ) ( p1 -> K f x1 ) of ( p2 -> K f x2 ) ( p3 -> K f x3 ) @@ -3947,14 +4102,12 @@ To achieve this: phase. (The Final phase is still quite early, so we might consider delaying still more.) -2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for - all alternatives, except for exprIsTrival RHSs. Previously we used - exprIsDupable. This generates a lot more join points, but makes - them much more case-of-case friendly. +2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for all + alternatives, /unless/ the join point would be immediately inlined in the + following iteration: e.g. if its RHS is trivial. - It is definitely worth checking for exprIsTrivial, otherwise we get - an extra Simplifier iteration, because it is inlined in the next - round. + (Previously we used exprIsDupable.) This generates a lot more join points, + but makes them much more case-of-case friendly. 3. By the same token we want to use Plan B in Note [Duplicating StrictArg] when the RHS of the new join point @@ -3978,7 +4131,7 @@ the join point only when the RHS is * a constructor application? or * just non-trivial? Currently, a bit ad-hoc, but we definitely want to retain the join -point for data constructors in mkDupalbleALt (point 2); that is the +point for data constructors in mkDupableAlt (point 2); that is the whole point of #19996 described above. Historical Note [Case binders and join points] @@ -4241,30 +4394,40 @@ simplLetUnfolding :: SimplEnv simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf | isStableUnfolding unf = simplStableUnfolding env bind_cxt id rhs_ty arity unf + | isExitJoinId id - = return noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify + = -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify + return noUnfolding + + | isJoinId id + , too_many_occs (idOccInfo id) + = -- This is a tricky one! + -- See wrinkle (JU1) in Note [Do not add unfoldings to join points at birth] + return noUnfolding + | otherwise = -- Otherwise, we end up retaining all the SimpleEnv let !opts = seUnfoldingOpts env in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs + where + too_many_occs (ManyOccs {}) = True + too_many_occs (OneOcc { occ_n_br = n }) = n > 10 -- See #23627 + too_many_occs IAmDead = False + too_many_occs (IAmALoopBreaker {}) = False + ------------------- mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource -> InId -> OutExpr -> SimplM Unfolding mkLetUnfolding !uf_opts top_lvl src id new_rhs - = return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs Nothing) - -- We make an unfolding *even for loop-breakers*. - -- Reason: (a) It might be useful to know that they are WHNF - -- (b) In GHC.Iface.Tidy we currently assume that, if we want to - -- expose the unfolding then indeed we *have* an unfolding - -- to expose. (We could instead use the RHS, but currently - -- we don't.) The simple thing is always to have one. + = return (mkCoreUnfolding src is_top_lvl new_rhs Nothing guidance) where - -- Might as well force this, profiles indicate up to 0.5MB of thunks - -- just from this site. - !is_top_lvl = isTopLevel top_lvl - -- See Note [Force bottoming field] - !is_bottoming = isDeadEndId id + guidance = calcUnfoldingGuidance uf_opts (isJoinId id) is_top_bottoming new_rhs + + -- Strict binding; profiles indicate up to 0.5MB of thunks + -- just from this site. See Note [Force bottoming field] + !is_top_lvl = isTopLevel top_lvl + !is_top_bottoming =is_top_lvl && isDeadEndId id ------------------- simplStableUnfolding :: SimplEnv -> BindContext @@ -4375,6 +4538,17 @@ Wrinkles in GHC.Core.Opt.Simplify.Utils. We uphold this because the join-point case (bind_cxt = BC_Join {}) doesn't use eta_expand. +Note [Heavily used join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +After inining join points we can end up with + let $j x = + in case x1 of + True -> case x2 of + True -> $j blah1 + False -> $j blah2 + False -> case x3 of .... +with a huge case tree + Note [Force bottoming field] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We need to force bottoming, or the new unfolding holds ===================================== compiler/GHC/Core/Opt/Simplify/Monad.hs ===================================== @@ -219,7 +219,6 @@ newJoinId bndrs body_ty join_arity = length bndrs details = JoinId join_arity Nothing id_info = vanillaIdInfo `setArityInfo` arity --- `setOccInfo` strongLoopBreaker ; return (mkLocalVar details name ManyTy join_id_ty id_info) } ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -162,9 +162,12 @@ data SimplCont | CastIt -- (CastIt co K)[e] = K[ e `cast` co ] - OutCoercion -- The coercion simplified + { sc_co :: OutCoercion -- The coercion simplified -- Invariant: never an identity coercion - SimplCont + , sc_opt :: Bool -- True <=> sc_co has had optCoercion applied to it + -- See Note [Avoid re-simplifying coercions] + -- in GHC.Core.Opt.Simplify.Iteration + , sc_cont :: SimplCont } | ApplyToVal -- (ApplyToVal arg K)[e] = K[ e arg ] { sc_dup :: DupFlag -- See Note [DupFlag invariants] @@ -272,8 +275,10 @@ instance Outputable SimplCont where = text "Stop" <> brackets (sep $ punctuate comma pps) <+> ppr ty where pps = [ppr interesting] ++ [ppr eval_sd | eval_sd /= topSubDmd] - ppr (CastIt co cont ) = (text "CastIt" <+> pprOptCo co) $$ ppr cont - ppr (TickIt t cont) = (text "TickIt" <+> ppr t) $$ ppr cont + ppr (CastIt { sc_co = co, sc_cont = cont }) + = (text "CastIt" <+> pprOptCo co) $$ ppr cont + ppr (TickIt t cont) + = (text "TickIt" <+> ppr t) $$ ppr cont ppr (ApplyToTy { sc_arg_ty = ty, sc_cont = cont }) = (text "ApplyToTy" <+> pprParendType ty) $$ ppr cont ppr (ApplyToVal { sc_arg = arg, sc_dup = dup, sc_cont = cont, sc_hole_ty = hole_ty }) @@ -284,9 +289,9 @@ instance Outputable SimplCont where = (text "StrictBind" <+> ppr b) $$ ppr cont ppr (StrictArg { sc_fun = ai, sc_cont = cont }) = (text "StrictArg" <+> ppr (ai_fun ai)) $$ ppr cont - ppr (Select { sc_dup = dup, sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont }) + ppr (Select { sc_dup = dup, sc_bndr = bndr, sc_alts = alts, sc_cont = cont }) = (text "Select" <+> ppr dup <+> ppr bndr) $$ - whenPprDebug (nest 2 $ vcat [ppr (seTvSubst se), ppr alts]) $$ ppr cont + whenPprDebug (nest 2 $ ppr alts) $$ ppr cont {- Note [The hole type in ApplyToTy] @@ -350,6 +355,7 @@ data ArgSpec , as_hole_ty :: OutType } -- Type of the function (presumably forall a. blah) | CastBy OutCoercion -- Cast by this; c.f. CastIt + -- Coercion is optimised instance Outputable ArgInfo where ppr (ArgInfo { ai_fun = fun, ai_args = args, ai_dmds = dmds }) @@ -412,7 +418,8 @@ pushSimplifiedArg env (ValArg { as_arg = arg, as_hole_ty = hole_ty }) cont = ApplyToVal { sc_arg = arg, sc_env = env, sc_dup = Simplified -- The SubstEnv will be ignored since sc_dup=Simplified , sc_hole_ty = hole_ty, sc_cont = cont } -pushSimplifiedArg _ (CastBy c) cont = CastIt c cont +pushSimplifiedArg _ (CastBy c) cont + = CastIt { sc_co = c, sc_cont = cont, sc_opt = True } argInfoExpr :: OutId -> [ArgSpec] -> OutExpr -- NB: the [ArgSpec] is reversed so that the first arg @@ -469,7 +476,7 @@ mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd ------------------- contIsRhs :: SimplCont -> Maybe RecFlag contIsRhs (Stop _ (RhsCtxt is_rec) _) = Just is_rec -contIsRhs (CastIt _ k) = contIsRhs k -- For f = e |> co, treat e as Rhs context +contIsRhs (CastIt { sc_cont = k }) = contIsRhs k -- For f = e |> co, treat e as Rhs context contIsRhs _ = Nothing ------------------- @@ -483,7 +490,7 @@ contIsDupable (ApplyToTy { sc_cont = k }) = contIsDupable k contIsDupable (ApplyToVal { sc_dup = OkToDup }) = True -- See Note [DupFlag invariants] contIsDupable (Select { sc_dup = OkToDup }) = True -- ...ditto... contIsDupable (StrictArg { sc_dup = OkToDup }) = True -- ...ditto... -contIsDupable (CastIt _ k) = contIsDupable k +contIsDupable (CastIt { sc_cont = k }) = contIsDupable k contIsDupable _ = False ------------------- @@ -492,13 +499,13 @@ contIsTrivial (Stop {}) = True contIsTrivial (ApplyToTy { sc_cont = k }) = contIsTrivial k -- This one doesn't look right. A value application is not trivial -- contIsTrivial (ApplyToVal { sc_arg = Coercion _, sc_cont = k }) = contIsTrivial k -contIsTrivial (CastIt _ k) = contIsTrivial k +contIsTrivial (CastIt { sc_cont = k }) = contIsTrivial k contIsTrivial _ = False ------------------- contResultType :: SimplCont -> OutType contResultType (Stop ty _ _) = ty -contResultType (CastIt _ k) = contResultType k +contResultType (CastIt { sc_cont = k }) = contResultType k contResultType (StrictBind { sc_cont = k }) = contResultType k contResultType (StrictArg { sc_cont = k }) = contResultType k contResultType (Select { sc_cont = k }) = contResultType k @@ -509,7 +516,7 @@ contResultType (TickIt _ k) = contResultType k contHoleType :: SimplCont -> OutType contHoleType (Stop ty _ _) = ty contHoleType (TickIt _ k) = contHoleType k -contHoleType (CastIt co _) = coercionLKind co +contHoleType (CastIt { sc_co = co }) = coercionLKind co contHoleType (StrictBind { sc_bndr = b, sc_dup = dup, sc_env = se }) = perhapsSubstTy dup se (idType b) contHoleType (StrictArg { sc_fun_ty = ty }) = funArgTy ty @@ -529,7 +536,8 @@ contHoleType (Select { sc_dup = d, sc_bndr = b, sc_env = se }) -- case-of-case transformation. contHoleScaling :: SimplCont -> Mult contHoleScaling (Stop _ _ _) = OneTy -contHoleScaling (CastIt _ k) = contHoleScaling k +contHoleScaling (CastIt { sc_cont = k }) + = contHoleScaling k contHoleScaling (StrictBind { sc_bndr = id, sc_cont = k }) = idMult id `mkMultMul` contHoleScaling k contHoleScaling (Select { sc_bndr = id, sc_cont = k }) @@ -548,14 +556,14 @@ countArgs :: SimplCont -> Int -- and other values; skipping over casts. countArgs (ApplyToTy { sc_cont = cont }) = 1 + countArgs cont countArgs (ApplyToVal { sc_cont = cont }) = 1 + countArgs cont -countArgs (CastIt _ cont) = countArgs cont +countArgs (CastIt { sc_cont = cont }) = countArgs cont countArgs _ = 0 countValArgs :: SimplCont -> Int -- Count value arguments only countValArgs (ApplyToTy { sc_cont = cont }) = countValArgs cont countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont -countValArgs (CastIt _ cont) = countValArgs cont +countValArgs (CastIt { sc_cont = cont }) = countValArgs cont countValArgs _ = 0 ------------------- @@ -575,7 +583,7 @@ contArgs cont go args (ApplyToVal { sc_arg = arg, sc_env = se, sc_cont = k }) = go (is_interesting arg se : args) k go args (ApplyToTy { sc_cont = k }) = go args k - go args (CastIt _ k) = go args k + go args (CastIt { sc_cont = k }) = go args k go args k = (False, reverse args, k) is_interesting arg se = interestingArg se arg @@ -594,10 +602,10 @@ contArgs cont -- about what to do then and no call sites so far seem to care. contEvalContext :: SimplCont -> SubDemand contEvalContext k = case k of - (Stop _ _ sd) -> sd - (TickIt _ k) -> contEvalContext k - (CastIt _ k) -> contEvalContext k - ApplyToTy{sc_cont=k} -> contEvalContext k + Stop _ _ sd -> sd + TickIt _ k -> contEvalContext k + CastIt { sc_cont = k } -> contEvalContext k + ApplyToTy{ sc_cont = k } -> contEvalContext k -- ApplyToVal{sc_cont=k} -> mkCalledOnceDmd $ contEvalContext k -- Not 100% sure that's correct, . Here's an example: -- f (e x) and f :: @@ -881,7 +889,7 @@ interestingCallContext env cont interesting (Stop _ cci _) = cci interesting (TickIt _ k) = interesting k interesting (ApplyToTy { sc_cont = k }) = interesting k - interesting (CastIt _ k) = interesting k + interesting (CastIt { sc_cont = k }) = interesting k -- If this call is the arg of a strict function, the context -- is a bit interesting. If we inline here, we may get useful -- evaluation information to avoid repeated evals: e.g. @@ -921,7 +929,7 @@ contHasRules cont where go (ApplyToVal { sc_cont = cont }) = go cont go (ApplyToTy { sc_cont = cont }) = go cont - go (CastIt _ cont) = go cont + go (CastIt { sc_cont = cont }) = go cont go (StrictArg { sc_fun = fun }) = ai_encl fun go (Stop _ RuleArgCtxt _) = True go (TickIt _ c) = go c @@ -1514,15 +1522,14 @@ rules] for details. postInlineUnconditionally :: SimplEnv -> BindContext - -> OutId -- The binder (*not* a CoVar), including its unfolding - -> OccInfo -- From the InId + -> InId -> OutId -- The binder (*not* a CoVar), including its unfolding -> OutExpr -> Bool -- Precondition: rhs satisfies the let-can-float invariant -- See Note [Core let-can-float invariant] in GHC.Core -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings -postInlineUnconditionally env bind_cxt bndr occ_info rhs +postInlineUnconditionally env bind_cxt old_bndr bndr rhs | not active = False | isWeakLoopBreaker occ_info = False -- If it's a loop-breaker of any kind, don't inline -- because it might be referred to "earlier" @@ -1530,27 +1537,23 @@ postInlineUnconditionally env bind_cxt bndr occ_info rhs | isTopLevel (bindContextLevel bind_cxt) = False -- Note [Top level and postInlineUnconditionally] | exprIsTrivial rhs = True - | BC_Join {} <- bind_cxt -- See point (1) of Note [Duplicating join points] - , not (phase == FinalPhase) = False -- in Simplify.hs + | BC_Join {} <- bind_cxt = False -- See point (1) of Note [Duplicating join points] +-- , not (phase == FinalPhase) = False -- in Simplify.hs | otherwise = case occ_info of OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt, occ_n_br = n_br } -- See Note [Inline small things to avoid creating a thunk] - -> n_br < 100 -- See Note [Suppress exponential blowup] + | let not_inside_lam = in_lam == NotInsideLam + -> n_br < 100 -- See #23627 - && smallEnoughToInline uf_opts unfolding -- Small enough to dup - -- ToDo: consider discount on smallEnoughToInline if int_cxt is true - -- - -- NB: Do NOT inline arbitrarily big things, even if occ_n_br=1 - -- Reason: doing so risks exponential behaviour. We simplify a big - -- expression, inline it, and simplify it again. But if the - -- very same thing happens in the big expression, we get - -- exponential cost! - -- PRINCIPLE: when we've already simplified an expression once, - -- make sure that we only inline it if it's reasonably small. - - && (in_lam == NotInsideLam || + && ( (n_br == 1 && not_inside_lam) + -- See Note [Post-inline for single-use things] + || (is_lazy && smallEnoughToInline uf_opts unfolding)) + -- Lazy, and small enough to dup + -- ToDo: consider discount on smallEnoughToInline if int_cxt is true + + && (not_inside_lam || -- Outside a lambda, we want to be reasonably aggressive -- about inlining into multiple branches of case -- e.g. let x = @@ -1571,19 +1574,9 @@ postInlineUnconditionally env bind_cxt bndr occ_info rhs _ -> False --- Here's an example that we don't handle well: --- let f = if b then Left (\x.BIG) else Right (\y.BIG) --- in \y. ....case f of {...} .... --- Here f is used just once, and duplicating the case work is fine (exprIsCheap). --- But --- - We can't preInlineUnconditionally because that would invalidate --- the occ info for b. --- - We can't postInlineUnconditionally because the RHS is big, and --- that risks exponential behaviour --- - We can't call-site inline, because the rhs is big --- Alas! - where + is_lazy = not (isStrictId bndr) + occ_info = idOccInfo old_bndr unfolding = idUnfolding bndr uf_opts = seUnfoldingOpts env phase = sePhase env @@ -1608,37 +1601,51 @@ in allocation if you miss this out. And bits of GHC itself start to allocate more. An egregious example is test perf/compiler/T14697, where GHC.Driver.CmdLine.$wprocessArgs allocated hugely more. -Note [Suppress exponential blowup] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In #13253, and several related tickets, we got an exponential blowup -in code size from postInlineUnconditionally. The trouble comes when -we have - let j1a = case f y of { True -> p; False -> q } - j1b = case f y of { True -> q; False -> p } - j2a = case f (y+1) of { True -> j1a; False -> j1b } - j2b = case f (y+1) of { True -> j1b; False -> j1a } - ... - in case f (y+10) of { True -> j10a; False -> j10b } - -when there are many branches. In pass 1, postInlineUnconditionally -inlines j10a and j10b (they are both small). Now we have two calls -to j9a and two to j9b. In pass 2, postInlineUnconditionally inlines -all four of these calls, leaving four calls to j8a and j8b. Etc. -Yikes! This is exponential! - -A possible plan: stop doing postInlineUnconditionally -for some fixed, smallish number of branches, say 4. But that turned -out to be bad: see Note [Inline small things to avoid creating a thunk]. -And, as it happened, the problem with #13253 was solved in a -different way (Note [Duplicating StrictArg] in Simplify). - -So I just set an arbitrary, high limit of 100, to stop any -totally exponential behaviour. - -This still leaves the nasty possibility that /ordinary/ inlining (not -postInlineUnconditionally) might inline these join points, each of -which is individually quiet small. I'm still not sure what to do -about this (e.g. see #15488). +Note [Post-inline for single-use things] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If we have + + let x = rhs in ...x... + +and `x` is used exactly once, and not inside a lambda, then we will usually +preInlineUnconditinally. But we can still get this situation in +postInlineUnconditionally: + + case K rhs of K x -> ...x.... + +Here we'll use `simplAuxBind` to bind `x` to (the already-simplified) `rhs`; +and `x` is used exactly once. It's beneficial to inline right away; otherwise +we risk creating + + let x = rhs in ...x... + +which will take another iteration of the Simplifier to eliminate. We do this in +two places + +1. In the full `postInlineUnconditionally` look for the special case + of "one occurrence, not under a lambda", and inline unconditionally then. + + This is a bit risky: see Note [Avoiding simplifying repeatedly] in + Simplify.Iteration. But in practice it seems to be a small win. + +2. `simplAuxBind` does a kind of poor-man's `postInlineUnconditionally`. It + does not need to account for many of the cases (e.g. top level) that the + full `postInlineUnconditionally` does. Moreover, we don't have an + OutId, which `postInlineUnconditionally` needs. I got a slight improvement + in compiler performance when I added this test. + +Here's an example that we don't currently handle well: + let f = if b then Left (\x.BIG) else Right (\y.BIG) + in \y. ....case f of {...} .... +Here f is used just once, and duplicating the case work is fine (exprIsCheap). +But + - We can't preInlineUnconditionally because that would invalidate + the occ info for b. + - We can't postInlineUnconditionally because the RHS is big, and + that risks exponential behaviour + - We can't call-site inline, because the rhs is big +Alas! + Note [Top level and postInlineUnconditionally] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -512,6 +512,12 @@ do_beta_by_substitution bndr rhs = exprIsTrivial rhs -- Can duplicate || safe_to_inline (idOccInfo bndr) -- Occurs at most once +do_case_elim :: CoreExpr -> Id -> [Id] -> Bool +do_case_elim scrut case_bndr alt_bndrs + = exprIsHNF scrut + && safe_to_inline (idOccInfo case_bndr) + && all isDeadBinder alt_bndrs + ------------------- simple_out_bind :: TopLevelFlag -> SimpleOptEnv @@ -1290,13 +1296,17 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr in go subst' (float:floats) expr cont go subst floats (Case scrut b _ [Alt con vars expr]) cont + | do_case_elim scrut' b vars -- See Note [Case elim in exprIsConApp_maybe] + = go (extend subst b scrut') floats expr cont + | otherwise = let - scrut' = subst_expr subst scrut (subst', b') = subst_bndr subst b (subst'', vars') = subst_bndrs subst' vars float = FloatCase scrut' b' con vars' in go subst'' (float:floats) expr cont + where + scrut' = subst_expr subst scrut go (Right sub) floats (Var v) cont = go (Left (getSubstInScope sub)) @@ -1417,6 +1427,27 @@ dealWithStringLiteral fun str co = in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co {- +Note [Case elim in exprIsConApp_maybe] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + data K a = MkK !a + + $WMkK x = case x of y -> K y -- Wrapper for MkK + + ...case $WMkK v of K w -> + +We call `exprIsConApp_maybe` on ($WMkK v); we inline the wrapper +and beta-reduce, so we get to + exprIsConApp_maybe (case v of y -> K y) + +So we may float the case, and end up with + case v of y -> [y/w] + +But if `v` is already evaluated, the next run of the Simplifier will +eliminate the case, and we may then make more progress with . +Better to do it in one iteration. Hence the `do_case_elim` +check in `exprIsConApp_maybe`. + Note [Unfolding DFuns] ~~~~~~~~~~~~~~~~~~~~~~ DFuns look like ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -152,7 +152,7 @@ data Type -- for example unsaturated type synonyms -- can appear as the right hand side of a type synonym. - | ForAllTy + | ForAllTy -- See Note [Weird typing rule for ForAllTy] {-# UNPACK #-} !ForAllTyBinder Type -- ^ A Π type. -- Note [When we quantify over a coercion variable] @@ -938,9 +938,15 @@ instance Outputable Coercion where ppr = pprCo instance Outputable CoSel where - ppr (SelTyCon n _r) = text "Tc" <> parens (int n) - ppr SelForAll = text "All" - ppr (SelFun fs) = text "Fun" <> parens (ppr fs) + ppr (SelTyCon n r) = text "Tc" <> parens (int n <> comma <> pprOneCharRole r) + ppr SelForAll = text "All" + ppr (SelFun fs) = text "Fun" <> parens (ppr fs) + + +pprOneCharRole :: Role -> SDoc +pprOneCharRole Nominal = char 'N' +pprOneCharRole Representational = char 'R' +pprOneCharRole Phantom = char 'P' instance Outputable FunSel where ppr SelMult = text "mult" @@ -1054,7 +1060,7 @@ SelTyCon, SelForAll, and SelFun. r = tyConRole tc r0 i i < n (i is zero-indexed) ---------------------------------- - SelCo (SelTyCon i r) : si ~r ti + SelCo (SelTyCon i r) co : si ~r ti "Not a newtype": see Note [SelCo and newtypes] "Not an arrow type": see SelFun below @@ -1074,17 +1080,17 @@ SelTyCon, SelForAll, and SelFun. co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2) r = funRole r0 SelMult ---------------------------------- - SelCo (SelFun SelMult) : m1 ~r m2 + SelCo (SelFun SelMult) co : m1 ~r m2 co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2) r = funRole r0 SelArg ---------------------------------- - SelCo (SelFun SelArg) : s1 ~r s2 + SelCo (SelFun SelArg) co : s1 ~r s2 co : (s1 %{m1}-> t1) ~r0 (s2 %{m2}-> t2) r = funRole r0 SelRes ---------------------------------- - SelCo (SelFun SelRes) : t1 ~r t2 + SelCo (SelFun SelRes) co : t1 ~r t2 Note [FunCo] ~~~~~~~~~~~~ @@ -1167,11 +1173,11 @@ because the kinds of the bound tyvars can be different. The typing rule is: - kind_co : k1 ~ k2 - tv1:k1 |- co : t1 ~ t2 + kind_co : k1 ~N k2 + tv1:k1 |- co : t1 ~r t2 ------------------------------------------------------------------- - ForAllCo tv1 kind_co co : all tv1:k1. t1 ~ - all tv1:k2. (t2[tv1 |-> tv1 |> sym kind_co]) + ForAllCo tv1 kind_co co : all tv1:k1. t1 ~r + all tv1:k2. (t2[tv1 := (tv1 |> sym kind_co)]) First, the TyCoVar stored in a ForAllCo is really an optimisation: this field should be a Name, as its kind is redundant. Thinking of the field as a Name ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -256,17 +256,18 @@ inlineBoringOk e calcUnfoldingGuidance :: UnfoldingOpts + -> Bool -- This is a join point -> Bool -- Definitely a top-level, bottoming binding -> CoreExpr -- Expression to look at -> UnfoldingGuidance -calcUnfoldingGuidance opts is_top_bottoming (Tick t expr) +calcUnfoldingGuidance opts is_join is_top_bottoming (Tick t expr) | not (tickishIsCode t) -- non-code ticks don't matter for unfolding - = calcUnfoldingGuidance opts is_top_bottoming expr -calcUnfoldingGuidance opts is_top_bottoming expr + = calcUnfoldingGuidance opts is_join is_top_bottoming expr +calcUnfoldingGuidance opts is_join is_top_bottoming expr = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of TooBig -> UnfNever SizeIs size cased_bndrs scrut_discount - | uncondInline expr n_val_bndrs size + | uncondInline is_join expr n_val_bndrs size -> UnfWhen { ug_unsat_ok = unSaturatedOk , ug_boring_ok = boringCxtOk , ug_arity = n_val_bndrs } -- Note [INLINE for small functions] @@ -432,11 +433,12 @@ sharing the wrapper closure. The solution: don’t ignore coercion arguments after all. -} -uncondInline :: CoreExpr -> Arity -> Int -> Bool +uncondInline :: Bool -> CoreExpr -> Arity -> Int -> Bool -- Inline unconditionally if there no size increase -- Size of call is arity (+1 for the function) -- See Note [INLINE for small functions] -uncondInline rhs arity size +uncondInline is_join rhs arity size + | is_join = size < 10 | arity > 0 = size <= 10 * (arity + 1) -- See Note [INLINE for small functions] (1) | otherwise = exprIsTrivial rhs -- See Note [INLINE for small functions] (4) @@ -594,6 +596,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr DataConWorkId dc -> conSize dc (length val_args) PrimOpId op _ -> primOpSize op (length val_args) ClassOpId {} -> classOpSize opts top_args val_args + JoinId {} -> sizeZero -- See Note [Inlining join points] _ -> funSize opts top_args fun (length val_args) voids ------------ @@ -685,6 +688,7 @@ callSize n_val_args voids = 10 * (1 + n_val_args - voids) -- Add 1 for each non-trivial arg; -- the allocation cost, as in let(rec) +{- -- | The size of a jump to a join point jumpSize :: Int -- ^ number of value args @@ -695,6 +699,7 @@ jumpSize n_val_args voids = 2 * (1 + n_val_args - voids) -- bug #6048, but making them any more expensive loses a 21% improvement in -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a -- better solution? +-} funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize -- Size for functions that are not constructors or primops @@ -705,9 +710,9 @@ funSize opts top_args fun n_val_args voids | otherwise = SizeIs size arg_discount res_discount where some_val_args = n_val_args > 0 - is_join = isJoinId fun +-- is_join = isJoinId fun - size | is_join = jumpSize n_val_args voids + size -- | is_join = jumpSize n_val_args voids | not some_val_args = 0 | otherwise = callSize n_val_args voids @@ -772,6 +777,21 @@ win", but its terribly dangerous because a function with many many case branches, each finishing with a constructor, can have an arbitrarily large discount. This led to terrible code bloat: see #6099. +Note [Inlining join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + join j1 a b c d = blah + join j2 x = j1 x v x w + in ...(jump j2 t).... + +Then j1 is just an indirection to j1 with a bit of argument shuffling. +We want to inline it even though it has more arguments: + join j1 a b c d = blah + in ...(jump j1 t v t w)... + +So we charge nothing for join-point calls; a bit like we make constructor +applications cheap (see Note [Constructor size and result discount]). + Note [Unboxed tuple size and result discount] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ However, unboxed tuples count as size zero. I found occasions where we had ===================================== compiler/GHC/Core/Unfold/Make.hs ===================================== @@ -117,7 +117,7 @@ mkWorkerUnfolding opts work_fn = mkCoreUnfolding src top_lvl new_tmpl Nothing guidance where new_tmpl = simpleOptExpr opts (work_fn tmpl) - guidance = calcUnfoldingGuidance (so_uf_opts opts) False new_tmpl + guidance = calcUnfoldingGuidance (so_uf_opts opts) False False new_tmpl mkWorkerUnfolding _ _ _ = noUnfolding @@ -328,7 +328,7 @@ mkUnfolding opts src top_lvl is_bottoming expr cache = mkCoreUnfolding src top_lvl expr cache guidance where is_top_bottoming = top_lvl && is_bottoming - guidance = calcUnfoldingGuidance opts is_top_bottoming expr + guidance = calcUnfoldingGuidance opts False is_top_bottoming expr -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))! -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression] ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -263,41 +263,28 @@ mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) -- | Wrap the given expression in the coercion safely, dropping -- identity coercions and coalescing nested coercions mkCast :: HasDebugCallStack => CoreExpr -> CoercionR -> CoreExpr -mkCast e co - | assertPpr (coercionRole co == Representational) - (text "coercion" <+> ppr co <+> text "passed to mkCast" - <+> ppr e <+> text "has wrong role" <+> ppr (coercionRole co)) $ - isReflCo co - = e - -mkCast (Coercion e_co) co - | isCoVarType (coercionRKind co) - -- The guard here checks that g has a (~#) on both sides, - -- otherwise decomposeCo fails. Can in principle happen - -- with unsafeCoerce - = Coercion (mkCoCast e_co co) - -mkCast (Cast expr co2) co - = warnPprTrace (let { from_ty = coercionLKind co; - to_ty2 = coercionRKind co2 } in - not (from_ty `eqType` to_ty2)) - "mkCast" - (vcat ([ text "expr:" <+> ppr expr - , text "co2:" <+> ppr co2 - , text "co:" <+> ppr co ])) $ - mkCast expr (mkTransCo co2 co) - -mkCast (Tick t expr) co - = Tick t (mkCast expr co) mkCast expr co - = let from_ty = coercionLKind co in - warnPprTrace (not (from_ty `eqType` exprType expr)) + = assertPpr (coercionRole co == Representational) + (text "coercion" <+> ppr co <+> text "passed to mkCast" + <+> ppr expr <+> text "has wrong role" <+> ppr (coercionRole co)) $ + warnPprTrace (not (coercionLKind co `eqType` exprType expr)) "Trying to coerce" (text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ ppr (coercionType co) $$ callStackDoc) $ - (Cast expr co) + case expr of + Cast expr co2 -> mkCast expr (mkTransCo co2 co) + Tick t expr -> Tick t (mkCast expr co) + + Coercion e_co | isCoVarType (coercionRKind co) + -- The guard here checks that g has a (~#) on both sides, + -- otherwise decomposeCo fails. Can in principle happen + -- with unsafeCoerce + -> Coercion (mkCoCast e_co co) + + _ | isReflCo co -> expr + | otherwise -> Cast expr co {- ********************************************************************* ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -325,6 +325,11 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of go _ = Nothing trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +{-# INLINE trvVarInfo #-} +-- This function is called a lot and we want to specilise it, not only +-- for the type class, but also for its 'f' function argument. +-- Before the INLINE pragma it sometimes inlined and sometimes didn't, +-- depending delicately on GHC's optimisations. Better to use a pragma. trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x = set_vi <$> f (lookupVarInfo ts x) where ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1872,8 +1872,8 @@ ppr_co _ (IfaceUnivCo prov role ty1 ty2) ppr_co ctxt_prec (IfaceInstCo co ty) = maybeParen ctxt_prec appPrec $ - text "Inst" <+> pprParendIfaceCoercion co - <+> pprParendIfaceCoercion ty + text "Inst" <+> sep [ pprParendIfaceCoercion co + , pprParendIfaceCoercion ty ] ppr_co ctxt_prec (IfaceAxiomRuleCo tc cos) = maybeParen ctxt_prec appPrec $ ppr tc <+> parens (interpp'SP cos) ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1778,7 +1778,7 @@ tcUnfolding toplvl name _ info (IfCoreUnfold src cache if_guidance if_expr) ; expr <- tcUnfoldingRhs (isCompulsorySource src) toplvl name if_expr ; let guidance = case if_guidance of IfWhen arity unsat_ok boring_ok -> UnfWhen arity unsat_ok boring_ok - IfNoGuidance -> calcUnfoldingGuidance uf_opts is_top_bottoming expr + IfNoGuidance -> calcUnfoldingGuidance uf_opts False is_top_bottoming expr -- See Note [Tying the 'CoreUnfolding' knot] ; return $ mkCoreUnfolding src True expr (Just cache) guidance } where ===================================== testsuite/tests/perf/compiler/T15630.hs ===================================== @@ -1,5 +1,28 @@ module T15630 where +{- This is a fansastic test cose. + +* It scales really easily (just add or remove fields). + +* It can demonstrate massive (exponental) blow up if you get inlining + for join points wrong. + +* I found that a more monomorphic variant, T15630a, tickled a very similar + exponential -blowup, but somehow in a slighlty different way. To be specific, + at the time of writing, HEAD was fine on T15630, but blew up on T15630a. + So both tests are valuable. + +* Also worth noting: even if it doesn't blow up, it can result in two + very different programs. Below are the good and bad versions for 5 + fields. Note that the good version passes Maybes to the join points, + the ultimate values of the fields. But the bad version passes an + accumulating *function* to the join points. Lots of PAPs much less + efficient. + +See Note [Do not add unfoldings to join points at birth] in +GHc.Core.Opt.Simplify.Iteration. +-} + data IValue = IDefault | IInt Int | IBlob String @@ -54,3 +77,220 @@ getMenuItem vs = fst $ (pure TestStructure, vs) <+> (getInt ?) <+> (getInt ?) <+> (getString ?) + + +{- +------------- The good version (5 fields) ---------------- +getMenuItem + = \ (vs_az6 :: [IValue]) -> + case vs_az6 of { + [] -> case T15630.<+>1 of wild1_00 { }; + : v_az3 vs1_az4 -> + case vs1_az4 of { + [] -> case T15630.<+>1 of wild2_00 { }; + : v1_X4 vs2_X5 -> + case vs2_X5 of { + [] -> case T15630.<+>1 of wild3_00 { }; + : v2_X7 vs3_X8 -> + case vs3_X8 of { + [] -> case T15630.<+>1 of wild4_00 { }; + : v3_Xa vs4_Xb -> + case vs4_Xb of { + [] -> case T15630.<+>1 of wild5_00 { }; + : v4_Xd vs5_Xe -> + case v_az3 of { + __DEFAULT -> T15630.getMenuItem1; + IInt i_ayQ -> + join { + $j_sPO [Dmd=MC(1,L)] :: Maybe String -> Either () TestStructure + [LclId[JoinId(1)(Nothing)], Arity=1, Str=, Unf=OtherCon []] + $j_sPO (y_Xf [OS=OneShot] :: Maybe String) + = join { + $j1_sPR [Dmd=MC(1,L)] :: Maybe Int -> Either () TestStructure + [LclId[JoinId(1)(Nothing)], Arity=1, Str=, Unf=OtherCon []] + $j1_sPR (y1_Xg [OS=OneShot] :: Maybe Int) + = case v3_Xa of { + IDefault -> + case v4_Xd of { + IDefault -> + Data.Either.Right + @() + @TestStructure + (T15630.TestStructure + i_ayQ + y_Xf + y1_Xg + (Nothing @String) + (Nothing @Int)); + IInt i1_Xk -> + Data.Either.Right + @() + @TestStructure + (T15630.TestStructure + i_ayQ + y_Xf + y1_Xg + (Nothing @String) + (Just @Int i1_Xk)); + IBlob ipv_sPo -> T15630.getMenuItem1 + }; + IInt ipv_sPm -> T15630.getMenuItem1; + IBlob b_ayW -> + case v4_Xd of { + IDefault -> + Data.Either.Right + @() + @TestStructure + (T15630.TestStructure + i_ayQ + y_Xf + y1_Xg + (Just @String b_ayW) + (Nothing @Int)); + IInt i1_Xk -> + Data.Either.Right + @() + @TestStructure + (T15630.TestStructure + i_ayQ + y_Xf + y1_Xg + (Just @String b_ayW) + (Just @Int i1_Xk)); + IBlob ipv_sPo -> T15630.getMenuItem1 + } + } } in + case v2_X7 of { + IDefault -> jump $j1_sPR (Nothing @Int); + IInt i1_Xi -> jump $j1_sPR (Just @Int i1_Xi); + IBlob ipv_sPk -> T15630.getMenuItem1 + } } in + case v1_X4 of { + IDefault -> jump $j_sPO (Nothing @String); + IInt ipv_sPi -> T15630.getMenuItem1; + IBlob b_ayW -> jump $j_sPO (Just @String b_ayW) + }}}}}}} + + +------------- The bad version ---------------- +getMenuItem + = \ (vs_azD :: [IValue]) -> + case vs_azD of { + [] -> case T15630.<+>1 of wild1_00 { }; + : v_azA vs1_azB -> + case vs1_azB of { + [] -> case T15630.<+>1 of wild2_00 { }; + : v1_X5 vs2_X6 -> + case vs2_X6 of { + [] -> case T15630.<+>1 of wild3_00 { }; + : v2_X9 vs3_Xa -> + case vs3_Xa of { + [] -> case T15630.<+>1 of wild4_00 { }; + : v3_Xd vs4_Xe -> + case vs4_Xe of { + [] -> case T15630.<+>1 of wild5_00 { }; + : v4_Xh vs5_Xi -> + case v_azA of { + __DEFAULT -> T15630.getMenuItem1; + IInt i_azn -> + join { + $j_sQw [Dmd=MC(1,L)] + :: (Maybe String -> Maybe Int -> TestStructure) + -> Either () TestStructure + [LclId[JoinId(1)(Nothing)], + Arity=1, + Str=, + Unf=OtherCon []] + $j_sQw (f_aPr [OS=OneShot] + :: Maybe String -> Maybe Int -> TestStructure) + = case v3_Xd of { + IDefault -> + case v4_Xh of { + IDefault -> + Data.Either.Right + @() + @TestStructure + (f_aPr + (Nothing @String) + (Nothing @Int)); + IInt i1_Xl -> + Data.Either.Right + @() + @TestStructure + (f_aPr + (Nothing @String) + (Just @Int i1_Xl)); + IBlob ipv_sPM -> T15630.getMenuItem1 + }; + IInt ipv_sPK -> T15630.getMenuItem1; + IBlob b_azt -> + case v4_Xh of { + IDefault -> + Data.Either.Right + @() + @TestStructure + (f_aPr + (Just @String b_azt) + (Nothing @Int)); + IInt i1_Xl -> + Data.Either.Right + @() + @TestStructure + (f_aPr + (Just @String b_azt) + (Just @Int i1_Xl)); + IBlob ipv_sPM -> T15630.getMenuItem1 + } + } } in + case v1_X5 of { + IDefault -> + case v2_X9 of { + IDefault -> + jump $j_sQw + (\ (ds_dNN [OS=OneShot] :: Maybe String) + (ds1_dNO [OS=OneShot] :: Maybe Int) -> + T15630.TestStructure + i_azn + (Nothing @String) + (Nothing @Int) + ds_dNN + ds1_dNO); + IInt i1_Xk -> + jump $j_sQw + (\ (ds_dNN [OS=OneShot] :: Maybe String) + (ds1_dNO [OS=OneShot] :: Maybe Int) -> + T15630.TestStructure + i_azn + (Nothing @String) + (Just @Int i1_Xk) + ds_dNN + ds1_dNO); + IBlob ipv_sPI -> T15630.getMenuItem1 + }; + IInt ipv_sPG -> T15630.getMenuItem1; + IBlob b_azt -> + case v2_X9 of { + IDefault -> + jump $j_sQw + (\ (ds_Xl [OS=OneShot] :: Maybe String) + (ds1_Xm [OS=OneShot] :: Maybe Int) -> + T15630.TestStructure + i_azn + (Just @String b_azt) + (Nothing @Int) + ds_Xl + ds1_Xm); + IInt i1_Xk -> + jump $j_sQw + (\ (ds_Xm [OS=OneShot] :: Maybe String) + (ds1_Xn [OS=OneShot] :: Maybe Int) -> + T15630.TestStructure + i_azn + (Just @String b_azt) + (Just @Int i1_Xk) + ds_Xm + ds1_Xn); + IBlob ipv_sPI -> T15630.getMenuItem1 + }}}}}}}} + +-} ===================================== testsuite/tests/perf/compiler/T15630a.hs ===================================== @@ -0,0 +1,64 @@ +module T15630a where + +data IValue = IDefault + | IInt Int + | IBlob String + +(?) :: (IValue -> Either x a) -> IValue -> Either x (Maybe a) +-- With this NOINLINE pragma we get good behaviour, but disastrous without +-- {-# NOINLINE [0] (?) #-} +(?) _ IDefault = pure Nothing +(?) p x = Just <$> p x + +getInt :: IValue -> Either () Int +{-# NOINLINE getInt #-} +getInt (IInt i) = Right i +getInt v = Left () + +getString :: IValue -> Either () String +{-# NOINLINE getString #-} +getString (IBlob b) = Right $ b +getString v = Left () + +(<+>) :: (Either x (a -> b), [IValue]) -> (IValue -> Either x a) -> (Either x b, [IValue]) +(<+>) (f, (v:vs)) p = (f <*> (p v), vs) + +data TestStructure = TestStructure + { _param1 :: Int + , _param2 :: Maybe String + , _param3 :: Maybe Int + , _param4 :: Maybe String + , _param5 :: Maybe Int + , _param6 :: Maybe Int + + , _param7 :: Maybe String + , _param8 :: Maybe String + , _param9 :: Maybe Int + , _param10 :: Maybe Int + , _param11 :: Maybe String + , _param12 :: Maybe String + , _param13 :: Maybe Int + , _param14 :: Maybe Int + , _param15 :: Maybe String + + } + +getMenuItem :: [IValue] -> Either () TestStructure +getMenuItem vs = fst $ (pure TestStructure, vs) + <+> getInt + <+> (getString ?) + <+> (getInt ?) + <+> (getString ?) + <+> (getInt ?) + <+> (getInt ?) + + <+> (getString ?) + <+> (getString ?) + <+> (getInt ?) + <+> (getInt ?) + <+> (getString ?) + <+> (getString ?) + <+> (getInt ?) + <+> (getInt ?) + <+> (getString ?) + ===================================== testsuite/tests/simplCore/should_compile/T18730.hs → testsuite/tests/perf/compiler/T18730.hs ===================================== ===================================== testsuite/tests/simplCore/should_compile/T18730_A.hs → testsuite/tests/perf/compiler/T18730_A.hs ===================================== ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -202,6 +202,15 @@ test('CoOpt_Singletons', ######### +# Moved from simplCore/should_compile +test('T18730', + [ only_ways(['optasm']) + , collect_compiler_stats('bytes allocated',1) + , extra_files(['T8730_aux.hs']) + ], + multimod_compile, + ['T18730_A', '-v0 -O']) + test ('LargeRecord', [ only_ways(['normal']), collect_compiler_stats('bytes allocated',1) @@ -527,6 +536,11 @@ test('T15630', ], compile, ['-O2']) +test('T15630a', + [collect_compiler_stats() + ], + compile, + ['-O2']) # See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_186960 test ('WWRec', ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -341,7 +341,6 @@ test('T18603', normal, compile, ['-dcore-lint -O']) # T18649 should /not/ generate a specialisation rule test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) -test('T18730', normal, multimod_compile, ['T18730_A', '-dcore-lint -O']) test('T18747A', normal, compile, ['']) test('T18747B', normal, compile, ['']) test('T18815', only_ways(['optasm']), makefile_test, ['T18815']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8fc0f2b29ed83b26d59c59fdebffeea97225cc1c...be385269dafbad2d3af3347afac4690b4f9f4933 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8fc0f2b29ed83b26d59c59fdebffeea97225cc1c...be385269dafbad2d3af3347afac4690b4f9f4933 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 16:48:33 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 12 Jul 2023 12:48:33 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: ghc-toolchain: Toolchain Selection Message-ID: <64aed96151b_3f5efc65c9ff83491e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 3dda3947 by Rodrigo Mesquita at 2023-07-12T17:48:14+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain leftovers Delete a part Use ghc-platform instead of ghc-boot - - - - - b9056ee8 by Rodrigo Mesquita at 2023-07-12T17:48:14+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 174c4ac6 by Rodrigo Mesquita at 2023-07-12T17:48:14+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.host.target.in - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/Common.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e7431ef598a117763a2bcf4429c103978443fe3...174c4ac600a07d066d31be6654a4475dab2d15aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e7431ef598a117763a2bcf4429c103978443fe3...174c4ac600a07d066d31be6654a4475dab2d15aa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 16:57:58 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 12 Jul 2023 12:57:58 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - Blame the binding body but keep the error context about the statement in addArgCtxt Message-ID: <64aedb96352c3_3f5efc65c9ff835284a@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 85d28d95 by Apoorv Ingle at 2023-07-12T11:56:53-05:00 - Blame the binding body but keep the error context about the statement in addArgCtxt - - - - - 1 changed file: - compiler/GHC/Tc/Gen/App.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -747,10 +747,11 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside setSrcSpanA loc $ addStmtCtxt ((text "addArgCtxt 2e")) stmt $ thing_inside - VAExpansionStmt (L _ (BindStmt _ _ (L body_loc body))) + VAExpansionStmt stmt@(L _ (BindStmt _ _ (L body_loc _))) -> do traceTc "addArgCtxt 2e bind" empty setSrcSpanA body_loc $ - addExprCtxt ((text "addArgCtxt body 2e")) body $ + -- addExprCtxt ((text "addArgCtxt body 2e")) body $ + addStmtCtxt ((text "addArgCtxt body 2e")) stmt $ thing_inside VAExpansionStmt (L _ (LetStmt {})) -- TODO: Do nothing for let statements for now? -> do traceTc "addArgCtxt 2e let" empty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85d28d95326ec9474d33cefc2f4bfb18b4e089e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85d28d95326ec9474d33cefc2f4bfb18b4e089e7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 19:01:51 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 12 Jul 2023 15:01:51 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] EPA: getting rid of tweakDelta Message-ID: <64aef89f3ee3e_3f5efc1cb10a78378969@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 3163f815 by Alan Zimmerman at 2023-07-12T20:00:56+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 4 changed files: - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Transform.hs - utils/check-exact/Utils.hs Changes: ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -109,9 +109,9 @@ runEP epReader action = do defaultEPState :: EPState defaultEPState = EPState { epPos = (1,1) - , dLHS = 1 + , dLHS = 0 , pMarkLayout = False - , pLHS = 1 + , pLHS = 0 , dMarkLayout = False , dPriorEndPosition = (1,1) , uAnchorSpan = badRealSrcSpan @@ -519,23 +519,12 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do -- ------------------------------------------------------------------- -- start of print phase processing - let mflush = when (flush == FlushComments) $ do - debugM $ "flushing comments in enterAnn:" ++ showAst cs - flushComments (getFollowingComments cs) - advance edp a' <- exact a - mflush - - -- end of sub-Anchor processing, start of tail end processing - -- postCs <- cua canUpdateAnchor takeAppliedCommentsPop - -- when (flush == NoFlushComments) $ do - -- when ((getFollowingComments cs) /= []) $ do - - -- debugM $ "enterAnn:in:(anchor') =" ++ show (eloc2str anchor') - -- debugM $ "starting trailing comments:" ++ showAst (getFollowingComments cs) - -- mapM_ printOneComment (map tokComment $ getFollowingComments cs) - -- debugM $ "ending trailing comments" + when (flush == FlushComments) $ do + debugM $ "flushing comments in enterAnn:" ++ showAst cs + flushComments (getFollowingComments cs) + debugM $ "flushing comments in enterAnn done" eof <- getEofPos case eof of @@ -544,19 +533,19 @@ enterAnn (Entry anchor' trailing_anns cs flush canUpdateAnchor) a = do let dp = if pos == prior then (DifferentLine 1 0) else origDelta pos prior - debugM $ "EOF:(pos,prior,dp) =" ++ showGhc (ss2pos pos, ss2pos prior, dp) + debugM $ "EOF:(pos,posEnd,prior,dp) =" ++ showGhc (ss2pos pos, ss2posEnd pos, ss2pos prior, dp) printStringAtLsDelta dp "" setEofPos Nothing -- Only do this once -- Deal with exit from the current anchor - printCommentsIn curAnchor -- Make sure all comments in the span are printed + when (flush == NoFlushComments) $ do + printCommentsIn curAnchor -- Make sure all comments in the span are printed p1 <- getPosP pe1 <- getPriorEndD debugM $ "enterAnn:done:(anchor',p,pe,a) =" ++ show (eloc2str anchor', p1, pe1, astId a') case anchor' of - -- EpaDelta _ _ -> setPriorEndD p1 EpaDelta _ _ -> return () EpaSpan (RealSrcSpan rss _) -> do setAcceptSpan False @@ -623,6 +612,7 @@ flushComments trailing_anns = do -- AZ:TODO: is the sort still needed? then mapM_ printOneComment (sortComments cs) else mapM_ (printOneComment . commentOrigDelta') cs + putUnallocatedComments [] debugM $ "flushing comments done" -- --------------------------------------------------------------------- @@ -1429,15 +1419,12 @@ printOneComment c@(Comment _str loc _r _mo) = do dp' <- case mep of Just (EpaDelta edp _) -> do debugM $ "printOneComment:edp=" ++ show edp - ddd <- fmap unTweakDelta $ adjustDeltaForOffsetM edp - debugM $ "printOneComment:ddd=" ++ show ddd - fmap unTweakDelta $ adjustDeltaForOffsetM edp + adjustDeltaForOffsetM edp _ -> return dp -- Start of debug printing LayoutStartCol dOff <- getLayoutOffsetD debugM $ "printOneComment:(dp,dp',dOff,loc)=" ++ showGhc (dp,dp',dOff,loc) -- End of debug printing - -- setPriorEndD (ss2posEnd (anchor loc)) updateAndApplyComment c dp' printQueuedComment c dp' @@ -1451,18 +1438,11 @@ unTweakDelta (DifferentLine l d) = DifferentLine l (d+1) updateAndApplyComment :: (Monad m, Monoid w) => Comment -> DeltaPos -> EP w m () updateAndApplyComment (Comment str anc pp mo) dp = do - -- debugM $ "updateAndApplyComment: (dp,anc',co)=" ++ showAst (dp,anc',co) applyComment (Comment str anc' pp mo) where - -- anc' = anc { anchor_op = op} anc' = op (r,c) = ss2posEnd pp - -- la = anchor anc - -- dp'' = if r == 0 - -- then (ss2delta (r,c+0) la) - -- else (ss2delta (r,c) la) - -- la = anchor anc dp'' = case anc of EpaDelta dp1 _ -> dp1 EpaSpan (RealSrcSpan la _) -> @@ -1551,7 +1531,6 @@ instance (ExactPrint a) => ExactPrint (LocatedA a) where exact (L la a) = do debugM $ "LocatedA a:la loc=" ++ show (ss2range $ locA la) a' <- markAnnotated a - -- la' <- markALocatedA la return (L la a') instance (ExactPrint a) => ExactPrint (LocatedAn NoEpAnns a) where @@ -1638,8 +1617,6 @@ instance ExactPrint (HsModule GhcPs) where Just (pos, prior) -> do debugM $ "am_eof:" ++ showGhc (pos, prior) setEofPos (Just (pos, prior)) - -- let dp = origDelta pos prior - -- printStringAtLsDelta dp "" let anf = an0 { anns = (anns an0) { am_decls = am_decls' }} debugM $ "HsModule, anf=" ++ showAst anf @@ -2567,13 +2544,6 @@ instance ExactPrint (HsValBindsLR GhcPs GhcPs) where setAnnotationAnchor a _ _ _ = a exact (ValBinds sortKey binds sigs) = do - -- ds <- setLayoutBoth $ withSortKeyBind sortKey - -- (prepareListAnnotationA (bagToList binds) - -- ++ prepareListAnnotationA sigs - -- ) - -- let - -- binds' = listToBag $ undynamic ds - -- sigs' = undynamic ds setLayoutBoth $ mapM markAnnotated $ hsDeclsValBinds (ValBinds sortKey binds sigs) let binds' = binds @@ -2632,28 +2602,12 @@ prepareListAnnotationA ls = map (\b -> (realSrcSpan "aa5" $ getLocA b,go b)) ls b' <- markAnnotated b return (toDyn b') --- withSortKeyBind :: (Monad m, Monoid w) --- => AnnSortKey [(DeclTag, Int)] -> [(RealSrcSpan, EP w m Dynamic)] -> EP w m [Dynamic] --- withSortKeyBind annSortKey xs = do --- debugM $ "withSortKey:annSortKey=" ++ showAst annSortKey --- let ordered = case annSortKey of --- NoAnnSortKey -> sortBy orderByFst xs --- -- Just keys -> error $ "withSortKey: keys" ++ show keys --- AnnSortKey keys -> orderByKey xs keys --- -- `debug` ("withSortKey:" ++ --- -- showPprUnsafe (map fst (sortBy (comparing (flip elemIndex keys . fst)) xs), --- -- map fst xs, --- -- keys) --- -- ) --- mapM snd ordered - withSortKey :: (Monad m, Monoid w) => AnnSortKey [RealSrcSpan] -> [(RealSrcSpan, EP w m Dynamic)] -> EP w m [Dynamic] withSortKey annSortKey xs = do debugM $ "withSortKey:annSortKey=" ++ showAst annSortKey let ordered = case annSortKey of NoAnnSortKey -> sortBy orderByFst xs - -- Just keys -> error $ "withSortKey: keys" ++ show keys AnnSortKey keys -> orderByKey xs keys -- `debug` ("withSortKey:" ++ -- showPprUnsafe (map fst (sortBy (comparing (flip elemIndex keys . fst)) xs), @@ -5134,7 +5088,7 @@ setLayoutTopLevelP k = do debugM $ "setLayoutTopLevelP entered" oldAnchorOffset <- getLayoutOffsetP modify (\a -> a { pMarkLayout = False - , pLHS = 1} ) + , pLHS = 0} ) r <- k debugM $ "setLayoutTopLevelP:resetting" setLayoutOffsetP oldAnchorOffset ===================================== utils/check-exact/Main.hs ===================================== @@ -59,7 +59,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2) -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3) -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls) - -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2) + "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2) -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" (Just changeWhereIn3a) -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" (Just changeWhereIn3b) -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" Nothing @@ -69,7 +69,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" (Just addLocaLDecl4) -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" (Just addLocaLDecl5) -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just addLocaLDecl6) - "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1) + -- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" (Just rmDecl2) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" (Just rmDecl3) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl4.hs" (Just rmDecl4) @@ -100,6 +100,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Ppr008.hs" Nothing -- "../../testsuite/tests/printer/Ppr009.hs" Nothing -- "../../testsuite/tests/printer/Ppr011.hs" Nothing + -- "../../testsuite/tests/printer/Ppr011a.hs" Nothing -- "../../testsuite/tests/printer/Ppr012.hs" Nothing -- "../../testsuite/tests/printer/Ppr013.hs" Nothing -- "../../testsuite/tests/printer/Ppr014.hs" Nothing @@ -148,6 +149,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/PprRecordDotSyntax3.hs" Nothing -- "../../testsuite/tests/printer/PprRecordDotSyntax4.hs" Nothing -- "../../testsuite/tests/printer/PprRecordDotSyntaxA.hs" Nothing + -- "../../testsuite/tests/printer/PprUnicodeSyntax.hs" Nothing -- "../../testsuite/tests/printer/StarBinderAnns.hs" Nothing -- "../../testsuite/tests/printer/T13050p.hs" Nothing -- "../../testsuite/tests/printer/T13199.hs" Nothing @@ -534,7 +536,7 @@ changeLocalDecls libdir (L l p) = do os' = setEntryDP os (DifferentLine 2 0) let sortKey = captureOrderBinds decls let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van - let van' = (EpAnn anc (AnnList (Just (EpaDelta (DifferentLine 1 4) [])) a b c dd) cs) + let van' = (EpAnn anc (AnnList (Just (EpaDelta (DifferentLine 1 5) [])) a b c dd) cs) let binds' = (HsValBinds van' (ValBinds sortKey (listToBag $ decl':oldBinds) (sig':os':oldSigs))) @@ -558,8 +560,8 @@ changeLocalDecls2 libdir (L l p) = do replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do - let anc = (EpaDelta (DifferentLine 1 2) []) - let anc2 = (EpaDelta (DifferentLine 1 4) []) + let anc = (EpaDelta (DifferentLine 1 3) []) + let anc2 = (EpaDelta (DifferentLine 1 5) []) let an = EpAnn anc (AnnList (Just anc2) Nothing Nothing [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])] []) ===================================== utils/check-exact/Transform.hs ===================================== @@ -330,7 +330,7 @@ setEntryDP (L (EpAnnS (EpaSpan (RealSrcSpan r _)) an cs) a) dp csd = L (EpaDelta dp []) c:cs' lc = head $ reverse $ (L ca c:cs') delta = case getLoc lc of - EpaSpan (RealSrcSpan rr _) -> tweakDelta $ ss2delta (ss2pos rr) r + EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r _ -> DifferentLine 1 0 line = getDeltaLine delta col = deltaColumn delta @@ -383,9 +383,9 @@ setEntryDPI (L (SrcSpanAnn (EpAnn (EpaSpan (RealSrcSpan r _)) an cs) l) a) dp cs'' = setPriorComments cs (L (EpaDelta dp []) c:cs') lc = head $ reverse $ (L ca c:cs') delta = case getLoc lc of - EpaSpan (RealSrcSpan rr _) -> tweakDelta $ ss2delta (ss2pos rr) r - EpaSpan _ -> tweakDelta (SameLine 0) - EpaDelta dp _ -> tweakDelta dp + EpaSpan (RealSrcSpan rr _) -> ss2delta (ss2pos rr) r + EpaSpan _ -> (SameLine 0) + EpaDelta dp _ -> dp line = getDeltaLine delta col = deltaColumn delta edp' = if line == 0 then SameLine col @@ -1329,8 +1329,8 @@ oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = do newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn AnnList) newWhereAnnotation ww = do - let anc = EpaDelta (DifferentLine 1 2) [] - let anc2 = EpaDelta (DifferentLine 1 4) [] + let anc = EpaDelta (DifferentLine 1 3) [] + let anc2 = EpaDelta (DifferentLine 1 5) [] let w = case ww of WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0) [])] WithoutWhere -> [] ===================================== utils/check-exact/Utils.hs ===================================== @@ -48,8 +48,8 @@ import Types -- |Global switch to enable debug tracing in ghc-exactprint Delta / Print debugEnabledFlag :: Bool --- debugEnabledFlag = True -debugEnabledFlag = False +debugEnabledFlag = True +-- debugEnabledFlag = False -- |Provide a version of trace that comes at the end of the line, so it can -- easily be commented out when debugging different things. @@ -108,6 +108,7 @@ pos2delta (refl,refc) (l,c) = deltaPos lo co lo = l - refl co = if lo == 0 then c - refc else c + -- else c - 1 -- | Apply the delta to the current position, taking into account the -- current column offset if advancing to a new line @@ -193,21 +194,7 @@ commentOrigDelta' (Comment s (EpaSpan (RealSrcSpan la _)) pp co) commentOrigDelta' c = c origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos -origDelta pos pp = op - where - (r,c) = ss2posEnd pp - - op = if r == 0 - then ( ss2delta (r,c+1) pos) - else (tweakDelta $ ss2delta (r,c ) pos) - --- --------------------------------------------------------------------- - --- | For comment-related deltas starting on a new line we have an --- off-by-one problem. Adjust -tweakDelta :: DeltaPos -> DeltaPos -tweakDelta (SameLine d) = SameLine d -tweakDelta (DifferentLine l d) = DifferentLine l (d-1) +origDelta pos pp = ss2delta (ss2posEnd pp) pos -- --------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3163f815e39de9119553de75c2e7bd09c0177f35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3163f815e39de9119553de75c2e7bd09c0177f35 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 20:30:54 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 12 Jul 2023 16:30:54 -0400 Subject: [Git][ghc/ghc][wip/T22404] Simplify the shadowing case Message-ID: <64af0d7e25749_3f5efc365dcec3915f2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 63679314 by Simon Peyton Jones at 2023-07-12T21:27:21+01:00 Simplify the shadowing case - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2873,9 +2873,11 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points fix_up_uds (thing_inside env_w_bndrs) | otherwise -- Shadowing! Lots of things to do - = fix_up_uds $ add_bad_joins $ + = fix_up_uds $ + add_bad_joins $ thing_inside $ - drop_shadowed_swaps $ drop_shadowed_joins $ + drop_shadowed_swaps $ + drop_shadowed_joins $ env_w_bndrs where @@ -2891,7 +2893,8 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points drop_shadowed_joins :: OccEnv -> OccEnv -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) - drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs } +-- drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs } + drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } fix_up_uds :: WithUsageDetails a -> WithUsageDetails a -- Remove usage for bndrs @@ -2917,11 +2920,14 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points | uniq `elemUFM_Directly` ud_env uds = uds `andUDs` bad_join_uds | otherwise = uds + bad_joins = join_points +{- bad_joins, good_joins :: IdEnv UsageDetails (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points bad_join_rhs :: UsageDetails -> Bool bad_join_rhs (UD { ud_env = rhs_usage }) = any (`elemVarEnv` rhs_usage) bndrs +-} addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv addJoinPoint env bndr rhs_uds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6367931471a6386ad3f0362d8d4936442ca8048a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6367931471a6386ad3f0362d8d4936442ca8048a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 22:22:14 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 12 Jul 2023 18:22:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-improve-sl1 Message-ID: <64af27961583a_3f5efcb31c8400498@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-improve-sl1 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-improve-sl1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 12 23:33:40 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 12 Jul 2023 19:33:40 -0400 Subject: [Git][ghc/ghc][wip/T22404] More efficient now Message-ID: <64af3854a625d_3f5efc65c9ff840661@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 16ad0494 by Simon Peyton Jones at 2023-07-13T00:33:23+01:00 More efficient now - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2940,15 +2940,12 @@ addJoinPoint env bndr rhs_uds mkZeroedForm :: UsageDetails -> UsageDetails -- See Note [Occurrence analysis for join points] for "zeroed form" -mkZeroedForm rhs_uds@(UD { ud_env = rhs_occs }) - = emptyDetails { ud_env = mapMaybeWithKeyUFM do_one rhs_occs } +mkZeroedForm (UD { ud_env = rhs_occs }) + = emptyDetails { ud_env = mapMaybeUFM do_one rhs_occs } where - do_one :: Unique -> OccInfo -> Maybe OccInfo - do_one key occ = case doZappingByUnique rhs_uds key occ of - ManyOccs {} -> Nothing - occ@(OneOcc {}) -> Just (occ { occ_n_br = 0 }) - IAmDead -> pprPanic "addJoinPoint" (ppr key) - IAmALoopBreaker {} -> pprPanic "addJoinPoint" (ppr key) + do_one :: LocalOcc -> Maybe LocalOcc + do_one ManyOccL = Nothing + do_one (OneOccL _ ic) = Just (OneOccL 0 ic) -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet @@ -3369,10 +3366,11 @@ info then simply means setting the corresponding zapped set to the whole 'OccInfoEnv', a fast O(1) operation. -} -type OccInfoEnv = IdEnv OccInfo -- A finite map from an expression's - -- free variables to their usage - -- INVARIANT: never IAmDead, or IAmLoopBreaker - -- Deadness is signalled by not being in the map at all +type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's + -- free variables to their usage + +data LocalOcc = OneOccL {-# UNPACK #-} !Int !InterestingCxt + | ManyOccL type ZappedSet = OccInfoEnv -- Values are ignored @@ -3380,12 +3378,17 @@ data UsageDetails = UD { ud_env :: !OccInfoEnv , ud_z_many :: !ZappedSet -- apply 'markMany' to these , ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these - , ud_z_no_tail :: !ZappedSet } -- apply 'markNonTail' to these - -- INVARIANT: All three zapped sets are subsets of the OccInfoEnv + , ud_tail :: !(IdEnv TailCallInfo) + } + -- INVARIANT: Both zapped sets are subsets of ud_env instance Outputable UsageDetails where - ppr ud = ppr (ud_env (flattenUsageDetails ud)) - + ppr ud = text "UD" <+> (braces $ fsep $ punctuate comma $ + [ ppr uq <+> text ":->" <+> ppr (mkOccInfoByUnique ud uq local_occ) + | (uq, local_occ) <- nonDetStrictFoldVarEnv_Directly do_one [] (ud_env ud) ]) + where + do_one :: Unique -> LocalOcc -> [(Unique,LocalOcc)] -> [(Unique,LocalOcc)] + do_one uniq occ occs = (uniq, occ) : occs --------------------- -- | TailUsageDetails captures the result of applying 'occAnalLamTail' @@ -3409,7 +3412,7 @@ data WithTailUsageDetails a = WTUD !TailUsageDetails !a andUDs, orUDs :: UsageDetails -> UsageDetails -> UsageDetails -andUDs = combineUsageDetailsWith addOccInfo +andUDs = combineUsageDetailsWith andOccInfo orUDs = combineUsageDetailsWith orOccInfo mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails @@ -3426,15 +3429,13 @@ mkOneOcc !env id int_cxt arity = one_occ_uds where - one_occ_uds = emptyDetails { ud_env = unitVarEnv id one_occ_info } - one_occ_info = OneOcc { occ_in_lam = NotInsideLam - , occ_n_br = oneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled arity } + one_occ_uds = emptyDetails + { ud_env = unitVarEnv id (OneOccL 1 int_cxt) + , ud_tail = unitVarEnv id (AlwaysTailCalled arity) } addManyOccId :: UsageDetails -> Id -> UsageDetails -- Add the non-committal (id :-> noOccInfo) to the usage details -addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id noOccInfo } +addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id ManyOccL } -- Add several occurrences, assumed not to be tail calls addManyOcc :: Var -> UsageDetails -> UsageDetails @@ -3463,20 +3464,27 @@ emptyDetails :: UsageDetails emptyDetails = UD { ud_env = emptyVarEnv , ud_z_many = emptyVarEnv , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } + , ud_tail = emptyVarEnv } isEmptyDetails :: UsageDetails -> Bool isEmptyDetails = isEmptyVarEnv . ud_env delDetails :: UsageDetails -> [Id] -> UsageDetails -- Delete these binders from the UsageDetails -delDetails ud bndrs = ud `alterUsageDetails` (`delVarEnvList` bndrs) +delDetails (UD { ud_env = env + , ud_z_many = z_many + , ud_z_in_lam = z_in_lam + , ud_tail = tail }) bndrs + = UD { ud_env = env `delVarEnvList` bndrs + , ud_z_many = z_many `delVarEnvList` bndrs + , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs + , ud_tail = tail `delVarEnvList` bndrs } markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails markAllMany ud = ud { ud_z_many = ud_env ud } markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } -markAllNonTail ud = ud { ud_z_no_tail = ud_env ud } +markAllNonTail ud = ud { ud_tail = emptyVarEnv } markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3490,7 +3498,7 @@ markAllNonTailIf False ud = ud lookupDetails :: UsageDetails -> Id -> OccInfo lookupDetails ud id = case lookupVarEnv (ud_env ud) id of - Just occ -> doZapping ud id occ + Just occ -> mkOccInfo ud id occ Nothing -> IAmDead usedIn :: Id -> UsageDetails -> Bool @@ -3515,7 +3523,7 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs ------------------- -- Auxiliary functions for UsageDetails implementation -combineUsageDetailsWith :: (OccInfo -> OccInfo -> OccInfo) +combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails combineUsageDetailsWith plus_occ_info ud1 ud2 | isEmptyDetails ud1 = ud2 @@ -3524,35 +3532,34 @@ combineUsageDetailsWith plus_occ_info ud1 ud2 = UD { ud_env = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2) , ud_z_many = plusVarEnv (ud_z_many ud1) (ud_z_many ud2) , ud_z_in_lam = plusVarEnv (ud_z_in_lam ud1) (ud_z_in_lam ud2) - , ud_z_no_tail = plusVarEnv (ud_z_no_tail ud1) (ud_z_no_tail ud2) } + , ud_tail = plusVarEnv_C andTailCallInfo (ud_tail ud1) (ud_tail ud2) } -doZapping :: UsageDetails -> Var -> OccInfo -> OccInfo -doZapping ud var occ - = doZappingByUnique ud (varUnique var) occ +mkOccInfo :: UsageDetails -> Var -> LocalOcc -> OccInfo +mkOccInfo ud var occ = mkOccInfoByUnique ud (varUnique var) occ -doZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo -doZappingByUnique (UD { ud_z_many = many - , ud_z_in_lam = in_lam - , ud_z_no_tail = no_tail }) +mkOccInfoByUnique :: UsageDetails -> Unique -> LocalOcc -> OccInfo +mkOccInfoByUnique (UD { ud_z_many = z_many + , ud_z_in_lam = z_in_lam + , ud_tail = tail_env }) uniq occ - = occ2 + = case occ of + OneOccL n_br int_cxt + | not (uniq `elemVarEnvByKey`z_many) + -> OneOcc { occ_in_lam = in_lam + , occ_n_br = n_br + , occ_int_cxt = int_cxt + , occ_tail = tail } + + _other -- ManyOccL and zapped OneOccL + -> ManyOccs { occ_tail = tail } + where - occ1 | uniq `elemVarEnvByKey` many = markMany occ - | uniq `elemVarEnvByKey` in_lam = markInsideLam occ - | otherwise = occ - occ2 | uniq `elemVarEnvByKey` no_tail = markNonTail occ1 - | otherwise = occ1 - -alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails -alterUsageDetails !ud f - = UD { ud_env = f (ud_env ud) - , ud_z_many = f (ud_z_many ud) - , ud_z_in_lam = f (ud_z_in_lam ud) - , ud_z_no_tail = f (ud_z_no_tail ud) } - -flattenUsageDetails :: UsageDetails -> UsageDetails -flattenUsageDetails ud@(UD { ud_env = env }) - = emptyDetails { ud_env = mapUFM_Directly (doZappingByUnique ud) env } + tail = case lookupVarEnv_Directly tail_env uniq of + Nothing -> NoTailCallInfo + Just tc -> tc + + in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam + | otherwise = NotInsideLam ------------------- -- See Note [Adjusting right-hand sides] @@ -3833,44 +3840,21 @@ See Invariant 2a of Note [Invariants on join points] in GHC.Core ************************************************************************ -} -markMany, markInsideLam, markNonTail :: OccInfo -> OccInfo - -markMany IAmDead = IAmDead -markMany occ = ManyOccs { occ_tail = occ_tail occ } - -markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = IsInsideLam } -markInsideLam occ = occ - +markNonTail :: OccInfo -> OccInfo markNonTail IAmDead = IAmDead markNonTail occ = occ { occ_tail = NoTailCallInfo } -addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo +andOccInfo, orOccInfo :: LocalOcc -> LocalOcc -> LocalOcc -addOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } - -- Both branches are at least One - -- (Argument is never IAmDead) +andOccInfo _ _ = ManyOccL -- (orOccInfo orig new) is used -- when combining occurrence info from branches of a case -orOccInfo (OneOcc { occ_in_lam = in_lam1 - , occ_n_br = nbr1 - , occ_int_cxt = int_cxt1 - , occ_tail = tail1 }) - (OneOcc { occ_in_lam = in_lam2 - , occ_n_br = nbr2 - , occ_int_cxt = int_cxt2 - , occ_tail = tail2 }) - = OneOcc { occ_n_br = nbr1 + nbr2 - , occ_in_lam = in_lam1 `mappend` in_lam2 - , occ_int_cxt = int_cxt1 `mappend` int_cxt2 - , occ_tail = tail1 `andTailCallInfo` tail2 } - -orOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } +orOccInfo (OneOccL nbr1 int_cxt1) (OneOccL nbr2 int_cxt2) + = OneOccL (nbr1 + nbr2) (int_cxt1 `mappend` int_cxt2) + +orOccInfo _ _ = ManyOccL andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16ad0494646104fe1c3183210ef1f3ac775f021e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16ad0494646104fe1c3183210ef1f3ac775f021e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 00:03:03 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 12 Jul 2023 20:03:03 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - fix the location displayed for the errors that crop up during type checking LetStmt Message-ID: <64af3f37beeaa_3f5efcb3678407151@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: da56d434 by Apoorv Ingle at 2023-07-12T19:01:36-05:00 - fix the location displayed for the errors that crop up during type checking LetStmt - - - - - 7 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -459,15 +459,15 @@ data XXExprGhcRn {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcRn)) | ExpandedStmt {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (HsExpr GhcRn)) - | PopSrcSpan + | PopErrCtxt {-# UNPACK #-} !(LHsExpr GhcRn) -- Placeholder for identifying generated source locations in GhcRn phase -- Should not presist post typechecking -- Note [Expanding HsDo with HsExpansion] in GHC.Tc.Gen.Match -- | Wrap a located expression with a PopSrcExpr -mkPopSrcSpanExpr :: LHsExpr GhcRn -> HsExpr GhcRn -mkPopSrcSpanExpr a = XExpr (PopSrcSpan a) +mkPopErrCtxtExpr :: LHsExpr GhcRn -> HsExpr GhcRn +mkPopErrCtxtExpr a = XExpr (PopErrCtxt a) -- | Build a 'HsExpansion' out of an extension constructor, -- and the two components of the expansion: original and @@ -753,7 +753,7 @@ ppr_expr (XExpr x) = case ghcPass @p of instance Outputable XXExprGhcRn where ppr (ExpandedExpr ex) = whenPprDebug (text "[ExpandedExpr]") <+> ppr ex ppr (ExpandedStmt ex) = whenPprDebug (text "[ExpandedStmt]") <+> ppr ex - ppr (PopSrcSpan e) = whenPprDebug (text "") <+> parens (ppr e) + ppr (PopErrCtxt e) = whenPprDebug (text "") <+> parens (ppr e) instance Outputable XXExprGhcTc where ppr (WrapExpr (HsWrap co_fn e)) @@ -801,7 +801,7 @@ ppr_infix_expr _ = Nothing ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc ppr_infix_expr_rn (ExpandedExpr (HsExpanded a _)) = ppr_infix_expr a ppr_infix_expr_rn (ExpandedStmt _) = Nothing -ppr_infix_expr_rn (PopSrcSpan (L _ a)) = ppr_infix_expr a +ppr_infix_expr_rn (PopErrCtxt (L _ a)) = ppr_infix_expr a ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc ppr_infix_expr_tc (WrapExpr (HsWrap _ e)) = ppr_infix_expr e @@ -914,7 +914,7 @@ hsExprNeedsParens prec = go go_x_rn :: XXExprGhcRn -> Bool go_x_rn (ExpandedExpr (HsExpanded a _)) = hsExprNeedsParens prec a go_x_rn (ExpandedStmt _) = False - go_x_rn (PopSrcSpan (L _ a)) = hsExprNeedsParens prec a + go_x_rn (PopErrCtxt (L _ a)) = hsExprNeedsParens prec a -- | Parenthesize an expression without token information @@ -960,7 +960,7 @@ isAtomicHsExpr (XExpr x) go_x_rn :: XXExprGhcRn -> Bool go_x_rn (ExpandedExpr (HsExpanded a _)) = isAtomicHsExpr a go_x_rn (ExpandedStmt _) = False - go_x_rn (PopSrcSpan (L _ a)) = isAtomicHsExpr a + go_x_rn (PopErrCtxt (L _ a)) = isAtomicHsExpr a isAtomicHsExpr _ = False ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1671,7 +1671,7 @@ repE (XExpr (ExpandedExpr (HsExpanded orig_expr ds_expr))) ; if rebindable_on -- See Note [Quotation and rebindable syntax] then repE ds_expr else repE orig_expr } -repE (XExpr (PopSrcSpan (L _ e))) = repE e +repE (XExpr (PopErrCtxt (L _ e))) = repE e repE e@(XExpr (ExpandedStmt _)) = notHandled (ThExpressionForm e) repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e) repE e@(HsTypedBracket{}) = notHandled (ThExpressionForm e) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -321,6 +321,8 @@ The latter is much better. That is why we call unifyExpectedType before tcValArgs. -} + + tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- See Note [tcApp: typechecking applications] tcApp rn_expr exp_res_ty @@ -360,6 +362,11 @@ tcApp rn_expr exp_res_ty = do traceTc "tcApp" (vcat [text "VACall stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VACall stmt") stmt thing_inside + | insideExpansion fun_ctxt + , VAExpansionStmt stmt@(L loc _) <- fun_ctxt + = do traceTc "tcApp" (vcat [text "VAExpansionStmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) + setSrcSpanA loc $ addStmtCtxt (text "tcApp VAExpansionStmt") stmt + thing_inside | XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun = do traceTc "tcApp" (vcat [text "VAExpansion stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VAExpansion stmt") stmt @@ -724,6 +731,11 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside -- <+> ppr (is_bind_fun (appCtxtExpr ctxt)) ]) ; case ctxt of + VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ + -> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .." + setSrcSpanA loc $ + addStmtCtxt (text "addArgCtxt 2c") stmt $ + thing_inside VACall fun arg_no _ | not in_generated_code && not (is_then_fun fun || is_bind_fun fun) -> do traceTc "addArgCtxt 2a" empty setSrcSpanA arg_loc $ @@ -732,11 +744,6 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside VACall fun _ _ | not in_generated_code && is_then_fun fun -> do traceTc "addArgCtxt 2b >>" empty -- Skip setting "In the expression..." if the arg_no is > 1 thing_inside - VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ - -> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .." - setSrcSpanA loc $ - addStmtCtxt (text "addArgCtxt 2c") stmt $ - thing_inside VAExpansion (HsDo _ _ _) _ -> do traceTc "addArgCtxt 2d" empty -- Set the context as the first statement of do block -- setSrcSpanA arg_loc $ -- skip adding "In the expression do ... " ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -211,9 +211,9 @@ tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty tcExpr e@(XExpr (ExpandedExpr {})) res_ty = tcApp e res_ty -tcExpr (XExpr (PopSrcSpan (L _ e))) res_ty - = do traceTc "tcExpr" (text "PopSrcSpan") - popErrCtxt $ tcExpr e res_ty +tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty + = do traceTc "tcExpr" (text "PopErrCtxt") + popErrCtxt $ setSrcSpanA loc $ tcApp e res_ty tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) e))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -296,8 +296,22 @@ splitHsApps :: HsExpr GhcRn -> ( (HsExpr GhcRn, AppCtxt) -- Head , [HsExprArg 'TcpRn]) -- Args -- See Note [splitHsApps] -splitHsApps e = go e (top_ctxt 0 e) [] +splitHsApps e = maybeShiftCtxt $ + go e (top_ctxt 0 e) [] where + -- Ugly fix for setting the correct AppCtxt for let statements + -- The point is that when we try to typecheck a let expression we are checking + -- for the body of the let expression. But the go function for let statement expansion does not + -- calculate the correct app context + maybeShiftCtxt :: ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn]) -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn]) + maybeShiftCtxt ((rn_fun, fun_ctxt), rn_args) + | ((HsLet _ _ _ _ (L _ (XExpr (PopErrCtxt + (L _ (XExpr (ExpandedStmt (HsExpanded body_stmt _)))))))) + , VAExpansionStmt{}) <- (rn_fun, fun_ctxt) + = ((rn_fun, VAExpansionStmt body_stmt), rn_args) + | otherwise = ((rn_fun, fun_ctxt), rn_args) + + top_ctxt :: Int -> HsExpr GhcRn -> AppCtxt -- Always returns VACall fun n_val_args noSrcSpan -- to initialise the argument splitting in 'go' @@ -307,7 +321,6 @@ splitHsApps e = go e (top_ctxt 0 e) [] top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun top_ctxt n (XExpr (ExpandedExpr (HsExpanded orig _))) = VACall orig n noSrcSpan - -- top_ctxt n (XExpr (ExpandedStmt (HsExpanded stmt _))) = VACall other_fun n generatedSrcSpan top_ctxt n other_fun = VACall other_fun n noSrcSpan top_lctxt n (L _ fun) = top_ctxt n fun ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1190,7 +1190,7 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) -- | Generated location for PopSrcExpr -- genPopSrcSpanExpr :: LHsExpr GhcRn -> LHsExpr GhcRn --- genPopSrcSpanExpr = wrapGenSpan . mkPopSrcSpanExpr +-- genPopSrcSpanExpr = wrapGenSpan . mkPopErrCtxtExpr -- mkExpandedStmtLExpr -- :: ExprLStmt GhcRn -- ^ source statement @@ -1202,7 +1202,7 @@ expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) -- TODO ANI: maybe better to not add the Pop error contexts in the first place? expandDoStmts doFlav stmts = do expanded_expr <- expand_do_stmts doFlav stmts case expanded_expr of - L _ (XExpr (PopSrcSpan (L loc e))) -> return $ L loc e + L _ (XExpr (PopErrCtxt (L loc e))) -> return $ L loc e _ -> return expanded_expr -- | Expand the Do statments so that it works fine with Quicklook @@ -1229,7 +1229,7 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt = do traceTc "expand_do_stmts last" (ppr ret_expr) - return $ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt (unLoc body))) + return $ L loc (mkPopErrCtxtExpr $ L loc (mkExpandedStmt stmt (unLoc body))) | SyntaxExprRn ret <- ret_expr -- @@ -1237,19 +1237,19 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- return e ~~> return e -- to make T18324 work = do traceTc "expand_do_stmts last" (ppr ret_expr) - return $ wrapGenSpan (mkPopSrcSpanExpr $ - wrapGenSpan (mkExpandedStmt stmt ( + return $ wrapGenSpan (mkPopErrCtxtExpr $ + L loc (mkExpandedStmt stmt ( genHsApp (wrapGenSpan ret) body))) -expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bs)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bs)) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt (genHsLet bs $ expand_stmts))) + return $ wrapGenSpan (mkPopErrCtxtExpr $ L loc (mkExpandedStmt stmt (genHsLet bs $ expand_stmts))) -expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding pat can fail @@ -1262,7 +1262,7 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (wrapGenSpan (mkExpandedStmt stmt ( + return $ wrapGenSpan (mkPopErrCtxtExpr $ L loc (wrapGenSpan (mkExpandedStmt stmt ( (wrapGenSpan bind_op) -- (>>=) `genHsApp` e)) `genHsApp` @@ -1277,7 +1277,7 @@ expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : do -- isRebindableOn <- xoptM LangExt.RebindableSyntax -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (mkPopSrcSpanExpr $ L loc ((L loc (mkExpandedStmt stmt ( + return $ wrapGenSpan (mkPopErrCtxtExpr $ L loc ((L loc (mkExpandedStmt stmt ( (wrapGenSpan then_op) -- (>>) `genHsApp` e))) `genHsApp` ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -728,7 +728,7 @@ exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" exprCtOrigin (XExpr (ExpandedExpr (HsExpanded a _))) = exprCtOrigin a exprCtOrigin (XExpr (ExpandedStmt {})) = DoOrigin -exprCtOrigin (XExpr (PopSrcSpan {})) = Shouldn'tHappenOrigin "PopSrcSpan" +exprCtOrigin (XExpr (PopErrCtxt {})) = Shouldn'tHappenOrigin "PopErrCtxt" -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da56d43443f3667bbf7f3394b262964c27fb1f8e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da56d43443f3667bbf7f3394b262964c27fb1f8e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 01:37:27 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 12 Jul 2023 21:37:27 -0400 Subject: [Git][ghc/ghc][wip/expand-do] Add the statement context in addHeadCtxt Message-ID: <64af55577bb09_3f5efcf6618cc41217f@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 257c8fc2 by Apoorv Ingle at 2023-07-12T20:22:49-05:00 Add the statement context in addHeadCtxt - - - - - 1 changed file: - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -829,11 +829,10 @@ tcInferAppHead_maybe fun args _ -> return Nothing addHeadCtxt :: AppCtxt -> TcM a -> TcM a --- addHeadCtxt (VAExpansionStmt stmt@(L stmt_loc _) _) thing_inside = --- do setSrcSpanA stmt_loc $ --- addStmtCtxt (text "addHeadCtxt") stmt --- thing_inside - +addHeadCtxt (VAExpansionStmt stmt@(L stmt_loc _)) thing_inside = + do setSrcSpanA stmt_loc $ + addStmtCtxt (text "addHeadCtxt") stmt + thing_inside addHeadCtxt fun_ctxt thing_inside | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments = do traceTc "addHeadCtxt not good" (ppr fun_ctxt) @@ -843,7 +842,6 @@ addHeadCtxt fun_ctxt thing_inside do traceTc "addHeadCtxt okay" (ppr fun_ctxt) case fun_ctxt of VAExpansion orig _ -> addExprCtxt (text "addHeadCtxt") orig thing_inside - VAExpansionStmt {} -> thing_inside VACall {} -> thing_inside where fun_loc = appCtxtLoc fun_ctxt View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/257c8fc24d49de94d25dcc80c1aa7786a4557042 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/257c8fc24d49de94d25dcc80c1aa7786a4557042 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 02:02:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 12 Jul 2023 22:02:20 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] testsuite: Accept metric changes Message-ID: <64af5b2c46237_3f5efc365dcec416984@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 25f3dc6e by Ben Gamari at 2023-07-12T22:01:31-04:00 testsuite: Accept metric changes Metric Increase: T6048 - - - - - 0 changed files: Changes: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f3dc6e3edf2e62f454b1fe13c254ac723c3cf4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f3dc6e3edf2e62f454b1fe13c254ac723c3cf4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 03:19:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 23:19:03 -0400 Subject: [Git][ghc/ghc][master] Use deb10 for i386 bindists Message-ID: <64af6d27867e1_3f5efc65c9ff842423d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: e0874d9716897188a8ba059d2245269ed541bf9d # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -1048,7 +1048,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false - - job: nightly-i386-linux-deb9-validate + - job: nightly-i386-linux-deb10-validate artifacts: false - job: nightly-x86_64-linux-deb10-validate artifacts: false ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -928,7 +928,7 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -126,7 +126,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -137,7 +137,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -147,14 +147,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -180,11 +180,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -377,7 +377,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -388,7 +388,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -398,14 +398,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -431,11 +431,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2536,7 +2536,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2547,7 +2547,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2557,14 +2557,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2590,13 +2590,13 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -191,7 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): deb10 = mk(debian("x86_64", 10)) deb11 = mk(debian("x86_64", 11)) deb10_arm64 = mk(debian("aarch64", 10)) - deb9_i386 = mk(debian("i386", 9)) + deb10_i386 = mk(debian("i386", 10)) source = mk_one_metadata(release_mode, version, job_map, source_artifact) test = mk_one_metadata(release_mode, version, job_map, test_artifact) @@ -221,10 +221,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): } - a32 = { "Linux_Debian": { "<10": deb9_i386, "unknown_versioning": deb9_i386 } - , "Linux_Ubuntu": { "unknown_versioning": deb9_i386 } - , "Linux_Mint" : { "unknown_versioning": deb9_i386 } - , "Linux_UnknownLinux" : { "unknown_versioning": deb9_i386 } + a32 = { "Linux_Debian": { "unknown_versioning": deb10_i386 } + , "Linux_Ubuntu": { "unknown_versioning": deb10_i386 } + , "Linux_Mint" : { "unknown_versioning": deb10_i386 } + , "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 } } arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c39f279b7a23e7c3259dff9ad660b7f417d4fdcd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c39f279b7a23e7c3259dff9ad660b7f417d4fdcd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 03:19:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 23:19:39 -0400 Subject: [Git][ghc/ghc][master] Fix #23567, a specializer bug Message-ID: <64af6d4b789e9_3f5efc365dcec42957a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 4 changed files: - compiler/GHC/Core/Opt/Specialise.hs - + testsuite/tests/simplCore/should_compile/T23567.hs - + testsuite/tests/simplCore/should_compile/T23567A.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1495,7 +1495,9 @@ specBind top_lvl env (NonRec fn rhs) do_body -- Destroying demand info is not terrible; specialisation is -- always followed soon by demand analysis. - body_env2 = body_env1 `extendInScope` fn3 + body_env2 = body_env1 `bringFloatedDictsIntoScope` ud_binds rhs_uds + `extendInScope` fn3 + -- bringFloatedDictsIntoScope: see #23567 ; (body', body_uds) <- do_body body_env2 ===================================== testsuite/tests/simplCore/should_compile/T23567.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -funfolding-use-threshold=111640 -fmax-simplifier-iterations=2 #-} + +module T23567 where + +import T23567A + +instance (MonadIO m) => CacheRWM2 (ReaderT (StateT m)) where + p = runCacheBuildM + {-# NOINLINE p #-} ===================================== testsuite/tests/simplCore/should_compile/T23567A.hs ===================================== @@ -0,0 +1,27 @@ +module T23567A where + +class Appl f where + pur :: f + ast :: f -> f + +class Appl f => Mona f where + unused :: f + +class Mona f => MonadIO f where + unused2 :: f + +newtype StateT m = StateT { runStateT :: m } + deriving (Mona, MonadIO) + +instance (Appl m, Appl m) => Appl (StateT m) where + pur = pur + ast x = x + +newtype ReaderT m = ReaderT { runReaderT :: m } + deriving (Appl, Mona, MonadIO) + +class CacheRWM2 m where + p :: m + +runCacheBuildM :: (MonadIO m) => m +runCacheBuildM = ast pur ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -490,3 +490,4 @@ test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], mul test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) test('T23074', normal, compile, ['-O -ddump-rules']) test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) +test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf9b9de0685e23c191722dfdb78d28b44f1cba05 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf9b9de0685e23c191722dfdb78d28b44f1cba05 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 03:20:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 23:20:28 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Comments Message-ID: <64af6d7c6008c_3f5efcb368c432818@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 2 changed files: - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Types/Name.hs Changes: ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -8,7 +8,34 @@ (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -} --- | Tidying up Core +{-| Tidying up Core + +This module's purpose is to prepare the Core program for two distinct purposes: +* To be serialised into the module's interface file +* To feed to the code generator + +The most important tasks are: +* Determine which `Name`s should ultimately be `Internal` and `External` + (which may differ to whether they were originally `Internal` or `External`). + See `Note [About the NameSorts]` in GHC.Types.Name. + For example, in: + module M where + f x = x + y + where y = factorial 4 + could be optimized during the Core pass to: + module M where + y = factorial 4 + f x = x + y + in which case `y` would be changed from `Internal` to `External`. + +* Rename local identifiers to avoid name clashes, so that unfoldings etc can + be serialialised using the OccName, without Uniques. + + For example (`x_5` means `x` with a `Unique` of `5`): + f x_12 x_23 = x_12 + would be changed to: + f x_12 x1_23 = x_12 +-} module GHC.Iface.Tidy ( TidyOpts (..) , UnfoldingExposure (..) ===================================== compiler/GHC/Types/Name.hs ===================================== @@ -143,12 +143,16 @@ data Name = Name -- See Note [About the NameSorts] data NameSort = External Module + -- Either an import from another module + -- or a top-level name + -- See Note [About the NameSorts] | WiredIn Module TyThing BuiltInSyntax -- A variant of External, for wired-in things - | Internal -- A user-defined Id or TyVar + | Internal -- A user-defined local Id or TyVar -- defined in the module being compiled + -- See Note [About the NameSorts] | System -- A system-defined Id or TyVar. Typically the -- OccName is very uninformative (like 's') @@ -213,21 +217,32 @@ TL;DR: we make the `n_occ` field lazy. {- Note [About the NameSorts] ~~~~~~~~~~~~~~~~~~~~~~~~~~ - -1. Initially, top-level Ids (including locally-defined ones) get External names, - and all other local Ids get Internal names - -2. In any invocation of GHC, an External Name for "M.x" has one and only one +1. Initially: + * All types, classes, data constructors get Extenal Names + * Top-level Ids (including locally-defined ones) get External Names, + * All other local (non-top-level) Ids get Internal names + +2. In the Tidy phase (GHC.Iface.Tidy): + * An Id that is "externally-visible" is given an External Name, + even if the name was Internal up to that point + * An Id that is not externally visible is given an Internal Name. + even if the name was External up to that point + See GHC.Iface.Tidy.tidyTopName + + An Id is externally visible if it is mentioned in the interface file; e.g. + - it is exported + - it is mentioned in an unfolding + See GHC.Iface.Tidy.chooseExternalIds + +3. In any invocation of GHC, an External Name for "M.x" has one and only one unique. This unique association is ensured via the Name Cache; see Note [The Name Cache] in GHC.Iface.Env. -3. Things with a External name are given C static labels, so they finally - appear in the .o file's symbol table. They appear in the symbol table - in the form M.n. If originally-local things have this property they - must be made @External@ first. +4. In code generation, things with a External name are given C static + labels, so they finally appear in the .o file's symbol table. They + appear in the symbol table in the form M.n. That is why + externally-visible things are made External (see (2) above). -4. In the tidy-core phase, a External that is not visible to an importer - is changed to Internal, and a Internal that is visible is changed to External 5. A System Name differs in the following ways: a) has unique attached when printing dumps @@ -239,13 +254,13 @@ Note [About the NameSorts] If any desugarer sys-locals have survived that far, they get changed to "ds1", "ds2", etc. -Built-in syntax => It's a syntactic form, not "in scope" (e.g. []) +6. A WiredIn Name is used for things (Id, TyCon) that are fully known to the compiler, + not read from an interface file. E.g. Bool, True, Int, Float, and many others. -Wired-in thing => The thing (Id, TyCon) is fully known to the compiler, - not read from an interface file. - E.g. Bool, True, Int, Float, and many others + A WiredIn Name contains contains a TyThing, so we don't have to look it up. -All built-in syntax is for wired-in things. + The BuiltInSyntax flag => It's a syntactic form, not "in scope" (e.g. []) + All built-in syntax thigs are WiredIn. -} instance HasOccName Name where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf9b9de0685e23c191722dfdb78d28b44f1cba05...2af23f0e84eec0eb30d77134abd99858a02d7a18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf9b9de0685e23c191722dfdb78d28b44f1cba05...2af23f0e84eec0eb30d77134abd99858a02d7a18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 03:51:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 12 Jul 2023 23:51:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Use deb10 for i386 bindists Message-ID: <64af74db68590_3f5efc23950a244375f1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - edb757fd by sheaf at 2023-07-12T23:51:46-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 8713c6a2 by sheaf at 2023-07-12T23:51:46-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 08e1d5ee by sheaf at 2023-07-12T23:51:46-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 1f621979 by Rodrigo Mesquita at 2023-07-12T23:51:46-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/GREInfo.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Name/Occurrence.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baaa288294fd7145fce18be1cba5b95e2b199e86...1f62197912d391206d4c3d5ce6b5b3b732d1cb27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baaa288294fd7145fce18be1cba5b95e2b199e86...1f62197912d391206d4c3d5ce6b5b3b732d1cb27 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 07:57:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 13 Jul 2023 03:57:41 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 3 commits: gitlab-ci: Bump ci-images Message-ID: <64afae752ad46_3f5efc65c9ff84859d7@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: ced6ce11 by Ben Gamari at 2023-07-13T03:57:12-04:00 gitlab-ci: Bump ci-images To freeze emsdk, avoiding #23641. - - - - - f7b22a63 by Ben Gamari at 2023-07-13T03:57:12-04:00 testsuite: Accept metric changes Metric Increase: T6048 - - - - - 77ee6b04 by Ben Gamari at 2023-07-13T03:57:12-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. - - - - - 2 changed files: - .gitlab-ci.yml - testsuite/tests/backpack/cabal/bkpcabal08/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: c29d97c469a23db1c77ac1184eebbb2fd86ef623 + DOCKER_REV: a9c0f5efbe503c17f63070583b2d815e498acc68 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== testsuite/tests/backpack/cabal/bkpcabal08/all.T ===================================== @@ -6,6 +6,7 @@ else: test('bkpcabal08', [extra_files(['p', 'q', 'impl', 'bkpcabal08.cabal', 'Setup.hs', 'R.hs']), js_broken(22351), + fragile(23648), normalise_slashes, normalise_version('bkpcabal08')], run_command, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25f3dc6e3edf2e62f454b1fe13c254ac723c3cf4...77ee6b043095cd5573409b42c1fd85649d239bc3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25f3dc6e3edf2e62f454b1fe13c254ac723c3cf4...77ee6b043095cd5573409b42c1fd85649d239bc3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 08:43:40 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 13 Jul 2023 04:43:40 -0400 Subject: [Git][ghc/ghc][wip/T23645] Add special imulMayOflo case for W8 Message-ID: <64afb93c86606_3f5efc65c9ff85107d3@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: a2b083e5 by Jaro Reinders at 2023-07-13T10:43:32+02:00 Add special imulMayOflo case for W8 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -968,12 +968,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + + -- Special case for W8. Given X, Y we compute: + -- Z := X * Y + -- Z + 128 > 255 (unsigned) + -- This is equivalent to checking: Z < -128 || 127 < Z + imulMayOflo W8 a b = do + (a_reg, a_code) <- getNonClobberedReg a + b_code <- getAnyReg b + let + code = a_code `appOL` b_code eax `appOL` + toOL [ + IMUL2 II8 (OpReg a_reg), -- result in %ax + ADD II16 (OpImm (ImmInt 128)) (OpReg eax), + CMP II16 (OpImm (ImmInt 255)) (OpReg eax), + SETCC GU (OpReg eax) + ] + return (Fixed II8 eax code) + imulMayOflo rep a b = do (a_reg, a_code) <- getNonClobberedReg a b_code <- getAnyReg b let shift_amt = case rep of - W8 -> 7 W16 -> 15 W32 -> 31 W64 -> 63 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2b083e548683f6da9ff58a9c763f25d4e99ac35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2b083e548683f6da9ff58a9c763f25d4e99ac35 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 08:48:54 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 13 Jul 2023 04:48:54 -0400 Subject: [Git][ghc/ghc][wip/T23645] Add special imulMayOflo case for W8 Message-ID: <64afba76ec471_3f5efc65c9ff8512643@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: baebaebe by Jaro Reinders at 2023-07-13T10:48:43+02:00 Add special imulMayOflo case for W8 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -968,12 +968,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + + -- Special case for W8. Given X, Y we compute: + -- Z := X * Y + -- Z + 128 > 255 (unsigned) + -- This is equivalent to checking: Z < -128 || 127 < Z + imulMayOflo W8 a b = do + (a_reg, a_code) <- getNonClobberedReg a + b_code <- getAnyReg b + let + code = a_code `appOL` b_code eax `appOL` + toOL [ + IMUL2 II8 (OpReg a_reg), -- result in %ax + SUB II16 (OpImm (ImmInt (-128))) (OpReg eax), + CMP II16 (OpImm (ImmInt 255)) (OpReg eax), + SETCC GU (OpReg eax) + ] + return (Fixed II8 eax code) + imulMayOflo rep a b = do (a_reg, a_code) <- getNonClobberedReg a b_code <- getAnyReg b let shift_amt = case rep of - W8 -> 7 W16 -> 15 W32 -> 31 W64 -> 63 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/baebaebec91c97a6d0559ef95032ee69a4f2ebaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/baebaebec91c97a6d0559ef95032ee69a4f2ebaf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 09:17:38 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 13 Jul 2023 05:17:38 -0400 Subject: [Git][ghc/ghc][wip/T23645] Try to fix mulmayoflo on aarch64 Message-ID: <64afc132eb914_3f5efc23950a24518120@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: d2bc3f84 by Jaro Reinders at 2023-07-13T11:17:32+02:00 Try to fix mulmayoflo on aarch64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1039,7 +1039,7 @@ getRegister' config plat expr code_x `appOL` code_y `snocOL` mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` + CMP (OpReg tmp_w tmp) (OpRegExt w tmp ext_mode 0) `snocOL` CSET (OpReg w dst) NE) -- | Is a given number encodable as a bitmask immediate? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2bc3f843309101e0c4caae61a7d1b5086a1984b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2bc3f843309101e0c4caae61a7d1b5086a1984b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 09:23:14 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 13 Jul 2023 05:23:14 -0400 Subject: [Git][ghc/ghc][wip/T23645] Fix aarch64 more Message-ID: <64afc2829f212_3f5efc23950a24519712@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: ee4fbcf8 by Jaro Reinders at 2023-07-13T11:23:04+02:00 Fix aarch64 more - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1039,8 +1039,8 @@ getRegister' config plat expr code_x `appOL` code_y `snocOL` mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CMP (OpReg tmp_w tmp) (OpRegExt w tmp ext_mode 0) `snocOL` - CSET (OpReg w dst) NE) + CMP (OpReg tmp_w tmp) (OpRegExt W32 tmp ext_mode 0) `snocOL` + CSET (OpReg W32 dst) NE) -- | Is a given number encodable as a bitmask immediate? -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee4fbcf8f5a340433c057e30957628603867afe0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee4fbcf8f5a340433c057e30957628603867afe0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 09:25:51 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 05:25:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ci-image-bump Message-ID: <64afc31fa160c_3f5efcb31a05219b@gitlab.mail> Matthew Pickering pushed new branch wip/ci-image-bump at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ci-image-bump You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 10:04:42 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 13 Jul 2023 06:04:42 -0400 Subject: [Git][ghc/ghc][wip/T23645] Fix whitespace Message-ID: <64afcc3ab6ecd_3f5efc65c9ff854181e@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: 8439d2e3 by Jaro Reinders at 2023-07-13T12:04:33+02:00 Fix whitespace - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -985,7 +985,7 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps SETCC GU (OpReg eax) ] return (Fixed II8 eax code) - + imulMayOflo rep a b = do (a_reg, a_code) <- getNonClobberedReg a b_code <- getAnyReg b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8439d2e36550784cb72a3242dfb90c0fbee18ff6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8439d2e36550784cb72a3242dfb90c0fbee18ff6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 10:25:09 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 13 Jul 2023 06:25:09 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] 78 commits: hadrian: Fix dependencies of docs:* rule Message-ID: <64afd10512a58_3f5efc23950a245532b1@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 051ff531 by Andrei Borzenkov at 2023-07-13T14:24:46+04:00 Draft: Type patterns (22478, 18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb97b95f46ea2209986ec819880882b20bf7f51a...051ff531d341dd2eed0e43a3ea6f136ec4805965 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb97b95f46ea2209986ec819880882b20bf7f51a...051ff531d341dd2eed0e43a3ea6f136ec4805965 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 10:58:19 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 13 Jul 2023 06:58:19 -0400 Subject: [Git][ghc/ghc][wip/T22404] Wibbles Message-ID: <64afd8cb47313_3f5efca34d21c56394d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: c12834a9 by Simon Peyton Jones at 2023-07-13T11:57:30+01:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Types/Basic.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2944,8 +2944,8 @@ mkZeroedForm (UD { ud_env = rhs_occs }) = emptyDetails { ud_env = mapMaybeUFM do_one rhs_occs } where do_one :: LocalOcc -> Maybe LocalOcc - do_one ManyOccL = Nothing - do_one (OneOccL _ ic) = Just (OneOccL 0 ic) + do_one ManyOccL = Nothing + do_one occ@(OneOccL {}) = Just (occ { lo_n_br = 0 }) -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet @@ -3369,7 +3369,9 @@ info then simply means setting the corresponding zapped set to the whole type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's -- free variables to their usage -data LocalOcc = OneOccL {-# UNPACK #-} !Int !InterestingCxt +data LocalOcc = OneOccL { lo_n_br :: {-# UNPACK #-} !Int + , lo_tail :: {-# UNPACK #-} !TailCallInfo + , lo_int_cxt :: !InterestingCxt } | ManyOccL type ZappedSet = OccInfoEnv -- Values are ignored @@ -3378,9 +3380,9 @@ data UsageDetails = UD { ud_env :: !OccInfoEnv , ud_z_many :: !ZappedSet -- apply 'markMany' to these , ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these - , ud_tail :: !(IdEnv TailCallInfo) + , ud_z_tail :: !ZappedSet } - -- INVARIANT: Both zapped sets are subsets of ud_env + -- INVARIANT: All three zapped sets are subsets of ud_env instance Outputable UsageDetails where ppr ud = text "UD" <+> (braces $ fsep $ punctuate comma $ @@ -3429,9 +3431,9 @@ mkOneOcc !env id int_cxt arity = one_occ_uds where - one_occ_uds = emptyDetails - { ud_env = unitVarEnv id (OneOccL 1 int_cxt) - , ud_tail = unitVarEnv id (AlwaysTailCalled arity) } + occ = OneOccL { lo_n_br = 1, lo_int_cxt = int_cxt + , lo_tail = AlwaysTailCalled arity } + one_occ_uds = emptyDetails { ud_env = unitVarEnv id occ } addManyOccId :: UsageDetails -> Id -> UsageDetails -- Add the non-committal (id :-> noOccInfo) to the usage details @@ -3464,7 +3466,7 @@ emptyDetails :: UsageDetails emptyDetails = UD { ud_env = emptyVarEnv , ud_z_many = emptyVarEnv , ud_z_in_lam = emptyVarEnv - , ud_tail = emptyVarEnv } + , ud_z_tail = emptyVarEnv } isEmptyDetails :: UsageDetails -> Bool isEmptyDetails = isEmptyVarEnv . ud_env @@ -3474,17 +3476,17 @@ delDetails :: UsageDetails -> [Id] -> UsageDetails delDetails (UD { ud_env = env , ud_z_many = z_many , ud_z_in_lam = z_in_lam - , ud_tail = tail }) bndrs + , ud_z_tail = z_tail }) bndrs = UD { ud_env = env `delVarEnvList` bndrs , ud_z_many = z_many `delVarEnvList` bndrs , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs - , ud_tail = tail `delVarEnvList` bndrs } + , ud_z_tail = z_tail `delVarEnvList` bndrs } markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails -markAllMany ud = ud { ud_z_many = ud_env ud } -markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } -markAllNonTail ud = ud { ud_tail = emptyVarEnv } +markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env } +markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env } +markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env } markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3532,7 +3534,7 @@ combineUsageDetailsWith plus_occ_info ud1 ud2 = UD { ud_env = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2) , ud_z_many = plusVarEnv (ud_z_many ud1) (ud_z_many ud2) , ud_z_in_lam = plusVarEnv (ud_z_in_lam ud1) (ud_z_in_lam ud2) - , ud_tail = plusVarEnv_C andTailCallInfo (ud_tail ud1) (ud_tail ud2) } + , ud_z_tail = plusVarEnv (ud_z_tail ud1) (ud_z_tail ud2) } mkOccInfo :: UsageDetails -> Var -> LocalOcc -> OccInfo mkOccInfo ud var occ = mkOccInfoByUnique ud (varUnique var) occ @@ -3540,26 +3542,26 @@ mkOccInfo ud var occ = mkOccInfoByUnique ud (varUnique var) occ mkOccInfoByUnique :: UsageDetails -> Unique -> LocalOcc -> OccInfo mkOccInfoByUnique (UD { ud_z_many = z_many , ud_z_in_lam = z_in_lam - , ud_tail = tail_env }) + , ud_z_tail = z_tail }) uniq occ = case occ of - OneOccL n_br int_cxt + OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt + , lo_tail = occ_tail } | not (uniq `elemVarEnvByKey`z_many) -> OneOcc { occ_in_lam = in_lam , occ_n_br = n_br , occ_int_cxt = int_cxt , occ_tail = tail } + where + tail | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo + | otherwise = occ_tail - _other -- ManyOccL and zapped OneOccL - -> ManyOccs { occ_tail = tail } - - where - tail = case lookupVarEnv_Directly tail_env uniq of - Nothing -> NoTailCallInfo - Just tc -> tc + in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam + | otherwise = NotInsideLam - in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam - | otherwise = NotInsideLam + _other -- ManyOccL and zapped OneOccL + -> ManyOccs { occ_tail = NoTailCallInfo } + -- I think this is redundant; remove from ManyOccs ------------------- -- See Note [Adjusting right-hand sides] @@ -3851,9 +3853,11 @@ andOccInfo _ _ = ManyOccL -- (orOccInfo orig new) is used -- when combining occurrence info from branches of a case -orOccInfo (OneOccL nbr1 int_cxt1) (OneOccL nbr2 int_cxt2) - = OneOccL (nbr1 + nbr2) (int_cxt1 `mappend` int_cxt2) - +orOccInfo (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = ar1 }) + (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = ar2 }) + = OneOccL { lo_n_br = nbr1 + nbr2 + , lo_int_cxt = int_cxt1 `mappend` int_cxt2 + , lo_tail = ar1 `andTailCallInfo` ar2 } orOccInfo _ _ = ManyOccL andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1068,8 +1068,9 @@ instance Monoid InsideLam where mappend = (Semi.<>) ----------------- -data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo] - | NoTailCallInfo +data TailCallInfo + = AlwaysTailCalled {-# UNPACK #-} !JoinArity -- See Note [TailCallInfo] + | NoTailCallInfo deriving (Eq) tailCallInfo :: OccInfo -> TailCallInfo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c12834a91a7c18b525779b14b0f48a1a76085eb2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c12834a91a7c18b525779b14b0f48a1a76085eb2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 11:54:58 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 13 Jul 2023 07:54:58 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Type patterns (#22478, #18986) Message-ID: <64afe61216c7a_3f5efc33ad50d858352@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: afdf646b by Andrei Borzenkov at 2023-07-13T15:54:29+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 30 changed files: - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - testsuite/tests/gadt/T18191.stderr - + testsuite/tests/rename/should_compile/T22478a.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T22478b.hs - + testsuite/tests/rename/should_fail/T22478b.stderr - + testsuite/tests/rename/should_fail/T22478d.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afdf646bde071702275037855b6a7ea5ea6648c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/afdf646bde071702275037855b6a7ea5ea6648c5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 11:59:00 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 07:59:00 -0400 Subject: [Git][ghc/ghc][wip/ci-image-bump] Update bootstrap plans for 9.6.2 and 9.4.5 Message-ID: <64afe70459e14_3f5efc23950a2458843f@gitlab.mail> Matthew Pickering pushed to branch wip/ci-image-bump at Glasgow Haskell Compiler / GHC Commits: 90069b0f by Matthew Pickering at 2023-07-13T12:58:36+01:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 5 changed files: - .gitlab-ci.yml - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90069b0ffba830ef21196d3f35c5e6f4704d49e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90069b0ffba830ef21196d3f35c5e6f4704d49e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:00:16 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:00:16 -0400 Subject: [Git][ghc/ghc][wip/ci-image-bump] Update bootstrap plans for 9.6.2 and 9.4.5 Message-ID: <64afe750b77b2_3f5efc33ad50d858868b@gitlab.mail> Matthew Pickering pushed to branch wip/ci-image-bump at Glasgow Haskell Compiler / GHC Commits: e0a2de7a by Matthew Pickering at 2023-07-13T12:59:53+01:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 4 changed files: - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0a2de7a853a9df06147764ef604713b09b642b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0a2de7a853a9df06147764ef604713b09b642b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:00:50 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:00:50 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/test-primops Message-ID: <64afe772b699d_3f5efca34d21c5890f7@gitlab.mail> Matthew Pickering pushed new branch wip/test-primops at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/test-primops You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:03:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 13 Jul 2023 08:03:02 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Fix deprecation of record fields Message-ID: <64afe7f5ed471_3f5efc33ad50d8598514@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 29 changed files: - compiler/GHC/Data/FastString.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/GREInfo.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr - + testsuite/tests/overloadedrecflds/should_compile/T23279.hs - + testsuite/tests/overloadedrecflds/should_compile/T23279.stderr - + testsuite/tests/overloadedrecflds/should_compile/T23279_aux.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/overloadedrecflds/should_fail/T16745.stderr - testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr - testsuite/tests/th/T7241.stderr Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -419,7 +419,8 @@ prototyping safe newtype-coercions: GHC.NT.Type.NT was imported, but could not be looked up /by the plugin/. let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT" - putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts + putMsgS $ showSDoc dflags $ ppr $ + lookupGRE (mg_rdr_env guts) (LookupRdrName rdrName AllRelevantGREs) `mkTcOcc` involves the lookup (or creation) of a FastString. Since the plugin's FastString.string_table is empty, constructing the RdrName also ===================================== compiler/GHC/Rename/Doc.hs ===================================== @@ -8,7 +8,6 @@ import GHC.Types.Name.Reader import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Tc.Utils.Monad (getGblEnv) -import GHC.Rename.Env rnLHsDoc :: LHsDoc GhcPs -> RnM (LHsDoc GhcRn) rnLHsDoc = traverse rnHsDoc @@ -38,8 +37,8 @@ rnHsDoc (WithHsDocIdentifiers s ids) = do rnHsDocIdentifiers :: GlobalRdrEnv -> [Located RdrName] -> [Located Name] -rnHsDocIdentifiers gre_env ns = concat - [ map (L l . greName) (lookupGRE_RdrName (IncludeFields WantNormal) gre_env c) +rnHsDocIdentifiers gre_env ns = + [ L l $ greName gre | L l rdr_name <- ns - , c <- dataTcOccs rdr_name + , gre <- lookupGRE gre_env (LookupOccName (rdrNameOcc rdr_name) AllRelevantGREs) ] ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Rename.Env ( ChildLookupResult(..), lookupSubBndrOcc_helper, - combineChildLookupResult, -- Called by lookupChildrenExport HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN, lookupSigCtxtOccRn, @@ -57,8 +56,6 @@ module GHC.Rename.Env ( DeprecationWarnings(..), addUsedGRE, addUsedGREs, addUsedDataCons, - - dataTcOccs, --TODO: Move this somewhere, into utils? ) where @@ -72,6 +69,7 @@ import GHC.Iface.Env import GHC.Hs import GHC.Types.Name.Reader import GHC.Tc.Errors.Types +import GHC.Tc.Errors.Ppr (pprScopeError) import GHC.Tc.Utils.Env import GHC.Tc.Types.LclEnv import GHC.Tc.Utils.Monad @@ -298,7 +296,7 @@ lookupTopBndrRn which_suggest rdr_name = (do { op_ok <- xoptM LangExt.TypeOperators ; unless op_ok (addErr (TcRnIllegalTypeOperatorDecl rdr_name)) }) ; env <- getGlobalRdrEnv - ; case filter isLocalGRE (lookupGRE_RdrName (IncludeFields WantNormal) env rdr_name) of + ; case filter isLocalGRE (lookupGRE env $ LookupRdrName rdr_name $ RelevantGREsFOS WantNormal) of [gre] -> return (greName gre) _ -> do -- Ambiguous (can't happen) or unbound traceRn "lookupTopBndrRN fail" (ppr rdr_name) @@ -357,17 +355,14 @@ lookupExternalExactName name lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt) lookupLocalExactGRE name = do { env <- getGlobalRdrEnv - ; let main_occ = nameOccName name - demoted_occs = case demoteOccName main_occ of - Just occ -> [occ] - Nothing -> [] - gres = [ gre | occ <- main_occ : demoted_occs - , gre <- lookupGRE_OccName (IncludeFields WantBoth) env occ - -- We're filtering by an exact 'Name' match, - -- so we should look up as many potential matches as possible. - -- See also test case T11809. - , greName gre == name ] - ; case gres of + ; let lk = LookupExactName { lookupExactName = name + , lookInAllNameSpaces = True } + -- We want to check for clashes where the same Unique + -- occurs in two different NameSpaces, as per + -- Note [Template Haskell ambiguity]. So we + -- check ALL namespaces, not just the NameSpace of the Name. + -- See test cases T9066, T11809. + ; case lookupGRE env lk of [gre] -> return (Right gre) [] -> -- See Note [Splicing Exact names] @@ -384,7 +379,8 @@ lookupLocalExactGRE name } } - gres -> return (Left (SameName gres)) } -- Ugh! See Note [Template Haskell ambiguity] } + gres -> return (Left (SameName gres)) } + -- Ugh! See Note [Template Haskell ambiguity] } ----------------------------------------------- lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name @@ -433,15 +429,16 @@ lookupFamInstName Nothing tc_rdr -- Family instance; tc_rdr is an *occurrenc = lookupLocatedOccRnConstr tc_rdr ----------------------------------------------- -lookupConstructorFields :: Name -> RnM [FieldLabel] +lookupConstructorFields :: HasDebugCallStack => Name -> RnM [FieldLabel] lookupConstructorFields = fmap conInfoFields . lookupConstructorInfo -- | Look up the arity and record fields of a constructor. -lookupConstructorInfo :: Name -> RnM ConInfo +lookupConstructorInfo :: HasDebugCallStack => Name -> RnM ConInfo lookupConstructorInfo con_name = do { info <- lookupGREInfo_GRE con_name ; case info of IAmConLike con_info -> return con_info + UnboundGRE -> return ConHasPositionalArgs _ -> pprPanic "lookupConstructorInfo: not a ConLike" $ vcat [ text "name:" <+> ppr con_name ] } @@ -454,10 +451,10 @@ lookupExactOrOrig rdr_name res k = do { men <- lookupExactOrOrig_base rdr_name ; case men of FoundExactOrOrig gre -> return $ res gre - ExactOrOrigError e -> + NotExactOrOrig -> k + ExactOrOrigError e -> do { addErr (mkTcRnNotInScope rdr_name e) - ; return $ res (mkUnboundGRERdr rdr_name) } - NotExactOrOrig -> k } + ; return $ res (mkUnboundGRERdr rdr_name) } } -- Variant of 'lookupExactOrOrig' that does not report an error -- See Note [Errors in lookup functions] @@ -563,7 +560,7 @@ lookupRecFieldOcc mb_con rdr_name ; Just nm -> return nm } } | otherwise -- Can't use the data constructor to disambiguate - = lookupGlobalOccRn' (IncludeFields WantField) rdr_name + = lookupGlobalOccRn' (RelevantGREsFOS WantField) rdr_name -- This use of Global is right as we are looking up a selector, -- which can only be defined at the top level. @@ -683,23 +680,21 @@ disambiguation anyway, because `x` is an original name, and lookupGlobalOccRn will find it. -} - -- | Used in export lists to lookup the children. -lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings -> Name -> RdrName +lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings + -> Name + -> RdrName -- ^ thing we are looking up + -> LookupChild -- ^ how to look it up (e.g. which + -- 'NameSpace's to look in) -> RnM ChildLookupResult -lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name +lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name how_lkup | isUnboundName parent -- Avoid an error cascade = return (FoundChild (mkUnboundGRERdr rdr_name)) | otherwise = do gre_env <- getGlobalRdrEnv - - let original_gres = lookupGRE_OccName (IncludeFields WantBoth) gre_env (rdrNameOcc rdr_name) - -- WantBoth: we are looking for children, so we want to include fields defined - -- with no field selectors, as we can export those as children. See test NFSExport. - - -- Disambiguate the lookup based on the parent information. + let original_gres = lookupGRE gre_env (LookupChildren (rdrNameOcc rdr_name) how_lkup) -- The remaining GREs are things that we *could* export here, note that -- this includes things which have `NoParent`. Those are sorted in -- `checkPatSynParent`. @@ -710,8 +705,9 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name NoOccurrence -> noMatchingParentErr original_gres UniqueOccurrence g -> - if must_have_parent then noMatchingParentErr original_gres - else checkFld g + if must_have_parent + then noMatchingParentErr original_gres + else checkFld g DisambiguatedOccurrence g -> checkFld g AmbiguousOccurrence gres -> @@ -737,27 +733,21 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name traceRn "npe" (ppr original_gres) dup_fields_ok <- xoptM LangExt.DuplicateRecordFields case original_gres of - [] -> return NameNotFound + [] -> return NameNotFound [g] -> return $ IncorrectParent parent g - [p | Just p <- [getParent g]] + [p | ParentIs p <- [greParent g]] gss@(g:gss'@(_:_)) -> if all isRecFldGRE gss && dup_fields_ok - then return $ - IncorrectParent parent g - [p | x <- gss, Just p <- [getParent x]] - else mkNameClashErr $ g NE.:| gss' + then return $ + IncorrectParent parent g + [p | x <- gss, ParentIs p <- [greParent x]] + else mkNameClashErr $ g NE.:| gss' mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult mkNameClashErr gres = do addNameClashErrRn rdr_name gres return (FoundChild (NE.head gres)) - getParent :: GlobalRdrElt -> Maybe Name - getParent (GRE { gre_par = p } ) = - case p of - ParentIs cur_parent -> Just cur_parent - NoParent -> Nothing - picked_gres :: [GlobalRdrElt] -> DisambigInfo -- For Unqual, find GREs that are in scope qualified or unqualified -- For Qual, find GREs that are in scope with that qualification @@ -769,12 +759,12 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name right_parent :: GlobalRdrElt -> DisambigInfo right_parent p - = case getParent p of - Just cur_parent - | parent == cur_parent -> DisambiguatedOccurrence p - | otherwise -> NoOccurrence - Nothing -> UniqueOccurrence p - + = case greParent p of + ParentIs cur_parent + | parent == cur_parent -> DisambiguatedOccurrence p + | otherwise -> NoOccurrence + NoParent -> UniqueOccurrence p +{-# INLINEABLE lookupSubBndrOcc_helper #-} -- This domain specific datatype is used to record why we decided it was -- possible that a GRE could be exported with a parent. @@ -830,18 +820,9 @@ data ChildLookupResult -- | We resolved to a child | FoundChild GlobalRdrElt --- | Specialised version of msum for RnM ChildLookupResult -combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult -combineChildLookupResult [] = return NameNotFound -combineChildLookupResult (x:xs) = do - res <- x - case res of - NameNotFound -> combineChildLookupResult xs - _ -> return res - instance Outputable ChildLookupResult where ppr NameNotFound = text "NameNotFound" - ppr (FoundChild n) = text "Found:" <+> ppr (gre_par n) <+> ppr n + ppr (FoundChild n) = text "Found:" <+> ppr (greParent n) <+> ppr n ppr (IncorrectParent p g ns) = text "IncorrectParent" <+> hsep [ppr p, ppr $ greName g, ppr ns] @@ -851,19 +832,21 @@ lookupSubBndrOcc :: DeprecationWarnings -> SDoc -> RdrName -> RnM (Either NotInScopeError Name) --- Find all the things the rdr-name maps to --- and pick the one with the right parent name +-- ^ Find all the things the 'RdrName' maps to, +-- and pick the one with the right 'Parent' 'Name'. lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = lookupExactOrOrig rdr_name (Right . greName) $ -- This happens for built-in classes, see mod052 for example - do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name + do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name what_lkup ; return $ case child of FoundChild g -> Right (greName g) NameNotFound -> Left (UnknownSubordinate doc) IncorrectParent {} -> Left (UnknownSubordinate doc) } -- See [Mismatched class methods and associated type families] -- in TcInstDecls. - + where + what_lkup = LookupChild { wantedParent = the_parent + , lookupDataConFirst = False } {- Note [Family instance binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1138,7 +1121,7 @@ lookup_demoted rdr_name -- ^^^^^^^^^^^ report_qualified_term_in_types :: RdrName -> RdrName -> RnM Name report_qualified_term_in_types rdr_name demoted_rdr_name = - do { mName <- lookupGlobalOccRn_maybe (IncludeFields WantNormal) demoted_rdr_name + do { mName <- lookupGlobalOccRn_maybe (RelevantGREsFOS WantNormal) demoted_rdr_name ; case mName of (Just _) -> termNameInType looking_for rdr_name demoted_rdr_name [] Nothing -> unboundTermNameInTypes looking_for rdr_name demoted_rdr_name } @@ -1250,14 +1233,14 @@ lookupOccRnX_maybe globalLookup wrapper rdr_name lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) lookupOccRn_maybe = lookupOccRnX_maybe - (lookupGlobalOccRn_maybe $ IncludeFields WantNormal) + (lookupGlobalOccRn_maybe $ RelevantGREsFOS WantNormal) return -- Used outside this module only by TH name reification (lookupName, lookupThName_maybe) lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name) lookupSameOccRn_maybe = lookupOccRnX_maybe - (get_name <$> lookupGlobalOccRn_maybe SameOccName) + (get_name <$> lookupGlobalOccRn_maybe SameNameSpace) (return . greName) where get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name) @@ -1307,7 +1290,7 @@ lookupGlobalOccRn :: RdrName -> RnM Name -- environment. -- -- Used by exports_from_avail -lookupGlobalOccRn = lookupGlobalOccRn' (IncludeFields WantNormal) +lookupGlobalOccRn = lookupGlobalOccRn' (RelevantGREsFOS WantNormal) lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name lookupGlobalOccRn' which_gres rdr_name = @@ -1317,10 +1300,10 @@ lookupGlobalOccRn' which_gres rdr_name = Just gre -> return (greName gre) Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name) ; unboundName (LF which_suggest WL_Global) rdr_name } - where which_suggest = case which_gres of - IncludeFields WantBoth -> WL_RecField - IncludeFields WantField -> WL_RecField - _ -> WL_Anything + where which_suggest = case includeFieldSelectors which_gres of + WantBoth -> WL_RecField + WantField -> WL_RecField + WantNormal -> WL_Anything -- Looks up a RdrName occurrence in the GlobalRdrEnv and with -- lookupQualifiedNameGHCi. Does not try to find an Exact or Orig name first. @@ -1335,12 +1318,14 @@ lookupGlobalOccRn_base which_gres rdr_name = -- and only happens for failed lookups where fos = case which_gres of - IncludeFields f_or_s -> f_or_s - _ -> WantNormal + RelevantGREs { includeFieldSelectors = sel } -> sel + _ -> if isFieldOcc (rdrNameOcc rdr_name) + then WantField + else WantNormal -- | Lookup a 'Name' in the 'GlobalRdrEnv', falling back to looking up -- in the type environment it if fails. -lookupGREInfo_GRE :: Name -> RnM GREInfo +lookupGREInfo_GRE :: HasDebugCallStack => Name -> RnM GREInfo lookupGREInfo_GRE name = do { rdr_env <- getGlobalRdrEnv ; case lookupGRE_Name rdr_env name of @@ -1352,19 +1337,19 @@ lookupGREInfo_GRE name -- need to handle qualified imports in GHCi; see e.g. T9815ghci. lookupInfoOccRn :: RdrName -> RnM [Name] --- lookupInfoOccRn is intended for use in GHCi's ":info" command +-- ^ lookupInfoOccRn is intended for use in GHCi's ":info" command -- It finds all the GREs that RdrName could mean, not complaining --- about ambiguity, but rather returning them all --- C.f. #9881 +-- about ambiguity, but rather returning them all (c.f. #9881). +-- -- lookupInfoOccRn is also used in situations where we check for -- at least one definition of the RdrName, not complaining about --- multiple definitions. (See #17832) +-- multiple definitions (see #17832). lookupInfoOccRn rdr_name = lookupExactOrOrig rdr_name (\ gre -> [greName gre]) $ do { rdr_env <- getGlobalRdrEnv - ; let ns = map greName $ lookupGRE_RdrName (IncludeFields WantBoth) rdr_env rdr_name - ; qual_ns <- map greName <$> lookupQualifiedNameGHCi WantBoth rdr_name - ; return $ ns ++ (qual_ns `minusList` ns) } + ; let nms = map greName $ lookupGRE rdr_env (LookupRdrName rdr_name (RelevantGREsFOS WantBoth)) + ; qual_nms <- map greName <$> lookupQualifiedNameGHCi WantBoth rdr_name + ; return $ nms ++ (qual_nms `minusList` nms) } -- | Look up all record field names, available in the 'GlobalRdrEnv', -- that a given 'RdrName' might refer to. @@ -1379,7 +1364,7 @@ lookupFieldGREs env (L loc rdr) $ do { res <- lookupExactOrOrig rdr (\ gre -> maybeToList $ fieldGRE_maybe gre) $ do { let (env_fld_gres, env_var_gres) = partition isRecFldGRE $ - lookupGRE_RdrName (IncludeFields WantBoth) env rdr + lookupGRE env (LookupRdrName rdr (RelevantGREsFOS WantBoth)) -- Handle implicit qualified imports in GHCi. See T10439. ; ghci_gres <- lookupQualifiedNameGHCi WantBoth rdr @@ -1416,7 +1401,7 @@ lookupFieldGREs env (L loc rdr) lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt) lookupGlobalOccRn_overloaded rdr_name = lookupExactOrOrig_maybe rdr_name id $ - do { res <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name AllDeprecationWarnings + do { res <- lookupGreRn_helper (RelevantGREsFOS WantNormal) rdr_name AllDeprecationWarnings ; case res of GreNotFound -> lookupOneQualifiedNameGHCi WantNormal rdr_name OneNameMatch gre -> return $ Just gre @@ -1675,7 +1660,7 @@ is enabled then we defer the selection until the typechecker. lookupGreRn_helper :: WhichGREs GREInfo -> RdrName -> DeprecationWarnings -> RnM GreLookupResult lookupGreRn_helper which_gres rdr_name warn_if_deprec = do { env <- getGlobalRdrEnv - ; case lookupGRE_RdrName which_gres env rdr_name of + ; case lookupGRE env (LookupRdrName rdr_name which_gres) of [] -> return GreNotFound [gre] -> do { addUsedGRE warn_if_deprec gre ; return (OneNameMatch gre) } @@ -1689,7 +1674,7 @@ lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt) -- Uses addUsedRdrName to record use and deprecations lookupGreAvailRn rdr_name = do - mb_gre <- lookupGreRn_helper (IncludeFields WantNormal) rdr_name ExportDeprecationWarnings + mb_gre <- lookupGreRn_helper (RelevantGREsFOS WantNormal) rdr_name ExportDeprecationWarnings case mb_gre of GreNotFound -> do @@ -1828,10 +1813,11 @@ warnIfDeclDeprecated gre@(GRE { gre_imp = iss }) lookupImpDeclDeprec :: ModIface -> GlobalRdrElt -> Maybe (WarningTxt GhcRn) lookupImpDeclDeprec iface gre - = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus` -- Bleat if the thing, - case gre_par gre of -- or its parent, is warn'd - ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p) - NoParent -> Nothing + -- Bleat if the thing, or its parent, is warn'd + = mi_decl_warn_fn (mi_final_exts iface) (greOccName gre) `mplus` + case greParent gre of + ParentIs p -> mi_decl_warn_fn (mi_final_exts iface) (nameOccName p) + NoParent -> Nothing warnIfExportDeprecated :: GlobalRdrElt -> RnM () warnIfExportDeprecated gre@(GRE { gre_imp = iss }) @@ -2008,17 +1994,18 @@ lookupGREInfo hsc_env nm -- and looks up the TyThing in the type environment. -- -- See Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo. - = let lookup_res = unsafePerformIO $ do - let mod = nameModule nm + = case nameModule_maybe nm of + Nothing -> UnboundGRE + Just mod -> + unsafePerformIO $ do _ <- initIfaceLoad hsc_env $ loadInterface (text "lookupGREInfo" <+> parens (ppr nm)) mod ImportBySystem - lookupType hsc_env nm - in - case lookup_res of - Nothing -> pprPanic "lookupGREInfo" $ - vcat [ text "lookup failed:" <+> ppr nm ] - Just ty_thing -> tyThingGREInfo ty_thing + mb_ty_thing <- lookupType hsc_env nm + case mb_ty_thing of + Nothing -> pprPanic "lookupGREInfo" $ + vcat [ text "lookup failed:" <+> ppr nm ] + Just ty_thing -> return $ tyThingGREInfo ty_thing {- Note [Looking up signature names] @@ -2102,31 +2089,41 @@ lookupSigCtxtOccRn :: HsSigCtxt -> RnM (GenLocated (SrcSpanAnn' ann) Name) lookupSigCtxtOccRn ctxt what = wrapLocMA $ \ rdr_name -> - do { mb_name <- lookupBindGroupOcc ctxt what rdr_name - ; case mb_name of - Left err -> do { addErr (mkTcRnNotInScope rdr_name err) - ; return (mkUnboundNameRdr rdr_name) } - Right name -> return name } + do { let also_try_tycons = False + ; mb_names <- lookupBindGroupOcc ctxt what rdr_name also_try_tycons + ; case mb_names of + Right name NE.:| rest -> + do { massertPpr (null rest) $ + vcat (text "lookupSigCtxtOccRn" <+> ppr name : map (either (pprScopeError rdr_name) ppr) rest) + ; return name } + Left err NE.:| _ -> + do { addErr (mkTcRnNotInScope rdr_name err) + ; return (mkUnboundNameRdr rdr_name) } + } lookupBindGroupOcc :: HsSigCtxt -> SDoc - -> RdrName -> RnM (Either NotInScopeError Name) --- Looks up the RdrName, expecting it to resolve to one of the --- bound names passed in. If not, return an appropriate error message + -> RdrName -- ^ what to look up + -> Bool -- ^ if the 'RdrName' we are looking up is in + -- a value 'NameSpace', should we also look up + -- in the type constructor 'NameSpace'? + -> RnM (NE.NonEmpty (Either NotInScopeError Name)) +-- ^ Looks up the 'RdrName', expecting it to resolve to one of the +-- bound names currently in scope. If not, return an appropriate error message. -- --- See Note [Looking up signature names] -lookupBindGroupOcc ctxt what rdr_name +-- See Note [Looking up signature names]. +lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns | Just n <- isExact_maybe rdr_name - = fmap greName <$> lookupExactOcc_either n - -- allow for the possibility of missing Exacts; - -- see Note [dataTcOccs and Exact Names] + = do { mb_gre <- lookupExactOcc_either n + ; return $ case mb_gre of + Left err -> NE.singleton $ Left err + Right gre -> finish (NoExactName $ greName gre) gre } -- Maybe we should check the side conditions -- but it's a pain, and Exact things only show -- up when you know what you are doing | Just (rdr_mod, rdr_occ) <- isOrig_maybe rdr_name - = do { n' <- lookupOrig rdr_mod rdr_occ - ; return (Right n') } + = do { NE.singleton . Right <$> lookupOrig rdr_mod rdr_occ } | otherwise = case ctxt of @@ -2136,32 +2133,45 @@ lookupBindGroupOcc ctxt what rdr_name LocalBindCtxt ns -> lookup_group ns ClsDeclCtxt cls -> lookup_cls_op cls InstDeclCtxt ns -> if uniqSetAny isUnboundName ns -- #16610 - then return (Right $ mkUnboundNameRdr rdr_name) + then return $ NE.singleton $ Right $ mkUnboundNameRdr rdr_name else lookup_top (`elemNameSet` ns) where + + ns = occNameSpace occ + occ = rdrNameOcc rdr_name + relevant_gres = + RelevantGREs + { includeFieldSelectors = WantBoth + , lookupVariablesForFields = True + , lookupTyConsAsWell = also_try_tycon_ns } + ok_gre = greIsRelevant relevant_gres ns + + finish err gre + | ok_gre gre + = NE.singleton (Right $ greName gre) + | otherwise + = NE.singleton (Left err) + lookup_cls_op cls - = lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name + = NE.singleton <$> lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name where doc = text "method of class" <+> quotes (ppr cls) lookup_top keep_me = do { env <- getGlobalRdrEnv - ; dflags <- getDynFlags - ; let all_gres = lookupGRE_OccName (IncludeFields WantNormal) env (rdrNameOcc rdr_name) + ; let occ = rdrNameOcc rdr_name + all_gres = lookupGRE env (LookupOccName occ relevant_gres) names_in_scope = -- If rdr_name lacks a binding, only - -- recommend alternatives from related + -- recommend alternatives from relevant -- namespaces. See #17593. - filter (\n -> nameSpacesRelated dflags WL_Anything - (rdrNameSpace rdr_name) - (nameNameSpace n)) - $ map greName - $ filter isLocalGRE + map greName + $ filter (ok_gre <&&> isLocalGRE) $ globalRdrEnvElts env candidates_msg = candidates names_in_scope ; case filter (keep_me . greName) all_gres of [] | null all_gres -> bale_out_with candidates_msg | otherwise -> bale_out_with local_msg - (gre:_) -> return (Right (greName gre)) } + (gre1:gres) -> return (fmap (Right . greName) (gre1 NE.:| gres)) } lookup_group bound_names -- Look in the local envt (not top level) = do { mname <- lookupLocalOccRn_maybe rdr_name @@ -2169,11 +2179,11 @@ lookupBindGroupOcc ctxt what rdr_name ; let candidates_msg = candidates $ localRdrEnvElts env ; case mname of Just n - | n `elemNameSet` bound_names -> return (Right n) + | n `elemNameSet` bound_names -> return $ NE.singleton $ Right n | otherwise -> bale_out_with local_msg Nothing -> bale_out_with candidates_msg } - bale_out_with hints = return (Left $ MissingBinding what hints) + bale_out_with hints = return $ NE.singleton $ Left $ MissingBinding what hints local_msg = [SuggestMoveToDeclarationSite what rdr_name] @@ -2187,8 +2197,8 @@ lookupBindGroupOcc ctxt what rdr_name where similar_names = fuzzyLookup (unpackFS $ occNameFS $ rdrNameOcc rdr_name) - $ map (\x -> ((unpackFS $ occNameFS $ nameOccName x), x)) - names_in_scope + $ map (\x -> ((unpackFS $ occNameFS $ nameOccName x), x)) + names_in_scope --------------- @@ -2197,17 +2207,16 @@ lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)] -- Used for top-level fixity signatures and deprecations. -- Complain if neither is in scope. -- See Note [Fixity signature lookup] -lookupLocalTcNames ctxt what rdr_name - = do { mb_gres <- mapM lookup (dataTcOccs rdr_name) - ; let (errs, names) = partitionEithers mb_gres +lookupLocalTcNames ctxt what rdr + = do { this_mod <- getModule + ; let also_try_tycon_ns = True + ; nms_eithers <- fmap (guard_builtin_syntax this_mod rdr) <$> + lookupBindGroupOcc ctxt what rdr also_try_tycon_ns + ; let (errs, names) = partitionEithers (NE.toList nms_eithers) ; when (null names) $ addErr (head errs) -- Bleat about one only ; return names } where - lookup rdr = do { this_mod <- getModule - ; nameEither <- lookupBindGroupOcc ctxt what rdr - ; return (guard_builtin_syntax this_mod rdr nameEither) } - -- Guard against the built-in syntax (ex: `infixl 6 :`), see #15233 guard_builtin_syntax this_mod rdr (Right name) | Just _ <- isBuiltInOcc_maybe (occName rdr) @@ -2216,7 +2225,7 @@ lookupLocalTcNames ctxt what rdr_name | otherwise = Right (rdr, name) guard_builtin_syntax _ _ (Left err) - = Left $ mkTcRnNotInScope rdr_name err + = Left $ mkTcRnNotInScope rdr err dataTcOccs :: RdrName -> [RdrName] -- Return both the given name and the same name promoted to the TcClsName @@ -2231,9 +2240,8 @@ dataTcOccs rdr_name occ = rdrNameOcc rdr_name rdr_name_tc = setRdrNameSpace rdr_name tcName -{- -Note [dataTcOccs and Exact Names] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [dataTcOccs and Exact Names] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Exact RdrNames can occur in code generated by Template Haskell, and generally those references are, well, exact. However, the TH `Name` type isn't expressive enough to always track the correct namespace information, so we sometimes get @@ -2249,8 +2257,6 @@ Note that setRdrNameSpace on an Exact name requires the Name to be External, which it always is for built in syntax. -} - - {- ************************************************************************ * * ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -261,7 +261,7 @@ rnExpr (HsVar _ (L l v)) Nothing -> rnUnboundVar v ; Just gre -> do { let nm = greName gre - info = gre_info gre + info = greInfo gre ; if | IAmRecField fld_info <- info -- Since GHC 9.4, such occurrences of record fields must be -- unambiguous. For ambiguous occurrences, we arbitrarily pick one ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1143,7 +1143,7 @@ warn_term_var_capture lVar = do case demoteRdrNameTv $ unLoc lVar of Nothing -> return () Just demoted_name -> do - let global_vars = lookupGRE_RdrName SameOccName gbl_env demoted_name + let global_vars = lookupGRE gbl_env (LookupRdrName demoted_name SameNameSpace) let mlocal_var = lookupLocalRdrEnv local_env demoted_name case mlocal_var of Just name -> warnCapturedTerm lVar (Right name) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -287,7 +287,10 @@ rnSrcWarnDecls bndr_set decls' = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc) rdr_names ; txt' <- rnWarningTxt txt - ; return [(rdrNameOcc rdr, txt') | (rdr, _) <- names] } + ; return [(nameOccName nm, txt') | (_, nm) <- names] } + -- Use the OccName from the Name we looked up, rather than from the RdrName, + -- as we might hit multiple different NameSpaces when looking up + -- (e.g. deprecating both a variable and a record field). what = text "deprecation" @@ -1552,7 +1555,7 @@ toParents rdr_env ns getParent :: GlobalRdrEnv -> Name -> Name getParent rdr_env n = case lookupGRE_Name rdr_env n of - Just gre -> case gre_par gre of + Just gre -> case greParent gre of ParentIs { par_is = p } -> p _ -> n Nothing -> n ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -730,7 +730,7 @@ extendGlobalRdrEnvRn new_gres new_fixities where -- See Note [Reporting duplicate local declarations] dups = filter isBadDupGRE - $ lookupGRE_OccName (AllNameSpaces WantBoth) env (greOccName gre) + $ lookupGRE env (LookupOccName (greOccName gre) (RelevantGREsFOS WantBoth)) isBadDupGRE old_gre = isLocalGRE old_gre && greClashesWith gre old_gre {- Note [Fail fast on duplicate definitions] @@ -927,7 +927,7 @@ getLocalNonValBinders fixity_env -- See (1) above L loc cls_rdr <- MaybeT $ pure $ getLHsInstDeclClass_maybe inst_ty -- See (2) above - MaybeT $ setSrcSpan (locA loc) $ lookupGlobalOccRn_maybe SameOccName cls_rdr + MaybeT $ setSrcSpan (locA loc) $ lookupGlobalOccRn_maybe SameNameSpace cls_rdr -- Assuming the previous step succeeded, process any associated data -- family instances. If the previous step failed, bail out. case mb_cls_gre of @@ -1530,7 +1530,7 @@ to a list of items, rather than a single item. mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt] mkChildEnv gres = foldr add emptyNameEnv gres where - add gre env = case gre_par gre of + add gre env = case greParent gre of ParentIs p -> extendNameEnv_Acc (:) Utils.singleton env p gre NoParent -> env ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -105,10 +105,10 @@ mkUnboundNameRdr :: RdrName -> Name mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr) mkUnboundGRE :: OccName -> GlobalRdrElt -mkUnboundGRE occ = mkLocalVanillaGRE NoParent $ mkUnboundName occ +mkUnboundGRE occ = mkLocalGRE UnboundGRE NoParent $ mkUnboundName occ mkUnboundGRERdr :: RdrName -> GlobalRdrElt -mkUnboundGRERdr rdr = mkLocalVanillaGRE NoParent $ mkUnboundNameRdr rdr +mkUnboundGRERdr rdr = mkLocalGRE UnboundGRE NoParent $ mkUnboundNameRdr rdr reportUnboundName' :: WhatLooking -> RdrName -> RnM Name reportUnboundName' what_look rdr = unboundName (LF what_look WL_Anywhere) rdr @@ -212,8 +212,8 @@ fieldSelectorSuggestions global_env tried_rdr_name | otherwise = [RemindFieldSelectorSuppressed tried_rdr_name parents] where gres = filter isNoFieldSelectorGRE - $ lookupGRE_RdrName (IncludeFields WantField) global_env tried_rdr_name - parents = [ parent | ParentIs parent <- map gre_par gres ] + $ lookupGRE global_env (LookupRdrName tried_rdr_name AllRelevantGREs) + parents = [ parent | ParentIs parent <- map greParent gres ] similarNameSuggestions :: LookingFor -> DynFlags -> GlobalRdrEnv -> LocalRdrEnv @@ -355,7 +355,8 @@ importSuggestions looking_for global_env hpt currMod imports rdr_name helpful_imports = filter helpful interesting_imports where helpful (_,imv) = any (isGreOk looking_for) $ - lookupGRE_OccName (AllNameSpaces WantNormal) (imv_all_exports imv) occ_name + lookupGRE (imv_all_exports imv) + (LookupOccName occ_name $ RelevantGREsFOS WantNormal) -- Which of these do that because of an explicit hiding list resp. an -- explicit import list ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -164,7 +164,7 @@ checkShadowedOccs (global_env,local_env) get_loc_occ ns where (loc,occ) = get_loc_occ n mb_local = lookupLocalRdrOcc local_env occ - gres = lookupGRE_RdrName (AllNameSpaces WantBoth) global_env (mkRdrUnqual occ) + gres = lookupGRE global_env (LookupRdrName (mkRdrUnqual occ) (RelevantGREsFOS WantBoth)) -- Make an Unqualified RdrName and look that up, so that -- we don't find any GREs that are in scope qualified-only @@ -349,7 +349,7 @@ warnUnusedTopBinds gres = whenWOptM Opt_WarnUnusedTopBinds $ do env <- getGblEnv let isBoot = isHsBootFile $ tcg_src env - let noParent gre = case gre_par gre of + let noParent gre = case greParent gre of NoParent -> True _ -> False -- Don't warn about unused bindings with parents in ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -362,7 +362,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do imp_spec = ImpSpec decl_spec ImpAll env = mkGlobalRdrEnv $ gresFromAvails hsc_env (Just imp_spec) (mi_exports iface) - case lookupGRE_RdrName (IncludeFields WantNormal) env rdr_name of + case lookupGRE env (LookupRdrName rdr_name (RelevantGREsFOS WantNormal)) of [gre] -> return (Just (greName gre, iface)) [] -> return Nothing _ -> panic "lookupRdrNameInModule" ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -2384,7 +2384,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm | otherwise = [] occ_name_in_scope glb_env lcl_env occ_name = not $ - null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) && + null (lookupGRE glb_env (LookupOccName occ_name (RelevantGREsFOS WantNormal))) && isNothing (lookupLocalRdrOcc lcl_env occ_name) record_field = case orig of ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -654,9 +654,9 @@ instance Diagnostic TcRnMessage where fld = quotes $ ppr (occNameFS $ greOccName gre1) pprSugg gre = vcat [ bullet <+> pprGRE gre <> comma , nest 2 (pprNameProvenance gre) ] - pprGRE gre = case gre_info gre of + pprGRE gre = case greInfo gre of IAmRecField {} - -> let parent = par_is $ gre_par gre + -> let parent = par_is $ greParent gre in text "record field" <+> fld <+> text "of" <+> quotes (ppr parent) _ -> text "variable" <+> fld TcRnAmbiguousRecordUpdate _rupd tc @@ -3294,7 +3294,7 @@ dodgy_msg kind tc ie where rest :: [SDoc] rest = - case gre_info tc of + case greInfo tc of IAmTyCon ClassFlavour -> [ text "(in-scope) class methods or associated types" <> comma , text "but it has none" ] @@ -4629,10 +4629,10 @@ pp_rdr_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hol pprScopeError :: RdrName -> NotInScopeError -> SDoc pprScopeError rdr_name scope_err = case scope_err of - NotInScope {} -> + NotInScope -> hang (text "Not in scope:") 2 (what <+> quotes (ppr rdr_name)) - NotARecordField {} -> + NotARecordField -> hang (text "Not in scope:") 2 (text "record field" <+> quotes (ppr rdr_name)) NoExactName name -> @@ -5467,7 +5467,7 @@ pprUnusedName name reason = -- See #15487 pprAmbiguousGreName :: GlobalRdrEnv -> GlobalRdrElt -> SDoc pprAmbiguousGreName gre_env gre - | IAmRecField fld_info <- gre_info gre + | IAmRecField fld_info <- greInfo gre = sep [ text "the field" <+> quotes (ppr occ) <+> parent_info fld_info <> comma , pprNameProvenance gre ] | otherwise @@ -5480,13 +5480,13 @@ pprAmbiguousGreName gre_env gre case first_con of PatSynName ps -> text "of pattern synonym" <+> quotes (ppr ps) DataConName {} -> - case gre_par gre of + case greParent gre of ParentIs par -- For a data family, only reporting the family TyCon can be -- unhelpful (see T23301). So we give a bit of additional -- info in that case. | Just par_gre <- lookupGRE_Name gre_env par - , IAmTyCon tc_flav <- gre_info par_gre + , IAmTyCon tc_flav <- greInfo par_gre , OpenFamilyFlavour IAmData _ <- tc_flav -> vcat [ ppr_cons , text "in a data family instance of" <+> quotes (ppr par) ] ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5284,10 +5284,9 @@ data NotInScopeError -- | A run-of-the-mill @"not in scope"@ error. = NotInScope - -- | Something used in record syntax, but it isn't a record field. + -- | Like 'NotInScope', but when we know we are looking for a + -- record field. | NotARecordField - -- TODO: this could be folded into NotInScope were there - -- a separate namespace for record fields. -- | An exact 'Name' was not in scope. -- ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -683,28 +683,19 @@ lookupChildrenExport :: Name -> [LIEWrappedName GhcPs] -> RnM ([(LIEWrappedName GhcRn, GlobalRdrElt)]) lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items where - -- Pick out the possible namespaces in order of priority - -- This is a consequence of how the parser parses all - -- data constructors as type constructors. - choosePossibleNamespaces :: NameSpace -> [NameSpace] - choosePossibleNamespaces ns - | ns == varName = [varName, tcName] - -- NB: for varName, we will also end up looking in the - -- record field namespaces. - | ns == tcName = [dataName, tcName] - | otherwise = [ns] -- Process an individual child doOne :: LIEWrappedName GhcPs -> RnM (LIEWrappedName GhcRn, GlobalRdrElt) doOne n = do let bareName = (ieWrappedName . unLoc) n - -- Do not report export list declaration deprecations - lkup v = lookupSubBndrOcc_helper False ExportDeprecationWarnings - spec_parent (setRdrNameSpace bareName v) + what_lkup :: LookupChild + what_lkup = LookupChild { wantedParent = spec_parent + , lookupDataConFirst = True } - name <- combineChildLookupResult $ map lkup $ - choosePossibleNamespaces (rdrNameSpace bareName) + -- Do not report export list declaration deprecations + name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings + spec_parent bareName what_lkup traceRn "lookupChildrenExport" (ppr name) -- Default to data constructors for slightly better error -- messages @@ -717,7 +708,7 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items NameNotFound -> do { ub <- reportUnboundName unboundName ; let l = getLoc n - gre = mkLocalVanillaGRE NoParent ub + gre = mkLocalGRE UnboundGRE NoParent ub ; return (L l (IEName noExtField (L (la2na l) ub)), gre)} FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) -> do { checkPatSynParent spec_parent par child_nm ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -958,9 +958,10 @@ checkHiBootIface' = Just (gre, Nothing) matching_flds | isVarOcc missing_occ -- (This only applies to variables.) - = lookupGRE_OccName (IncludeFields WantField) gre_env missing_occ + = lookupGRE gre_env $ + LookupOccName missing_occ (RelevantGREsFOS WantField) | otherwise - = [] + = [] -- BootFldReexport T18999_NoDisambiguateRecordFields T16745A in case mapMaybe mb_ok $ matching_flds of @@ -1750,7 +1751,7 @@ checkMainType tcg_env do { rdr_env <- getGlobalRdrEnv ; let dflags = hsc_dflags hsc_env main_occ = getMainOcc dflags - main_gres = lookupGRE_OccName SameOccName rdr_env main_occ + main_gres = lookupGRE rdr_env (LookupOccName main_occ SameNameSpace) ; case filter isLocalGRE main_gres of { [] -> return emptyWC ; (_:_:_) -> return emptyWC ; ===================================== compiler/GHC/Tc/Utils/Backpack.hs ===================================== @@ -160,7 +160,7 @@ checkHsigIface tcg_env gre_env sig_iface -- The hsig did NOT define this function; that means it must -- be a reexport. In this case, make sure the 'Name' of the -- reexport matches the 'Name' exported here. - | [gre] <- lookupGRE_OccName (AllNameSpaces WantNormal) gre_env (nameOccName name) = do + | [gre] <- lookupGRE gre_env (LookupOccName (nameOccName name) SameNameSpace) = do let name' = greName gre when (name /= name') $ do -- See Note [Error reporting bad reexport] @@ -741,7 +741,7 @@ mergeSignatures -- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env let fix_env = mkNameEnv [ (greName rdr_elt, FixItem occ f) | (occ, f) <- concatMap mi_fixities ifaces - , rdr_elt <- lookupGRE_OccName (AllNameSpaces WantBoth) rdr_env occ ] + , rdr_elt <- lookupGRE rdr_env (LookupOccName occ AllRelevantGREs) ] -- STEP 5: Typecheck the interfaces let type_env_var = tcg_type_env_var tcg_env @@ -955,7 +955,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do impl_iface False{- safe -} NotBoot ImportedBySystem fix_env = mkNameEnv [ (greName rdr_elt, FixItem occ f) | (occ, f) <- mi_fixities impl_iface - , rdr_elt <- lookupGRE_OccName (AllNameSpaces WantBoth) impl_gr occ ] + , rdr_elt <- lookupGRE impl_gr (LookupOccName occ AllRelevantGREs) ] updGblEnv (\tcg_env -> tcg_env { -- Setting tcg_rdr_env to treat all exported entities from -- the implementing module as in scope improves error messages, @@ -989,7 +989,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do -- STEP 3: Check that the implementing interface exports everything -- we need. (Notice we IGNORE the Modules in the AvailInfos.) forM_ (exportOccs (mi_exports isig_iface)) $ \occ -> - case lookupGRE_OccName SameOccName impl_gr occ of + case lookupGRE impl_gr (LookupOccName occ SameNameSpace) of [] -> addErr $ TcRnHsigMissingModuleExport occ unit_state impl_mod _ -> return () failIfErrsM ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -31,7 +31,6 @@ where import GHC.Prelude hiding (init, last, tail) import GHC.Hs as Hs -import GHC.Builtin.Names import GHC.Tc.Errors.Types import GHC.Types.Name.Reader import qualified GHC.Types.Name as Name ===================================== compiler/GHC/Types/GREInfo.hs ===================================== @@ -113,6 +113,8 @@ Search for references to this note in the code for illustration. data GREInfo -- | No particular information... e.g. a function = Vanilla + -- | An unbound GRE... could be anything + | UnboundGRE -- | 'TyCon' | IAmTyCon !(TyConFlavour Name) -- | 'ConLike' @@ -126,12 +128,14 @@ data GREInfo instance NFData GREInfo where rnf Vanilla = () + rnf UnboundGRE = () rnf (IAmTyCon tc) = rnf tc rnf (IAmConLike info) = rnf info rnf (IAmRecField info) = rnf info plusGREInfo :: GREInfo -> GREInfo -> GREInfo plusGREInfo Vanilla Vanilla = Vanilla +plusGREInfo UnboundGRE UnboundGRE = UnboundGRE plusGREInfo (IAmTyCon {}) info2@(IAmTyCon {}) = info2 plusGREInfo (IAmConLike {}) info2@(IAmConLike {}) = info2 plusGREInfo (IAmRecField {}) info2@(IAmRecField {}) = info2 @@ -141,6 +145,7 @@ plusGREInfo info1 info2 = pprPanic "plusInfo" $ instance Outputable GREInfo where ppr Vanilla = text "Vanilla" + ppr UnboundGRE = text "UnboundGRE" ppr (IAmTyCon flav) = text "TyCon" <+> ppr flav ppr (IAmConLike info) ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -89,7 +89,8 @@ module GHC.Types.Name.Occurrence ( OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv, strictMapOccEnv, mapMaybeOccEnv, - lookupOccEnv, lookupOccEnv_WithFields, lookupFieldsOccEnv, + lookupOccEnv, lookupOccEnv_AllNameSpaces, + lookupOccEnv_WithFields, lookupFieldsOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv, nonDetOccEnvElts, nonDetFoldOccEnv, plusOccEnv, plusOccEnv_C, @@ -614,6 +615,13 @@ lookupOccEnv (MkOccEnv as) (OccName ns s) = do { m <- lookupFsEnv as s ; lookupUFM m ns } +-- | Lookup an element in an 'OccEnv', ignoring 'NameSpace's entirely. +lookupOccEnv_AllNameSpaces :: OccEnv a -> OccName -> [a] +lookupOccEnv_AllNameSpaces (MkOccEnv as) (OccName _ s) + = case lookupFsEnv as s of + Nothing -> [] + Just r -> nonDetEltsUFM r + -- | Lookup an element in an 'OccEnv', looking in the record field -- namespace for a variable. lookupOccEnv_WithFields :: OccEnv a -> OccName -> [a] ===================================== compiler/GHC/Types/Name/Ppr.hs ===================================== @@ -97,7 +97,8 @@ mkQualName env = qual_name where = NameQual (greQualModName gre) | null qual_gres - = if null (lookupGRE_RdrName SameOccName env (mkRdrQual (moduleName mod) occ)) + = if null $ lookupGRE env $ + LookupRdrName (mkRdrQual (moduleName mod) occ) SameNameSpace then NameNotInScope1 else NameNotInScope2 @@ -127,8 +128,8 @@ mkQualName env = qual_name where right_name gre = greDefinitionModule gre == Just mod - unqual_gres = lookupGRE_RdrName SameOccName env (mkRdrUnqual occ) - qual_gres = filter right_name (lookupGRE_OccName SameOccName env occ) + unqual_gres = lookupGRE env (LookupRdrName (mkRdrUnqual occ) SameNameSpace) + qual_gres = filter right_name (lookupGRE env (LookupOccName occ SameNameSpace)) -- we can mention a module P:M without the P: qualifier iff -- "import M" would resolve unambiguously to P:M. (if P is the @@ -150,7 +151,7 @@ mkPromTick ptc env = ptcListTuplePuns ptc | Just occ' <- promoteOccName occ - , [] <- lookupGRE_RdrName SameOccName env (mkRdrUnqual occ') + , [] <- lookupGRE env (LookupRdrName (mkRdrUnqual occ') SameNameSpace) = -- Could not find a corresponding type name in the environment, -- so the data name is unambiguous. Promotion tick not needed. False ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -7,6 +7,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} -- | -- #name_types# @@ -53,7 +55,13 @@ module GHC.Types.Name.Reader ( -- ** Looking up 'GlobalRdrElt's FieldsOrSelectors(..), filterFieldGREs, allowGRE, - WhichGREs(..), lookupGRE_OccName, lookupGRE_RdrName, lookupGRE_Name, + + LookupGRE(..), lookupGRE, + WhichGREs(.., AllRelevantGREs, RelevantGREsFOS), + greIsRelevant, + LookupChild(..), + + lookupGRE_Name, lookupGRE_FieldLabel, getGRE_NameQualifier_maybes, transformGREs, pickGREs, pickGREsModExp, @@ -67,7 +75,8 @@ module GHC.Types.Name.Reader ( -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' GlobalRdrEltX(..), GlobalRdrElt, IfGlobalRdrElt, FieldGlobalRdrElt, - greName, forceGlobalRdrEnv, hydrateGlobalRdrEnv, + greName, greNameSpace, greParent, greInfo, + forceGlobalRdrEnv, hydrateGlobalRdrEnv, isLocalGRE, isImportedGRE, isRecFldGRE, fieldGREInfo, isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE, @@ -126,6 +135,7 @@ import GHC.Utils.Panic import Control.DeepSeq import Control.Monad ( guard ) import Data.Data +import Data.List ( sort ) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Semigroup as S @@ -583,8 +593,8 @@ absence of the 'GREInfo' field. This parametrisation also helps ensure that we don't accidentally force the GREInfo field (which can cause unnecessary loading of interface files). -In particular, the 'lookupGRE_OccName' is statically guaranteed to not consult -the 'GREInfo' field when its first argument is 'SameOccName', which is important +In particular, the 'lookupGRE' function is statically guaranteed to not consult +the 'GREInfo' field when using 'SameNameSpace', which is important as we sometimes need to use this function with an 'IfaceGlobalRdrEnv' in which the 'GREInfo' fields have been stripped. -} @@ -596,6 +606,15 @@ type FieldGlobalRdrElt = GlobalRdrElt greName :: GlobalRdrEltX info -> Name greName = gre_name +greNameSpace :: GlobalRdrEltX info -> NameSpace +greNameSpace = nameNameSpace . greName + +greParent :: GlobalRdrEltX info -> Parent +greParent = gre_par + +greInfo :: GlobalRdrElt -> GREInfo +greInfo = gre_info + instance NFData IfGlobalRdrElt where rnf !_ = () @@ -1023,7 +1042,7 @@ fieldGRELabel = recFieldLabel . fieldGREInfo fieldGREInfo :: HasDebugCallStack => FieldGlobalRdrElt -> RecFieldInfo fieldGREInfo gre = assertPpr (isRecFldGRE gre) (ppr gre) $ - case gre_info gre of + case greInfo gre of IAmRecField info -> info info -> pprPanic "fieldGREInfo" $ vcat [ text "gre_name:" <+> ppr (greName gre) @@ -1031,13 +1050,13 @@ fieldGREInfo gre recFieldConLike_maybe :: HasDebugCallStack => GlobalRdrElt -> Maybe ConInfo recFieldConLike_maybe gre = - case gre_info gre of + case greInfo gre of IAmConLike info -> Just info _ -> Nothing recFieldInfo_maybe :: HasDebugCallStack => GlobalRdrElt -> Maybe RecFieldInfo recFieldInfo_maybe gre = - case gre_info gre of + case greInfo gre of IAmRecField info -> assertPpr (isRecFldGRE gre) (ppr gre) $ Just info _ -> Nothing @@ -1051,7 +1070,7 @@ data FieldsOrSelectors -- they have selectors). | WantField -- ^ Include only fields, with or without selectors, ignoring -- any non-fields in scope. - deriving Eq + deriving (Eq, Show) filterFieldGREs :: FieldsOrSelectors -> [GlobalRdrElt] -> [GlobalRdrElt] filterFieldGREs WantBoth = id @@ -1072,7 +1091,7 @@ allowGRE WantNormal gre allowGRE WantField gre = isRecFldGRE gre --- | How should we look up in a 'GlobalRdrEnv'? Should we only look up +-- | What should we look up in a 'GlobalRdrEnv'? Should we only look up -- names with the exact same 'OccName', or do we allow different 'NameSpace's? -- -- Depending on the answer, we might need more or less information from the @@ -1081,71 +1100,245 @@ allowGRE WantField gre -- we need to consult the 'GREInfo'. This is why this datatype is a GADT. -- -- See Note [IfGlobalRdrEnv]. -data WhichGREs info where +data LookupGRE info where -- | Look for this specific 'OccName', with the exact same 'NameSpace', -- in the 'GlobalRdrEnv'. - SameOccName :: WhichGREs info - -- | If the 'OccName' is a variable, also look up in the record field namespaces. - -- - -- Used to look up variables which might refer to record fields. - IncludeFields :: FieldsOrSelectors - -- ^ - Should we include record fields defined with @-XNoFieldSelectors@? - -- - Should we include non-fields? - -- - -- See Note [NoFieldSelectors]. - -> WhichGREs GREInfo - -- | Like @'IncludeFields'@, but if the 'OccName' is a field, - -- also look up in the variable namespace. + LookupOccName :: OccName -- ^ the 'OccName' to look up + -> WhichGREs info + -- ^ information about other relevant 'NameSpace's + -> LookupGRE info + + -- | Look up the 'OccName' of this 'RdrName' in the 'GlobalRdrEnv', + -- filtering out those whose qualification matches that of the 'RdrName'. -- - -- Used to check if there are name clashes. - AllNameSpaces :: FieldsOrSelectors -> WhichGREs GREInfo + -- Lookup returns an empty result for 'Exact' or 'Orig' 'RdrName's. + LookupRdrName :: RdrName -- ^ the 'RdrName' to look up + -> WhichGREs info + -- ^ information about other relevant 'NameSpace's + -> LookupGRE info --- | Look for this 'OccName' in the global environment. --- --- The 'WhichGREs' argument specifies which 'GlobalRdrElt's we are interested in. -lookupGRE_OccName :: WhichGREs info -> GlobalRdrEnvX info -> OccName -> [GlobalRdrEltX info] -lookupGRE_OccName what env occ - -- If the 'RdrName' is a variable, we might also need - -- to look up in the record field namespaces. - | isVarOcc occ - , Just flds <- mb_flds - = normal ++ flds - -- If the 'RdrName' is a record field, we might want to check - -- the variable namespace too. - | isFieldOcc occ - , Just flds <- mb_flds - = flds ++ case what of { AllNameSpaces {} -> vars; _ -> [] } + -- | Look for 'GRE's with the same unique as the given 'Name' + -- in the 'GlobalRdrEnv'. + LookupExactName + :: { lookupExactName :: Name + -- ^ the 'Name' to look up + , lookInAllNameSpaces :: Bool + -- ^ whether to look in *all* 'NameSpace's, or just + -- in the 'NameSpace' of the 'Name' + -- See Note [Template Haskell ambiguity] + } + -> LookupGRE info + + -- | Look up children 'GlobalRdrElt's with a given 'Parent'. + LookupChildren + :: OccName -- ^ the 'OccName' to look up + -> LookupChild + -- ^ information to decide which 'GlobalRdrElt's + -- are valid children after looking up + -> LookupGRE info + +-- | How should we look up in a 'GlobalRdrEnv'? +-- Which 'NameSpace's are considered relevant for a given lookup? +data WhichGREs info where + -- | Only consider 'GlobalRdrElt's with the exact 'NameSpace' we look up. + SameNameSpace :: WhichGREs info + -- | Allow 'GlobalRdrElt's with different 'NameSpace's, e.g. allow looking up + -- record fields from the variable 'NameSpace', or looking up a 'TyCon' from + -- the data constructor 'NameSpace'. + RelevantGREs + :: { includeFieldSelectors :: !FieldsOrSelectors + -- ^ how should we handle looking up variables? + -- + -- - should we include record fields defined with @-XNoFieldSelectors@? + -- - should we include non-fields? + -- + -- See Note [NoFieldSelectors]. + , lookupVariablesForFields :: !Bool + -- ^ when looking up a record field, should we also look up plain variables? + , lookupTyConsAsWell :: !Bool + -- ^ when looking up a variable, field or data constructor, should we + -- also try the type constructor 'NameSpace'? + } + -> WhichGREs GREInfo + +-- | Look up as many possibly relevant 'GlobalRdrElt's as possible. +pattern AllRelevantGREs :: WhichGREs GREInfo +pattern AllRelevantGREs = + RelevantGREs { includeFieldSelectors = WantBoth + , lookupVariablesForFields = True + , lookupTyConsAsWell = True } + +-- | Look up relevant GREs, taking into account the interaction between the +-- variable and field 'NameSpace's as determined by the 'FieldsOrSelector' +-- argument. +pattern RelevantGREsFOS :: FieldsOrSelectors -> WhichGREs GREInfo +pattern RelevantGREsFOS fos <- RelevantGREs { includeFieldSelectors = fos } + where + RelevantGREsFOS fos = + RelevantGREs { includeFieldSelectors = fos + , lookupVariablesForFields = fos == WantBoth + , lookupTyConsAsWell = False } + +data LookupChild + = LookupChild + { wantedParent :: Name + -- ^ the parent we are looking up children of + , lookupDataConFirst :: Bool + -- ^ for type constructors, should we look in the data constructor + -- namespace first? + } + +-- | After looking up something with the given 'NameSpace', is the resulting +-- 'GlobalRdrElt' we have obtained relevant, according to the 'RelevantGREs' +-- specification of which 'NameSpace's are relevant? +greIsRelevant :: WhichGREs GREInfo -- ^ specification of which 'GlobalRdrElt's to consider relevant + -> NameSpace -- ^ the 'NameSpace' of the thing we are looking up + -> GlobalRdrElt -- ^ the 'GlobalRdrElt' we have looked up, in a + -- potentially different 'NameSpace' than we wanted + -> Bool +greIsRelevant which_gres ns gre + | ns == other_ns + = True | otherwise - = normal + = case which_gres of + SameNameSpace -> False + RelevantGREs { includeFieldSelectors = fos + , lookupVariablesForFields = vars_for_flds + , lookupTyConsAsWell = tycons_too } + | ns == varName + -> (isFieldNameSpace other_ns && allowGRE fos gre) || tc_too + | isFieldNameSpace ns + -> vars_for_flds && + ( other_ns == varName + || (isFieldNameSpace other_ns && allowGRE fos gre) + || tc_too ) + | isDataConNameSpace ns + -> tc_too + | otherwise + -> False + where + tc_too = tycons_too && isTcClsNameSpace other_ns + where + other_ns = greNameSpace gre + +-- | Scoring priority function for looking up children 'GlobalRdrElt'. +-- +-- First we score by 'NameSpace', with higher-priority 'NameSpace's having a +-- lower number. Then we break ties by checking if the 'Parent' is correct. +-- +-- This complicated scoring function is determined by the behaviour required by +-- 'lookupChildrenExport', which requires us to look in the data constructor +-- 'NameSpace' first, for things in the type constructor 'NameSpace'. +childGREPriority :: LookupChild -- ^ what kind of child do we want, + -- e.g. what should its parent be? + -> NameSpace -- ^ what 'NameSpace' are we originally looking in? + -> GlobalRdrEltX info + -- ^ the result of looking up; it might be in a different + -- 'NameSpace', which is used to determine the score + -- (in the first component) + -> Maybe (Int, Int) +childGREPriority (LookupChild { wantedParent = wanted_parent, lookupDataConFirst = try_dc_first }) + ns gre = + case child_ns_prio $ greNameSpace gre of + Nothing -> Nothing + Just np -> Just (np, parent_prio $ greParent gre) + -- Prioritise GREs first on NameSpace, and then on Parent. + -- See T11970. where - mb_flds = - case what of - IncludeFields fos -> Just $ filterFieldGREs fos $ concat $ lookupFieldsOccEnv env (occNameFS occ) - AllNameSpaces fos -> Just $ filterFieldGREs fos $ concat $ lookupFieldsOccEnv env (occNameFS occ) - SameOccName -> Nothing + -- Pick out the possible 'NameSpace's in order of priority. + child_ns_prio :: (NameSpace -> Maybe Int) + child_ns_prio other_ns + | other_ns == ns + = Just 0 + | isTermVarOrFieldNameSpace ns + , isTermVarOrFieldNameSpace other_ns + = Just 0 + | ns == varName + , other_ns == tcName + -- When looking up children, we sometimes want to a symbolic variable + -- name to resolve to a type constructor, e.g. for an infix declaration + -- "infix +!" we want to take into account both class methods and associated + -- types. See test T10816. + = Just 1 + | ns == tcName + , other_ns == dataName + , try_dc_first -- try data namespace before type/class namespace? + = Just (-1) + | otherwise + = Nothing - normal = fromMaybe [] $ lookupOccEnv env occ - vars = fromMaybe [] $ lookupOccEnv env (recFieldToVarOcc occ) + parent_prio :: Parent -> Int + parent_prio (ParentIs other_parent) + | other_parent == wanted_parent = 0 + | otherwise = 1 + parent_prio NoParent = 0 --- | Like 'lookupGRE_OccName', but for a 'RdrName'. -lookupGRE_RdrName :: WhichGREs info -> GlobalRdrEnvX info -> RdrName -> [GlobalRdrEltX info] -lookupGRE_RdrName what env rdr = - pickGREs rdr $ lookupGRE_OccName what env (rdrNameOcc rdr) +-- | Look something up in the Global Reader Environment. +-- +-- The 'LookupGRE' argument specifies what to look up, and in particular +-- whether there should there be any lee-way if the 'NameSpace's don't +-- exactly match. +lookupGRE :: GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info] +lookupGRE env = \case + LookupOccName occ which_gres -> + case which_gres of + SameNameSpace -> + concat $ lookupOccEnv env occ + rel@(RelevantGREs{}) -> + filter (greIsRelevant rel (occNameSpace occ)) $ + concat $ lookupOccEnv_AllNameSpaces env occ + LookupRdrName rdr rel -> + pickGREs rdr $ lookupGRE env (LookupOccName (rdrNameOcc rdr) rel) + LookupExactName { lookupExactName = nm + , lookInAllNameSpaces = all_ns } -> + [ gre | gre <- lkup, greName gre == nm ] + where + occ = nameOccName nm + lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ + | otherwise = fromMaybe [] $ lookupOccEnv env occ + LookupChildren occ which_child -> + highestPriorityGREs (childGREPriority which_child ns) $ + concat $ lookupOccEnv_AllNameSpaces env occ + where + ns :: NameSpace + ns = occNameSpace occ --- | Look for precisely this 'Name' in the environment. +-- | Collect the 'GlobalRdrElt's with the highest priority according +-- to the given function (lower value <=> higher priority). +-- +-- This allows us to first look in e.g. the data 'NameSpace', and then fall back +-- to the type/class 'NameSpace'. +highestPriorityGREs :: forall info prio + . Ord prio + => (GlobalRdrEltX info -> Maybe prio) + -- ^ priority function + -- lower value <=> higher priority + -> [GlobalRdrEltX info] -> [GlobalRdrEltX info] +highestPriorityGREs priority gres = + take_highest_prio $ NE.group $ sort + [ S.Arg prio gre + | gre <- gres + , prio <- maybeToList $ priority gre ] + where + take_highest_prio :: [NE.NonEmpty (S.Arg prio (GlobalRdrEltX info))] -> [GlobalRdrEltX info] + take_highest_prio [] = [] + take_highest_prio (fs:_) = map (\ (S.Arg _ gre) -> gre) $ NE.toList fs +{-# INLINEABLE highestPriorityGREs #-} + +-- | Look for precisely this 'Name' in the environment, +-- in the __same 'NameSpace'__ as the 'Name'. -- -- This tests whether it is in scope, ignoring anything -- else that might be in scope which doesn't have the same 'Unique'. lookupGRE_Name :: Outputable info => GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info) lookupGRE_Name env name = - let occ = nameOccName name - in case [ gre | gre <- lookupGRE_OccName SameOccName env occ - , gre_name gre == name ] of + case lookupGRE env (LookupExactName { lookupExactName = name + , lookInAllNameSpaces = False }) of [] -> Nothing [gre] -> Just gre gres -> pprPanic "lookupGRE_Name" - (ppr name $$ ppr occ $$ ppr gres) + (ppr name $$ ppr (nameOccName name) $$ ppr gres) -- See INVARIANT 1 on GlobalRdrEnv -- | Look for a particular record field selector in the environment. @@ -1531,16 +1724,17 @@ greIsShadowed old_gre shadowed = -- | Whether a 'GlobalRdrElt' is definitely shadowed, definitely not shadowed, -- or conditionally shadowed based on more information beyond the 'NameSpace'. data IsShadowed + -- | The GRE is not shadowed. = IsNotShadowed + -- | The GRE is shadowed. | IsShadowed + -- | The GRE is shadowed iff it is a record field GRE + -- which defines a field selector (i.e. FieldSelectors is enabled in its + -- defining module). | IsShadowedIfFieldSelector -- | Internal function: is a 'GlobalRdrElt' with the 'NameSpace' with given -- 'Unique' shadowed by the specified 'ShadowedGREs'? --- --- - @Just b@ means: definitely @b at . --- - @Nothing@ means: the GRE is shadowed iff it is a record field GRE --- with FieldSelectors enabled. namespace_is_shadowed :: Unique -> ShadowedGREs -> IsShadowed namespace_is_shadowed old_ns (ShadowedGREs shadowed_nonflds shadowed_flds) | isFldNSUnique old_ns ===================================== testsuite/tests/overloadedrecflds/should_compile/BootFldReexport.stderr ===================================== @@ -2,10 +2,10 @@ BootFldReexport.hs:8:9: error: [GHC-87543] Ambiguous occurrence ‘fld’. It could refer to - either ‘BootFldReexport_N.fld’, + either the field ‘fld’ of record ‘BootFldReexport_O.O’, + imported from ‘BootFldReexport_O’ at BootFldReexport.hs:6:5-7 + (and originally defined at BootFldReexport_O.hs:5:16-18), + or ‘BootFldReexport_N.fld’, imported from ‘BootFldReexport_N’ at BootFldReexport.hs:4:5-7 (and originally defined in ‘BootFldReexport_O’ - at BootFldReexport_O.hs-boot:4:1-13), - or the field ‘fld’ of record ‘BootFldReexport_O.O’, - imported from ‘BootFldReexport_O’ at BootFldReexport.hs:6:5-7 - (and originally defined at BootFldReexport_O.hs:5:16-18). + at BootFldReexport_O.hs-boot:4:1-13). ===================================== testsuite/tests/overloadedrecflds/should_compile/T23279.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module T23279 where + +import T23279_aux + +bar = Bar { x = 3, y = 'x', z = False, w = 17.28 } +baz = Baz { z = 1.1 } + +v = w ===================================== testsuite/tests/overloadedrecflds/should_compile/T23279.stderr ===================================== @@ -0,0 +1,20 @@ + +T23279.hs:7:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of record field of Bar ‘x’ (imported from T23279_aux): + Deprecated: "Don't use x" + +T23279.hs:7:29: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of record field of Bar ‘z’ (imported from T23279_aux): + Deprecated: "Don't use z" + +T23279.hs:7:40: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of record field of Bar ‘w’ (imported from T23279_aux): + Deprecated: "Don't use w" + +T23279.hs:8:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of record field of Baz ‘z’ (imported from T23279_aux): + Deprecated: "Don't use z" + +T23279.hs:10:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of ‘w’ (imported from T23279_aux): + Deprecated: "Don't use w" ===================================== testsuite/tests/overloadedrecflds/should_compile/T23279_aux.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE DuplicateRecordFields, NoFieldSelectors #-} + +module T23279_aux where + +data Bar = Bar + { x :: Int + , y :: Char + , z :: Bool + , w :: Double + } + +data Baz = Baz { z :: Float } + +w :: () +w = () + +{-# DEPRECATED x "Don't use x" #-} +{-# DEPRECATED z "Don't use z" #-} +{-# DEPRECATED w "Don't use w" #-} ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -55,3 +55,4 @@ test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A' test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) +test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0']) ===================================== testsuite/tests/overloadedrecflds/should_fail/T16745.stderr ===================================== @@ -6,9 +6,9 @@ T16745A.hs:8:9: error: [GHC-87543] Ambiguous occurrence ‘field’. It could refer to - either ‘T16745B.field’, + either the field ‘field’ of record ‘T16745B.R’, imported from ‘T16745B’ at T16745A.hs:3:24-28 - (and originally defined in ‘T16745C’ at T16745C.hs:2:1-5), - or the field ‘field’ of record ‘T16745B.R’, + (and originally defined at T16745B.hs:11:14-18), + or ‘T16745B.field’, imported from ‘T16745B’ at T16745A.hs:3:24-28 - (and originally defined at T16745B.hs:11:14-18). + (and originally defined in ‘T16745C’ at T16745C.hs:2:1-5). ===================================== testsuite/tests/overloadedrecflds/should_fail/T18999_NoDisambiguateRecordFields.stderr ===================================== @@ -2,11 +2,11 @@ T18999_NoDisambiguateRecordFields.hs:6:13: error: [GHC-87543] Ambiguous occurrence ‘not’. It could refer to - either ‘Prelude.not’, + either the field ‘not’ of record ‘Foo’, + defined at T18999_NoDisambiguateRecordFields.hs:4:18, + or ‘Prelude.not’, imported from ‘Prelude’ at T18999_NoDisambiguateRecordFields.hs:2:8-40 - (and originally defined in ‘GHC.Classes’), - or the field ‘not’ of record ‘Foo’, - defined at T18999_NoDisambiguateRecordFields.hs:4:18. + (and originally defined in ‘GHC.Classes’). T18999_NoDisambiguateRecordFields.hs:8:11: error: [GHC-56428] Ambiguous record field ‘not’. ===================================== testsuite/tests/th/T7241.stderr ===================================== @@ -7,3 +7,12 @@ T7241.hs:7:2: error: [GHC-81573] If you bound a unique Template Haskell name (NameU) perhaps via newName, then -ddump-splices might be useful. + +T7241.hs:7:2: error: [GHC-81573] + Same Name in multiple name-spaces: + type constructor or class ‘Foo’, declared at: T7241.hs:7:2 + data constructor ‘Foo’, declared at: T7241.hs:7:2 + Suggested fix: + If you bound a unique Template Haskell name (NameU) + perhaps via newName, + then -ddump-splices might be useful. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2af23f0e84eec0eb30d77134abd99858a02d7a18...7f0a86edeeda674f27c80e81be592d325447a897 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2af23f0e84eec0eb30d77134abd99858a02d7a18...7f0a86edeeda674f27c80e81be592d325447a897 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:03:36 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:03:36 -0400 Subject: [Git][ghc/ghc][wip/ci-image-bump] Update bootstrap plans for 9.6.2 and 9.4.5 Message-ID: <64afe818df2d9_3f5efc33ad50d8602238@gitlab.mail> Matthew Pickering pushed to branch wip/ci-image-bump at Glasgow Haskell Compiler / GHC Commits: 564c9b8e by Matthew Pickering at 2023-07-13T13:02:37+01:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 4 changed files: - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/564c9b8e365e03263273f7d99de8c41e44f92356 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/564c9b8e365e03263273f7d99de8c41e44f92356 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:03:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 13 Jul 2023 08:03:42 -0400 Subject: [Git][ghc/ghc][master] configure: Drop DllWrap command Message-ID: <64afe81e37cfc_3f5efc65c9ff86024d5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 12 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - configure.ac - docs/users_guide/phases.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - testsuite/tests/safeHaskell/flags/Flags02.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_a, sPgm_l, sPgm_lm, - sPgm_dll, sPgm_T, sPgm_windres, sPgm_ar, @@ -136,7 +135,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -404,8 +403,6 @@ pgm_l :: DynFlags -> (String,[Option]) pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags -pgm_dll :: DynFlags -> (String,[Option]) -pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags pgm_T :: DynFlags -> String pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String @@ -1080,8 +1077,6 @@ dynamic_flags_deps = [ } , make_ord_flag defFlag "pgml-supports-no-pie" $ noArg $ alterToolSettings $ \s -> s { toolSettings_ccSupportsNoPie = True } - , make_ord_flag defFlag "pgmdll" - $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_dll = (f,[]) } , make_ord_flag defFlag "pgmwindres" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_windres = f } , make_ord_flag defFlag "pgmar" ===================================== compiler/GHC/Settings.hs ===================================== @@ -33,7 +33,6 @@ module GHC.Settings , sPgm_a , sPgm_l , sPgm_lm - , sPgm_dll , sPgm_T , sPgm_windres , sPgm_ar @@ -108,7 +107,6 @@ data ToolSettings = ToolSettings -- ^ N.B. On Windows we don't have a linker which supports object -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. - , toolSettings_pgm_dll :: (String, [Option]) , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String @@ -218,8 +216,6 @@ sPgm_l :: Settings -> (String, [Option]) sPgm_l = toolSettings_pgm_l . sToolSettings sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings -sPgm_dll :: Settings -> (String, [Option]) -sPgm_dll = toolSettings_pgm_dll . sToolSettings sPgm_T :: Settings -> String sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -127,9 +127,6 @@ initSettings top_dir = do touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" - let mkdll_args = [] - -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -189,7 +186,6 @@ initSettings top_dir = do , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r - , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path ===================================== configure.ac ===================================== @@ -328,14 +328,12 @@ else AC_PATH_TOOL([AR],[ar]) AC_PATH_TOOL([RANLIB],[ranlib]) AC_PATH_TOOL([OBJDUMP],[objdump]) - AC_PATH_TOOL([DllWrap],[dllwrap]) AC_PATH_TOOL([Windres],[windres]) AC_PATH_TOOL([Genlib],[genlib]) HAVE_GENLIB=False if test "$HostOS" = "mingw32"; then AC_CHECK_TARGET_TOOL([Windres],[windres]) - AC_CHECK_TARGET_TOOL([DllWrap],[dllwrap]) AC_CHECK_TARGET_TOOL([OBJDUMP],[objdump]) if test "$Genlib" != ""; then @@ -346,9 +344,7 @@ else fi if test "$HostOS" = "mingw32"; then - DllWrapCmd="$DllWrap" WindresCmd="$Windres" - AC_SUBST([DllWrapCmd]) AC_SUBST([WindresCmd]) AC_SUBST([GenlibCmd]) AC_SUBST([HAVE_GENLIB]) @@ -1238,7 +1234,6 @@ echo "\ otool : $OtoolCmd install_name_tool : $InstallNameToolCmd windres : $WindresCmd - dllwrap : $DllWrapCmd genlib : $GenlibCmd Happy : $HappyCmd ($HappyVersion) Alex : $AlexCmd ($AlexVersion) ===================================== docs/users_guide/phases.rst ===================================== @@ -88,13 +88,6 @@ given compilation phase: Use ⟨cmd⟩ as the linker when merging object files (e.g. when generating joined objects for loading into GHCi). -.. ghc-flag:: -pgmdll ⟨cmd⟩ - :shortdesc: Use ⟨cmd⟩ as the DLL generator - :type: dynamic - :category: phase-programs - - Use ⟨cmd⟩ as the DLL generator. - .. ghc-flag:: -pgmF ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only) :type: dynamic ===================================== hadrian/bindist/Makefile ===================================== @@ -103,7 +103,6 @@ lib/settings : config.mk @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ - @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("cross compiling", "$(CrossCompiling)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -271,7 +271,6 @@ SettingsArCommand = @SettingsArCommand@ SettingsOtoolCommand = @SettingsOtoolCommand@ SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ -SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ SettingsTouchCommand = @SettingsTouchCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -155,7 +155,6 @@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ -settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-touch-command = @SettingsTouchCommand@ settings-llc-command = @SettingsLlcCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -123,7 +123,6 @@ data SettingsFileSetting | SettingsFileSetting_RanlibCommand | SettingsFileSetting_OtoolCommand | SettingsFileSetting_InstallNameToolCommand - | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_TouchCommand | SettingsFileSetting_LlcCommand @@ -220,7 +219,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" SettingsFileSetting_OtoolCommand -> "settings-otool-command" SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" - SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -462,7 +462,6 @@ generateSettings = do , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) - , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("cross compiling", expr $ yesNo <$> flag CrossCompiling) ===================================== m4/fp_settings.m4 ===================================== @@ -23,7 +23,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsFlags="" SettingsArCommand="${mingw_bin_prefix}llvm-ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" - SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" SettingsTouchCommand='$$topdir/bin/touchy.exe' @@ -45,11 +44,6 @@ AC_DEFUN([FP_SETTINGS], SettingsMergeObjectsCommand="$MergeObjsCmd" SettingsMergeObjectsFlags="$MergeObjsArgs" - if test -z "$DllWrapCmd"; then - SettingsDllWrapCommand="/bin/false" - else - SettingsDllWrapCommand="$DllWrapCmd" - fi if test -z "$WindresCmd"; then SettingsWindresCommand="/bin/false" else @@ -70,7 +64,6 @@ AC_DEFUN([FP_SETTINGS], SettingsLdCommand="$(basename $SettingsLdCommand)" SettingsMergeObjectsCommand="$(basename $SettingsMergeObjectsCommand)" SettingsArCommand="$(basename $SettingsArCommand)" - SettingsDllWrapCommand="$(basename $SettingsDllWrapCommand)" SettingsWindresCommand="$(basename $SettingsWindresCommand)" fi fi @@ -115,7 +108,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsOtoolCommand) AC_SUBST(SettingsInstallNameToolCommand) - AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsLlcCommand) ===================================== testsuite/tests/safeHaskell/flags/Flags02.hs ===================================== @@ -1,5 +1,5 @@ {-# LANGUAGE Haskell2010 #-} -{-# OPTIONS_GHC -pgmdll pgmdll, -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} +{-# OPTIONS_GHC -I., -L., -Uggg, -Dggg, -with-rtsopts full #-} -- | These are all flags that should be allowed module Flags02 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e951395e7ac68e3b9f1e1f1aaf079c063233952 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e951395e7ac68e3b9f1e1f1aaf079c063233952 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:08:28 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:08:28 -0400 Subject: [Git][ghc/ghc][wip/test-primops] fix Message-ID: <64afe93c511de_3f5efca34d21c6116e2@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 2a3008c5 by Matthew Pickering at 2023-07-13T13:08:19+01:00 fix - - - - - [...] Content analysis details: (6.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4857] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Matthew Pickering (@mpickering)" Subject: [Git][ghc/ghc][wip/test-primops] fix Date: Thu, 13 Jul 2023 08:08:28 -0400 Size: 23263 URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:09:33 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:09:33 -0400 Subject: [Git][ghc/ghc][wip/test-primops] fix Message-ID: <64afe97de6f8f_3f5efc23950a24611853@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 17808588 by Matthew Pickering at 2023-07-13T13:09:28+01:00 fix - - - - - [...] Content analysis details: (6.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4697] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Matthew Pickering (@mpickering)" Subject: [Git][ghc/ghc][wip/test-primops] fix Date: Thu, 13 Jul 2023 08:09:33 -0400 Size: 18264 URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:10:47 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 13 Jul 2023 08:10:47 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 4 commits: gitlab-ci: Bump ci-images Message-ID: <64afe9c7d6aa_3f5efcb31b461248b@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 62bfea7a by Ben Gamari at 2023-07-13T08:10:26-04:00 gitlab-ci: Bump ci-images To freeze emsdk, avoiding #23641. - - - - - a01879a7 by Ben Gamari at 2023-07-13T08:10:26-04:00 testsuite: Accept metric changes Metric Increase: T6048 - - - - - c046a238 by Ben Gamari at 2023-07-13T08:10:26-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. - - - - - f356a7e8 by Ben Gamari at 2023-07-13T08:10:26-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - testsuite/tests/backpack/cabal/bkpcabal08/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: c29d97c469a23db1c77ac1184eebbb2fd86ef623 + DOCKER_REV: a9c0f5efbe503c17f63070583b2d815e498acc68 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -86,7 +86,7 @@ workflow: DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_2:$DOCKER_REV" - GHC_VERSION: 9.4.3 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" - - GHC_VERSION: 9.6.1 + - GHC_VERSION: 9.6.2 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_6:$DOCKER_REV" # Allow linters to fail on draft MRs. ===================================== .gitlab/gen_ci.hs ===================================== @@ -434,9 +434,7 @@ distroVariables Alpine = mconcat , "HADRIAN_ARGS" =: "--docs=no-sphinx" -- encoding004: due to lack of locale support -- T10458, ghcilink002: due to #17869 - -- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies - -- (see Note [Object unloading]). - , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" + , "BROKEN_TESTS" =: "encoding004 T10458" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" @@ -940,7 +938,10 @@ job_groups = where -- ghcilink002 broken due to #17869 - fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 ") + -- + -- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies + -- (see Note [Object unloading]). + fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 linker_unload_native") hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url") ===================================== .gitlab/jobs.yaml ===================================== @@ -598,7 +598,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -660,7 +660,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", - "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BROKEN_TESTS": "encoding004 T10458", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -722,7 +722,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2536,7 +2536,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2599,7 +2599,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2662,7 +2662,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", + "BROKEN_TESTS": "encoding004 T10458", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -3709,7 +3709,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", ===================================== testsuite/tests/backpack/cabal/bkpcabal08/all.T ===================================== @@ -6,6 +6,7 @@ else: test('bkpcabal08', [extra_files(['p', 'q', 'impl', 'bkpcabal08.cabal', 'Setup.hs', 'R.hs']), js_broken(22351), + fragile(23648), normalise_slashes, normalise_version('bkpcabal08')], run_command, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ee6b043095cd5573409b42c1fd85649d239bc3...f356a7e8ec8ec3d6b2b30fd175598b9b80065d87 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ee6b043095cd5573409b42c1fd85649d239bc3...f356a7e8ec8ec3d6b2b30fd175598b9b80065d87 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:11:56 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:11:56 -0400 Subject: [Git][ghc/ghc][wip/test-primops] ci branch Message-ID: <64afea0cb50a1_3f5efca34d21c614577@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 850ab4e8 by Matthew Pickering at 2023-07-13T13:11:48+01:00 ci branch - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -816,7 +816,7 @@ release-hackage-lint: trigger: project: "ghc/test-primops" # todo- upstream-testing branch - branch: "master" + branch: "wip/ci" strategy: "depend" test-primops-validate: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/850ab4e8e592d40e2e7ce1fa489bdc748b036ab8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/850ab4e8e592d40e2e7ce1fa489bdc748b036ab8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:15:39 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:15:39 -0400 Subject: [Git][ghc/ghc][wip/test-primops] 2 commits: fix Message-ID: <64afeaebaf872_3f5efc65c9ff861475f@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 645e2cee by Matthew Pickering at 2023-07-13T13:15:01+01:00 fix - - - - - f7bab815 by Matthew Pickering at 2023-07-13T13:15:29+01:00 fix - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -820,7 +820,15 @@ release-hackage-lint: strategy: "depend" test-primops-validate: - needs: [] + needs: + # - job: x86_64-linux-deb10-validate+debug_info + # artifacts: false + - job: aarch64-linux-deb10-validate + artifacts: false + # - job: aarch64-darwin-validate + # artifacts: false + # - job: x64_64-darwin-validate + # artifacts: false extends: .test-primops when: manual View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/850ab4e8e592d40e2e7ce1fa489bdc748b036ab8...f7bab8152b6fd3320fa99e8d63ec9c2864fc9f1d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/850ab4e8e592d40e2e7ce1fa489bdc748b036ab8...f7bab8152b6fd3320fa99e8d63ec9c2864fc9f1d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:18:34 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:18:34 -0400 Subject: [Git][ghc/ghc][wip/test-primops] try Message-ID: <64afeb9a12d5a_3f5efc33ad50d86151ee@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 6e3ee8ab by Matthew Pickering at 2023-07-13T13:18:27+01:00 try - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -820,11 +820,11 @@ release-hackage-lint: strategy: "depend" test-primops-validate: - needs: + needs: [] # - job: x86_64-linux-deb10-validate+debug_info # artifacts: false - - job: aarch64-linux-deb10-validate - artifacts: false + # - job: aarch64-linux-deb10-validate + # artifacts: false # - job: aarch64-darwin-validate # artifacts: false # - job: x64_64-darwin-validate View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e3ee8ab0f736705b16d21412764c516f323e08c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e3ee8ab0f736705b16d21412764c516f323e08c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:20:18 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 08:20:18 -0400 Subject: [Git][ghc/ghc][wip/test-primops] Revert "try" Message-ID: <64afec021b79f_3f5efc1cb10a786153ac@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 30371d6b by Matthew Pickering at 2023-07-13T13:20:09+01:00 Revert "try" This reverts commit 6e3ee8ab0f736705b16d21412764c516f323e08c. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -820,11 +820,11 @@ release-hackage-lint: strategy: "depend" test-primops-validate: - needs: [] + needs: # - job: x86_64-linux-deb10-validate+debug_info # artifacts: false - # - job: aarch64-linux-deb10-validate - # artifacts: false + - job: aarch64-linux-deb10-validate + artifacts: false # - job: aarch64-darwin-validate # artifacts: false # - job: x64_64-darwin-validate View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30371d6b34e8b2ab4519b9a5c87405f928dc8ac5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/30371d6b34e8b2ab4519b9a5c87405f928dc8ac5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 12:35:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 13 Jul 2023 08:35:01 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Fix deprecation of record fields Message-ID: <64afef75ca181_3f5efcb36786187da@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - f5d431d8 by Matthew Pickering at 2023-07-13T08:34:58-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 30 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/GREInfo.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - configure.ac - docs/users_guide/phases.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f62197912d391206d4c3d5ce6b5b3b732d1cb27...f5d431d8545b2f42594afcce42046ec7d4da4dc5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f62197912d391206d4c3d5ce6b5b3b732d1cb27...f5d431d8545b2f42594afcce42046ec7d4da4dc5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 14:26:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 13 Jul 2023 10:26:14 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 18 commits: Hadrian: enable GHCi support on riscv64 Message-ID: <64b00986e3faf_3f5efcf6618cc67063@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 005125fe by Rodrigo Mesquita at 2023-07-13T15:20:30+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - 67c2d21c by Ben Gamari at 2023-07-13T15:20:30+01:00 ghc-toolchain: Initial commit - - - - - b1706500 by Rodrigo Mesquita at 2023-07-13T15:25:56+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain leftovers Delete a part Use ghc-platform instead of ghc-boot - - - - - 727d9f9f by Rodrigo Mesquita at 2023-07-13T15:25:56+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 286468f8 by Rodrigo Mesquita at 2023-07-13T15:25:56+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + TODO - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Utils/Backpack.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/174c4ac600a07d066d31be6654a4475dab2d15aa...286468f83e135a57bf0d136da6f92615b2374c8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/174c4ac600a07d066d31be6654a4475dab2d15aa...286468f83e135a57bf0d136da6f92615b2374c8d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 15:02:03 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 13 Jul 2023 11:02:03 -0400 Subject: [Git][ghc/ghc][wip/T17521] 2 commits: Better test Message-ID: <64b011ebd193f_3f5efca34d21c681615@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 03a9fa96 by Jaro Reinders at 2023-07-13T16:59:05+02:00 Better test - - - - - 0891b558 by Jaro Reinders at 2023-07-13T17:01:56+02:00 Relax lint - - - - - 8 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Stg/Lint.hs - testsuite/tests/unlifted-datatypes/should_run/TopLevel.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevel.hs - + testsuite/tests/unlifted-datatypes/should_compile/TopLevel.stderr - testsuite/tests/unlifted-datatypes/should_run/TopLevela.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs - testsuite/tests/unlifted-datatypes/should_compile/all.T - − testsuite/tests/unlifted-datatypes/should_run/TopLevel.stdout - testsuite/tests/unlifted-datatypes/should_run/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -577,13 +577,15 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty ; checkL (not (isCoVar binder) || isCoArg rhs) (mkLetErr binder rhs) - -- Check the let-can-float invariant + -- Check the let-can-float and letrec invariants -- See Note [Core let-can-float invariant] in GHC.Core + -- See Note [Core letrec invariant] in GHC.Core ; checkL ( isJoinId binder || mightBeLiftedType binder_ty || (isNonRec rec_flag && exprOkForSpeculation rhs) || isDataConWorkId binder || isDataConWrapId binder -- until #17521 is fixed - || exprIsTickedString rhs) + || exprIsTickedString rhs + || isTopLevel top_lvl && isBoxedType rhs_ty && isJust (do (Var v, xs) <- pure (collectArgs rhs); pure (isDataConWorkId v && all exprIsTrivial xs))) (badBndrTyMsg binder (text "unlifted")) -- Check that if the binder is at the top level and has type Addr#, ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -209,7 +209,8 @@ lint_binds_help top_lvl (binder, rhs) -- Check binder doesn't have unlifted type or it's a join point checkL ( isJoinId binder || not (isUnliftedType (idType binder)) - || isDataConWorkId binder || isDataConWrapId binder) -- until #17521 is fixed + || isDataConWorkId binder || isDataConWrapId binder -- until #17521 is fixed + || isTopLevel top_lvl && isBoxedType (idType binder) && case rhs of StgRhsCon{} -> True; _ -> False) (mkUnliftedTyMsg opts binder rhs) -- | Top-level bindings can't inherit the cost centre stack from their ===================================== testsuite/tests/unlifted-datatypes/should_run/TopLevel.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevel.hs ===================================== ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevel.stderr ===================================== @@ -0,0 +1,18 @@ +[1 of 3] Compiling TopLevela ( TopLevela.hs, TopLevela.o ) + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 12, types: 6, coercions: 0, joins: 0/0} + +x3 = USucc UZero + +x2 = USucc x3 + +x1 = USucc x2 + +x = Box x1 + + + +[2 of 3] Compiling Main ( TopLevel.hs, TopLevel.o ) +[3 of 3] Linking TopLevel ===================================== testsuite/tests/unlifted-datatypes/should_run/TopLevela.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs ===================================== @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -ddump-simpl -ddump-simpl -dsuppress-all -dno-typeable-binds -dsuppress-uniques #-} {-# LANGUAGE UnliftedDatatypes #-} module TopLevela where ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -2,3 +2,4 @@ test('UnlDataMonoSigs', normal, compile, ['']) test('UnlDataPolySigs', normal, compile, ['']) test('UnlDataFams', normal, compile, ['']) test('UnlDataUsersGuide', normal, compile, ['']) +test('TopLevel', normal, multimod_compile, ['TopLevel', '-O']) ===================================== testsuite/tests/unlifted-datatypes/should_run/TopLevel.stdout deleted ===================================== @@ -1 +0,0 @@ -3 \ No newline at end of file ===================================== testsuite/tests/unlifted-datatypes/should_run/all.T ===================================== @@ -1,4 +1,3 @@ test('UnlData1', normal, compile_and_run, ['']) test('UnlGadt1', [exit_code(1), expect_broken_for(23060, ghci_ways)], compile_and_run, ['']) -test('T23549', normal, multimod_compile_and_run, ['T23549', '']) -test('TopLevel', normal, multimod_compile_and_run, ['TopLevel', '-O']) \ No newline at end of file +test('T23549', normal, multimod_compile_and_run, ['T23549', '']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e59dd7947ae0da96da5b60ff7d3042ae7cd54de...0891b558ad08124d8e1a53f14fd68805cb02e711 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e59dd7947ae0da96da5b60ff7d3042ae7cd54de...0891b558ad08124d8e1a53f14fd68805cb02e711 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 15:06:31 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 13 Jul 2023 11:06:31 -0400 Subject: [Git][ghc/ghc][wip/T22404] Wibble Message-ID: <64b012f795ada_3f5efcb36786822d5@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 8afd4872 by Simon Peyton Jones at 2023-07-13T16:06:18+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -998,7 +998,8 @@ occAnalNonRecBody env lvl bndr thing_inside occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Id -> CoreExpr -> WithUsageDetails [CoreBind] occAnalNonRecRhs !env imp_rule_edges tagged_bndr rhs - = WUD rhs_usage [NonRec final_bndr final_rhs] + = WUD (adj_rhs_uds `andUDs` adj_unf_uds `andUDs` adj_rule_uds) + [NonRec final_bndr final_rhs] where -- Get the join info from the *new* decision -- See Note [Join points and unfoldings/rules] @@ -1020,7 +1021,6 @@ occAnalNonRecRhs !env imp_rule_edges tagged_bndr rhs -- hence adjust the UDs from the RHS WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join_arity $ occAnalLamTail rhs_env rhs - rhs_usage = adj_rhs_uds `andUDs` adj_unf_uds `andUDs` adj_rule_uds final_bndr = tagged_bndr `setIdSpecialisation` mkRuleInfo rules' `setIdUnfolding` unf2 @@ -3369,10 +3369,13 @@ info then simply means setting the corresponding zapped set to the whole type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's -- free variables to their usage -data LocalOcc = OneOccL { lo_n_br :: {-# UNPACK #-} !Int - , lo_tail :: {-# UNPACK #-} !TailCallInfo - , lo_int_cxt :: !InterestingCxt } - | ManyOccL +data LocalOcc + = OneOccL { lo_n_br :: {-# UNPACK #-} !Int + , lo_tail :: {-# UNPACK #-} !TailCallInfo + -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3) + -- gives NoTailCallInfo + , lo_int_cxt :: !InterestingCxt } + | ManyOccL type ZappedSet = OccInfoEnv -- Values are ignored @@ -3546,22 +3549,23 @@ mkOccInfoByUnique (UD { ud_z_many = z_many uniq occ = case occ of OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt - , lo_tail = occ_tail } - | not (uniq `elemVarEnvByKey`z_many) + , lo_tail = tail_info } + | uniq `elemVarEnvByKey`z_many + -> ManyOccs { occ_tail = tail_info' } -- Hack alert + | otherwise -> OneOcc { occ_in_lam = in_lam , occ_n_br = n_br , occ_int_cxt = int_cxt - , occ_tail = tail } + , occ_tail = tail_info' } where - tail | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo - | otherwise = occ_tail + tail_info' | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo + | otherwise = tail_info in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam | otherwise = NotInsideLam - _other -- ManyOccL and zapped OneOccL - -> ManyOccs { occ_tail = NoTailCallInfo } - -- I think this is redundant; remove from ManyOccs + ManyOccL -> ManyOccs { occ_tail = NoTailCallInfo } + -- I think this is redundant; remove from ManyOccs ------------------- -- See Note [Adjusting right-hand sides] @@ -3655,7 +3659,7 @@ tagNonRecBinder :: TopLevelFlag -- At top level? tagNonRecBinder lvl usage binder = setBinderOcc occ' binder where - occ = lookupDetails usage binder + occ = lookupDetails usage binder will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless -- it was a join point before but is now dead @@ -3757,7 +3761,21 @@ decideJoinPointHood NotTopLevel usage bndrs = all_ok where bndr1 = NE.head bndrs - lost_join_point = not (isDeadOcc (lookupDetails usage bndr1)) && not all_ok + lost_join_point + | isDeadOcc (lookupDetails usage bndr1) = False + | all_ok = False + | otherwise + = pprTrace "djph" + (let arity = case (tailCallInfo (lookupDetails usage bndr1)) of + AlwaysTailCalled ar -> ar + NoTailCallInfo -> 0 + in vcat [ text "bndr1:" <+> ppr bndr1 + , text "occ:" <+> ppr (lookupDetails usage bndr1) + , text "arity:" <+> ppr arity + , text "rules:" <+> ppr (idCoreRules bndr1) + , text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr1)) + , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr1)) ]) $ + True -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. @@ -3848,6 +3866,15 @@ markNonTail occ = occ { occ_tail = NoTailCallInfo } andOccInfo, orOccInfo :: LocalOcc -> LocalOcc -> LocalOcc +andOccInfo (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = ar1 }) + (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = ar2 }) + | AlwaysTailCalled n1 <- ar1 + , AlwaysTailCalled n2 <- ar2 + , n1 == n2 + = -- Hack alert + OneOccL { lo_n_br = nbr1 + nbr2 + , lo_int_cxt = int_cxt1 `mappend` int_cxt2 + , lo_tail = AlwaysTailCalled n1 } andOccInfo _ _ = ManyOccL -- (orOccInfo orig new) is used View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8afd4872c001bf0e55018934461f0cf7f7501be4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8afd4872c001bf0e55018934461f0cf7f7501be4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 15:07:01 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 13 Jul 2023 11:07:01 -0400 Subject: [Git][ghc/ghc][wip/T22404] 64 commits: Substitute free variables captured by breakpoints in SpecConstr Message-ID: <64b01315a2d68_3f5efca34d21c6829e2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 9b8ca36b by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Work in progress on #22404 Very much not ready! - - - - - b81ffb33 by Sebastian Graf at 2023-07-13T16:06:47+01:00 Partition into OneOccs and ManyOccs - - - - - 9e06dca1 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Wibbles - - - - - 25059b44 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Refactor WithTailJoinDetails - - - - - 9aa9e9d8 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Wibbles - - - - - 1224c7d0 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Wibbles - - - - - 321ac1bb by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Major wibbles - - - - - e24f5e08 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Wibble - - - - - a7d21b10 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Vital fix to alt_env - - - - - 06d822f8 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Comments - - - - - 8156aec6 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Another crucial change Fixing a wrongly-zapped occ_join_points ..and a DEBUG check to catch it if it happens again - - - - - 744afe62 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Fast path for addInScope - - - - - 2dd70d5e by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Tiny fix - - - - - 28968d90 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Simplify the shadowing case - - - - - 7267b9e9 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 More efficient now - - - - - d2d31ed7 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Wibbles - - - - - f4075814 by Simon Peyton Jones at 2023-07-13T16:06:47+01:00 Wibble - - - - - 19 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Config/StgToCmm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8afd4872c001bf0e55018934461f0cf7f7501be4...f4075814dd598d9eb904dc2587d7ff365cc850f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8afd4872c001bf0e55018934461f0cf7f7501be4...f4075814dd598d9eb904dc2587d7ff365cc850f4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 15:38:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 13 Jul 2023 11:38:34 -0400 Subject: [Git][ghc/ghc][wip/T22011] rts: Add generator for RtsSymbols from libgcc Message-ID: <64b01a7ae6404_3f5efc3d08fc54690976@gitlab.mail> Ben Gamari pushed to branch wip/T22011 at Glasgow Haskell Compiler / GHC Commits: b7a3b3b2 by Ben Gamari at 2023-07-13T11:36:46-04:00 rts: Add generator for RtsSymbols from libgcc - - - - - 6 changed files: - hadrian/src/Flavour.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Register.hs - − rts/AArch64Symbols.h - rts/RtsSymbols.c - + rts/gen_libgcc_symbols.py Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -142,6 +142,8 @@ werror = [ arg "-optc-Werror" -- clang complains about #pragma GCC pragmas , arg "-optc-Wno-error=unknown-pragmas" + -- RtsSymbols.c ascribes the wrong type to some builtins + , arg "-optc-Wno-error=builtin-declaration-mismatch" -- rejected inlinings are highly dependent upon toolchain and way , arg "-optc-Wno-error=inline" ] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -59,21 +59,26 @@ rtsDependencies = do jsTarget <- expr isJsTarget useSystemFfi <- expr (flag UseSystemFfi) - let -- headers common to native and JS RTS + let in_include file = rtsPath -/- "include" -/- file + + -- headers common to native and JS RTS common_headers = + map in_include [ "ghcautoconf.h", "ghcplatform.h" , "DerivedConstants.h" ] -- headers specific to the native RTS native_headers = + map in_include [ "rts" -/- "EventTypes.h" , "rts" -/- "EventLogConstants.h" ] - ++ (if useSystemFfi then [] else libffiHeaderFiles) + ++ (if useSystemFfi then [] else map in_include libffiHeaderFiles) + ++ [ in_include $ rtsPath -/- "LibgccSymbols.h" ] headers | jsTarget = common_headers | otherwise = common_headers ++ native_headers - pure $ ((rtsPath -/- "include") -/-) <$> headers + pure headers genapplyDependencies :: Expr [FilePath] genapplyDependencies = do @@ -166,7 +171,7 @@ generatePackageCode context@(Context stage pkg _ _) = do [accessOpsSource, "addr-access-ops", file] [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] + need [primopsSource, ba_ops_txt, addr_ops_txt] -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] @@ -180,13 +185,49 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "include/DerivedConstants.h" %> genPlatformConstantsHeader context root -/- "**" -/- dir -/- "include/rts/EventLogConstants.h" %> genEventTypes "--event-types-defines" root -/- "**" -/- dir -/- "include/rts/EventTypes.h" %> genEventTypes "--event-types-array" + root -/- "**" -/- dir -/- "LibgccSymbols.h" %> genLibgccSymbols context + +genLibgccSymbols :: Context -> FilePath -> Action () +genLibgccSymbols (Context stage _ _ _) outFile = do + libgcc <- getLibgccPath + need [script] + runBuilder Python [script, libgcc, "-o", outFile] [] [] + where + script = "rts" -/- "gen_libgcc_symbols.py" + + getLibgccPath :: Action FilePath + getLibgccPath = do + let builder = Cc CompileC stage + needBuilders [builder] + path <- builderPath builder + StdoutTrim libgcc <- quietly $ cmd [path] ["-print-libgcc-file-name"] + + -- Annoyingly, Apple's toolchain returns the non-existent + -- libclang_rt.builtins-aarch64.a when asked to -print-libgcc-file-name. + -- However, the file is actually called libclang_rt.osx.a. Moreover, + -- on some more recent XCodes the directory is also wrong. + -- + -- e.g. on Darwin -print-libgcc-file-name tells us: + -- /Library/Developer/CommandLineTools/usr/lib/clang/12.0.5/lib/darwin20.5.0/libclang_rt.builtins-aarch64.a + -- yet the path is in fact + -- + -- /Library/Developer/CommandLineTools/usr/lib/clang/12.0.5/lib/darwin/libclang_rt.osx.a + -- We workaround this with this horrible hack. + os <- setting TargetOs + pure $ + case os of + "darwin" -> let libDir = takeDirectory $ takeDirectory libgcc + in libDir "darwin" "libclang_rt.osx.a" + "ios" -> let libDir = takeDirectory $ takeDirectory libgcc + in libDir "darwin" "libclang_rt.osx.a" + _ -> libgcc genEventTypes :: String -> FilePath -> Action () genEventTypes flag file = do - need ["rts" -/- "gen_event_types.py"] - runBuilder Python - ["rts" -/- "gen_event_types.py", flag, file] - [] [] + need [script] + runBuilder Python [script, flag, file] [] [] + where + script = "rts" -/- "gen_event_types.py" genPrimopCode :: Context -> FilePath -> Action () genPrimopCode context@(Context stage _pkg _ _) file = do ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -212,6 +212,7 @@ buildConfInplace rs context at Context {..} _conf = do , path -/- "include/ghcplatform.h" , path -/- "include/rts/EventLogConstants.h" , path -/- "include/rts/EventTypes.h" + , path -/- "LibgccSymbols.h" ] -- we need to generate this file for GMP ===================================== rts/AArch64Symbols.h deleted ===================================== @@ -1,100 +0,0 @@ - SymE_NeedsProto(__aarch64_cas8_acq), - SymE_NeedsProto(__aarch64_cas8_acq), - SymE_NeedsProto(__aarch64_cas8_acq), - SymE_NeedsProto(__aarch64_cas8_acq), - SymE_NeedsProto(__aarch64_cas8_acq), - SymE_NeedsProto(__aarch64_cas8_acq_rel), - SymE_NeedsProto(__aarch64_cas8_acq_rel), - SymE_NeedsProto(__aarch64_cas8_acq_rel), - SymE_NeedsProto(__aarch64_cas8_acq_rel), - SymE_NeedsProto(__aarch64_cas8_acq_rel), - SymE_NeedsProto(__aarch64_cas8_rel), - SymE_NeedsProto(__aarch64_cas8_rel), - SymE_NeedsProto(__aarch64_cas8_rel), - SymE_NeedsProto(__aarch64_cas8_rel), - SymE_NeedsProto(__aarch64_cas8_rel), - SymE_NeedsProto(__aarch64_cas8_relax), - SymE_NeedsProto(__aarch64_cas8_relax), - SymE_NeedsProto(__aarch64_cas8_relax), - SymE_NeedsProto(__aarch64_cas8_relax), - SymE_NeedsProto(__aarch64_cas8_relax), - SymE_NeedsProto(__aarch64_ldadd1_acq), - SymE_NeedsProto(__aarch64_ldadd1_acq_rel), - SymE_NeedsProto(__aarch64_ldadd1_rel), - SymE_NeedsProto(__aarch64_ldadd1_relax), - SymE_NeedsProto(__aarch64_ldadd2_acq), - SymE_NeedsProto(__aarch64_ldadd2_acq_rel), - SymE_NeedsProto(__aarch64_ldadd2_rel), - SymE_NeedsProto(__aarch64_ldadd2_relax), - SymE_NeedsProto(__aarch64_ldadd4_acq), - SymE_NeedsProto(__aarch64_ldadd4_acq_rel), - SymE_NeedsProto(__aarch64_ldadd4_rel), - SymE_NeedsProto(__aarch64_ldadd4_relax), - SymE_NeedsProto(__aarch64_ldadd8_acq), - SymE_NeedsProto(__aarch64_ldadd8_acq_rel), - SymE_NeedsProto(__aarch64_ldadd8_rel), - SymE_NeedsProto(__aarch64_ldadd8_relax), - SymE_NeedsProto(__aarch64_ldclr1_acq), - SymE_NeedsProto(__aarch64_ldclr1_acq_rel), - SymE_NeedsProto(__aarch64_ldclr1_rel), - SymE_NeedsProto(__aarch64_ldclr1_relax), - SymE_NeedsProto(__aarch64_ldclr2_acq), - SymE_NeedsProto(__aarch64_ldclr2_acq_rel), - SymE_NeedsProto(__aarch64_ldclr2_rel), - SymE_NeedsProto(__aarch64_ldclr2_relax), - SymE_NeedsProto(__aarch64_ldclr4_acq), - SymE_NeedsProto(__aarch64_ldclr4_acq_rel), - SymE_NeedsProto(__aarch64_ldclr4_rel), - SymE_NeedsProto(__aarch64_ldclr4_relax), - SymE_NeedsProto(__aarch64_ldclr8_acq), - SymE_NeedsProto(__aarch64_ldclr8_acq_rel), - SymE_NeedsProto(__aarch64_ldclr8_rel), - SymE_NeedsProto(__aarch64_ldclr8_relax), - SymE_NeedsProto(__aarch64_ldeor1_acq), - SymE_NeedsProto(__aarch64_ldeor1_acq_rel), - SymE_NeedsProto(__aarch64_ldeor1_rel), - SymE_NeedsProto(__aarch64_ldeor1_relax), - SymE_NeedsProto(__aarch64_ldeor2_acq), - SymE_NeedsProto(__aarch64_ldeor2_acq_rel), - SymE_NeedsProto(__aarch64_ldeor2_rel), - SymE_NeedsProto(__aarch64_ldeor2_relax), - SymE_NeedsProto(__aarch64_ldeor4_acq), - SymE_NeedsProto(__aarch64_ldeor4_acq_rel), - SymE_NeedsProto(__aarch64_ldeor4_rel), - SymE_NeedsProto(__aarch64_ldeor4_relax), - SymE_NeedsProto(__aarch64_ldeor8_acq), - SymE_NeedsProto(__aarch64_ldeor8_acq_rel), - SymE_NeedsProto(__aarch64_ldeor8_rel), - SymE_NeedsProto(__aarch64_ldeor8_relax), - SymE_NeedsProto(__aarch64_ldset1_acq), - SymE_NeedsProto(__aarch64_ldset1_acq_rel), - SymE_NeedsProto(__aarch64_ldset1_rel), - SymE_NeedsProto(__aarch64_ldset1_relax), - SymE_NeedsProto(__aarch64_ldset2_acq), - SymE_NeedsProto(__aarch64_ldset2_acq_rel), - SymE_NeedsProto(__aarch64_ldset2_rel), - SymE_NeedsProto(__aarch64_ldset2_relax), - SymE_NeedsProto(__aarch64_ldset4_acq), - SymE_NeedsProto(__aarch64_ldset4_acq_rel), - SymE_NeedsProto(__aarch64_ldset4_rel), - SymE_NeedsProto(__aarch64_ldset4_relax), - SymE_NeedsProto(__aarch64_ldset8_acq), - SymE_NeedsProto(__aarch64_ldset8_acq_rel), - SymE_NeedsProto(__aarch64_ldset8_rel), - SymE_NeedsProto(__aarch64_ldset8_relax), - SymE_NeedsProto(__aarch64_swp1_acq), - SymE_NeedsProto(__aarch64_swp1_acq_rel), - SymE_NeedsProto(__aarch64_swp1_rel), - SymE_NeedsProto(__aarch64_swp1_relax), - SymE_NeedsProto(__aarch64_swp2_acq), - SymE_NeedsProto(__aarch64_swp2_acq_rel), - SymE_NeedsProto(__aarch64_swp2_rel), - SymE_NeedsProto(__aarch64_swp2_relax), - SymE_NeedsProto(__aarch64_swp4_acq), - SymE_NeedsProto(__aarch64_swp4_acq_rel), - SymE_NeedsProto(__aarch64_swp4_rel), - SymE_NeedsProto(__aarch64_swp4_relax), - SymE_NeedsProto(__aarch64_swp8_acq), - SymE_NeedsProto(__aarch64_swp8_acq_rel), - SymE_NeedsProto(__aarch64_swp8_rel), - SymE_NeedsProto(__aarch64_swp8_relax), ===================================== rts/RtsSymbols.c ===================================== @@ -947,26 +947,6 @@ extern char **environ; RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS -// 64-bit support functions in libgcc.a -#if defined(__GNUC__) && SIZEOF_VOID_P <= 4 && !defined(_ABIN32) -#define RTS_LIBGCC_SYMBOLS \ - SymI_NeedsProto(__divdi3) \ - SymI_NeedsProto(__udivdi3) \ - SymI_NeedsProto(__moddi3) \ - SymI_NeedsProto(__umoddi3) \ - SymI_NeedsProto(__muldi3) \ - SymI_NeedsProto(__ashldi3) \ - SymI_NeedsProto(__ashrdi3) \ - SymI_NeedsProto(__lshrdi3) \ - SymI_NeedsProto(__fixunsdfdi) -#elif defined(__GNUC__) && SIZEOF_VOID_P == 8 -#define RTS_LIBGCC_SYMBOLS \ - SymI_NeedsProto(__udivti3) \ - SymI_NeedsProto(__umodti3) -#else -#define RTS_LIBGCC_SYMBOLS -#endif - // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -983,6 +963,10 @@ extern char **environ; #define RTS_FINI_ARRAY_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt. This file is generated by +// gen_libgcc_symbols.py. +#include "LibgccSymbols.h" + /* entirely bogus claims about types of these symbols */ #define SymI_NeedsProto(vvv) extern void vvv(void); #define SymI_NeedsDataProto(vvv) extern StgWord vvv[]; @@ -1055,9 +1039,6 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS -#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) -#include "AArch64Symbols.h" -#endif SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, ===================================== rts/gen_libgcc_symbols.py ===================================== @@ -0,0 +1,38 @@ +#!/usr/bin/env python3 + +""" +Uses the POSIX nm tool to export the list of symbols exposed by a library +to a format which can be included in RtsSymbols.c. +""" + +import sys +import subprocess +import argparse +from typing import Set +from pathlib import Path + +def list_symbols(lib: Path) -> Set[str]: + out = subprocess.check_output([ + 'nm', '--format=posix', '--extern-only', '--defined-only', lib + ], encoding='ASCII') + syms = set() + for l in out.split('\n'): + parts = l.split(' ') + if len(parts) == 4: + syms.add(parts[0]) + + return syms + +def main() -> None: + parser = argparse.ArgumentParser() + parser.add_argument('libgcc', type=Path, help='path to libgcc') + parser.add_argument('-o', '--output', default=sys.stdout, type=argparse.FileType('w'), help='output file name') + args = parser.parse_args() + + syms = list_symbols(args.libgcc) + lines = [ '#define RTS_LIBGCC_SYMBOLS' ] + lines += [ f' SymE_NeedsProto({sym})' for sym in sorted(syms) ] + print(' \\\n'.join(lines), file=args.output) + +if __name__ == '__main__': + main() View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7a3b3b2fcdc7eefe80df6994c347310f29e18ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b7a3b3b2fcdc7eefe80df6994c347310f29e18ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 15:40:38 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 13 Jul 2023 11:40:38 -0400 Subject: [Git][ghc/ghc][wip/T22404] 2 commits: Wibbles Message-ID: <64b01af6e0011_3f5efcb31a06949e4@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 59662e48 by Simon Peyton Jones at 2023-07-13T16:37:05+01:00 Wibbles - - - - - 8c50df16 by Simon Peyton Jones at 2023-07-13T16:40:12+01:00 Comments only - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) -import GHC.Data.Maybe( isJust, orElse ) +import GHC.Data.Maybe( isJust, isNothing, orElse ) import GHC.Data.Graph.Directed ( SCC(..), Node(..) , stronglyConnCompFromEdgedVerticesUniq , stronglyConnCompFromEdgedVerticesUniqR ) @@ -954,7 +954,8 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine = let !(WUD body_uds res) = addInScope env [bndr] thing_inside in WUD body_uds (combine [NonRec bndr rhs] res) - -- Non-recursive join points + -- /Existing/ non-recursive join points + -- Analyse the RHS and /then/ the body | NotTopLevel <- lvl , mb_join@(Just {}) <- isJoinId_maybe bndr , not (isStableUnfolding (realIdUnfolding bndr)) @@ -971,17 +972,18 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body - else WUD (rhs_uds `orUDs` body_uds) + else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` (combine [NonRec tagged_bndr rhs'] body) - -- The normal case + -- The normal case, including newly-discovered join points + -- Analyse the body and /then/ the RHS | otherwise = let WUD body_uds (tagged_bndr, body) = occAnalNonRecBody env lvl bndr thing_inside WUD bind_uds binds = occAnalNonRecRhs env ire tagged_bndr rhs in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body - else WUD (bind_uds `andUDs` body_uds) + else WUD (bind_uds `andUDs` body_uds) -- Note `andUDs` (combine binds body) ----------------- @@ -3500,24 +3502,26 @@ markAllInsideLamIf False ud = ud markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud +lookupLocalDetails :: UsageDetails -> Id -> Maybe LocalOcc +lookupLocalDetails uds id = lookupVarEnv (ud_env uds) id + +lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo +lookupTailCallInfo uds id + | not (id `elemVarEnv` ud_z_tail uds) + , Just (OneOccL { lo_tail = tail_info }) <- lookupLocalDetails uds id + = tail_info + | otherwise + = NoTailCallInfo + lookupDetails :: UsageDetails -> Id -> OccInfo lookupDetails ud id - = case lookupVarEnv (ud_env ud) id of + = case lookupLocalDetails ud id of Just occ -> mkOccInfo ud id occ Nothing -> IAmDead usedIn :: Id -> UsageDetails -> Bool v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud -{- Commenting out - = (emptyDetails{ud_env = interesting_env}, emptyDetails{ud_env = boring_env}) - where - UD{ud_env=env} = flattenUsageDetails uds - (interesting_env,boring_env) = partitionVarEnv interesting env - interesting OneOcc{} = True - interesting _ = False --} - udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds udFreeVars bndrs ud = restrictFreeVars bndrs (ud_env ud) @@ -3696,8 +3700,7 @@ tagRecBinders lvl body_uds details_s -- Can't use willBeJoinId_maybe here because we haven't tagged -- the binder yet (the tag depends on these adjustments!) | will_be_joins - , let occ = lookupDetails unadj_uds bndr - , AlwaysTailCalled arity <- tailCallInfo occ + , AlwaysTailCalled arity <- lookupTailCallInfo unadj_uds bndr = Just arity | otherwise = assert (not will_be_joins) -- Should be AlwaysTailCalled if @@ -3762,11 +3765,11 @@ decideJoinPointHood NotTopLevel usage bndrs where bndr1 = NE.head bndrs lost_join_point - | isDeadOcc (lookupDetails usage bndr1) = False - | all_ok = False + | isNothing (lookupLocalDetails usage bndr1) = False -- Dead + | all_ok = False | otherwise = pprTrace "djph" - (let arity = case (tailCallInfo (lookupDetails usage bndr1)) of + (let arity = case lookupTailCallInfo usage bndr1 of AlwaysTailCalled ar -> ar NoTailCallInfo -> 0 in vcat [ text "bndr1:" <+> ppr bndr1 @@ -3784,7 +3787,7 @@ decideJoinPointHood NotTopLevel usage bndrs ok bndr | -- Invariant 1: Only tail calls, all same join arity - AlwaysTailCalled arity <- tailCallInfo (lookupDetails usage bndr) + AlwaysTailCalled arity <- lookupTailCallInfo usage bndr , -- Invariant 1 as applied to LHSes of rules all (ok_rule arity) (idCoreRules bndr) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4075814dd598d9eb904dc2587d7ff365cc850f4...8c50df1664c28550853d0b3daaf5cf2d97b19683 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4075814dd598d9eb904dc2587d7ff365cc850f4...8c50df1664c28550853d0b3daaf5cf2d97b19683 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 16:29:07 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 13 Jul 2023 12:29:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-windows-bindist Message-ID: <64b02653ed93_3f5efcf6618cc715020@gitlab.mail> Matthew Pickering pushed new branch wip/hadrian-windows-bindist at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-windows-bindist You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 20:26:15 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Thu, 13 Jul 2023 16:26:15 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 27 commits: EPA: Simplify GHC/Parser.y sL1 Message-ID: <64b05de7a72b4_3f5efc446cd1007530a@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 20c7cd0a by Alan Zimmerman at 2023-07-12T23:21:53+01:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - d7895226 by Alan Zimmerman at 2023-07-13T18:27:14+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 847e8df8 by Alan Zimmerman at 2023-07-13T20:22:18+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 11493540 by Alan Zimmerman at 2023-07-13T20:22:22+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 92eb39a7 by Alan Zimmerman at 2023-07-13T20:22:22+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - 720b0c8d by Alan Zimmerman at 2023-07-13T20:22:22+01:00 EPA: Fix span for GRHS - - - - - 136f41c6 by Alan Zimmerman at 2023-07-13T20:22:22+01:00 EPA: Fix span for Located Context - - - - - 274727de by Alan Zimmerman at 2023-07-13T20:22:22+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - b2ae4197 by Alan Zimmerman at 2023-07-13T20:22:22+01:00 EPA: widen more TrailingAnn usages - - - - - 4b0bcc58 by Alan Zimmerman at 2023-07-13T20:22:22+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 1f567e7d by Alan Zimmerman at 2023-07-13T20:22:22+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 18fd2ed9 by Alan Zimmerman at 2023-07-13T20:22:22+01:00 WIP - - - - - f307a26c by Alan Zimmerman at 2023-07-13T20:22:22+01:00 Fixup after rebase - - - - - 7e6b469a by Alan Zimmerman at 2023-07-13T20:22:22+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 7b5a6fa8 by Alan Zimmerman at 2023-07-13T20:22:22+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - e2f15fbb by Alan Zimmerman at 2023-07-13T20:27:11+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - 3fb5c0a8 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 39956b25 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 8b73fee9 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: More extending anchors to full span in Parser.y - - - - - 5f4412a5 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 03792010 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: Fix simple tests - - - - - c514c8c4 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 4561c4ff by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 1116f7f5 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: deal with fallout from getMonoBind - - - - - 0ae25c21 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA fix captureLineSpacing - - - - - 8b31bbd4 by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA print any comments in the span before exiting it - - - - - 5e64ea9a by Alan Zimmerman at 2023-07-13T20:27:14+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 23 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3163f815e39de9119553de75c2e7bd09c0177f35...5e64ea9abbd847d5eedaa90a982b42fac0a9b711 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3163f815e39de9119553de75c2e7bd09c0177f35...5e64ea9abbd847d5eedaa90a982b42fac0a9b711 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 20:34:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 13 Jul 2023 16:34:38 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 4 commits: Update generate_bootstrap_plans Message-ID: <64b05fde84c9a_3f5efc3ce26ee07538f3@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: c86a4055 by Ben Gamari at 2023-07-13T16:19:02-04:00 Update generate_bootstrap_plans - - - - - d58049ef by Ben Gamari at 2023-07-13T16:28:54-04:00 hadrian/bootstrap: Drop GHC 9.2 plans - - - - - a79d1806 by Ben Gamari at 2023-07-13T16:29:39-04:00 hadrian/bootstrap: Add 9.6.2 plans - - - - - 4f142ee9 by Ben Gamari at 2023-07-13T16:34:08-04:00 hadrian/bootstrap: Regenerate existing plans - - - - - 8 changed files: - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f356a7e8ec8ec3d6b2b30fd175598b9b80065d87...4f142ee9ab0cca0274c33df6c49972cb40744a6c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f356a7e8ec8ec3d6b2b30fd175598b9b80065d87...4f142ee9ab0cca0274c33df6c49972cb40744a6c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 21:27:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 13 Jul 2023 17:27:48 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] gitlab-ci: Drop test-bootstrap:9.2 jobs Message-ID: <64b06c546272e_3f5efc1cb10a787689a7@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 031d7f7c by Ben Gamari at 2023-07-13T17:27:30-04:00 gitlab-ci: Drop test-bootstrap:9.2 jobs - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -82,8 +82,6 @@ workflow: # which versions of GHC to allow bootstrap with .bootstrap_matrix : &bootstrap_matrix matrix: - - GHC_VERSION: 9.2.5 - DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_2:$DOCKER_REV" - GHC_VERSION: 9.4.3 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" - GHC_VERSION: 9.6.2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/031d7f7ca035cfe87a72da5c757ba85e52c50a40 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/031d7f7ca035cfe87a72da5c757ba85e52c50a40 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 22:35:12 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 13 Jul 2023 18:35:12 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 299 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <64b07c20b8ece_3f5efc3ce26ee077611f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - ecbe5814 by Rodrigo Mesquita at 2023-07-13T16:19:36+01:00 Add e-graphs submodule (hegg) - - - - - f8ed48de by Rodrigo Mesquita at 2023-07-13T16:19:36+01:00 Create Core.Equality module This module defines CoreExprF -- the base functor of CoreExpr, and equality and ordering operations on the debruijnized CoreExprF. Furthermore, it provides a function to represent a CoreExpr in an e-graph. This is a requirement to represent, reason about equality, and manipulate CoreExprs in e-graphs. E-graphs are going to be used in the pattern match checker (#19272), and potentially for type family rewriting (#TODO) -- amongst other oportunities that are unlocked by having them available. - - - - - a913d549 by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 Question - - - - - 72ff14e5 by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 Was going great until I started needing to thread ClassIds together with Ids. Ret-think this. - - - - - b33d3656 by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 A solution with more lookups - - - - - 839d2055 by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 Fixes to Pmc.Ppr module - - - - - 42bf4856 by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 Wow, a lot (stage1) is working actually, without PMC errprs - - - - - 6c0fea9a by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 We're still not there yet. - - - - - ea0cccc0 by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 WiP - - - - - 3b0c8095 by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 Add instances for debugging - - - - - e0ae925f by Rodrigo Mesquita at 2023-07-13T16:19:37+01:00 Things that were broken due to unlawfulness of e-graph instances - - - - - 3984339f by Rodrigo Mesquita at 2023-07-13T16:20:29+01:00 Scuffed merging without effects to salvage some information that might get lost in merging that happens outside of addVarCt - - - - - e698b151 by Rodrigo Mesquita at 2023-07-13T23:06:19+01:00 This is the commit where it does works: * Drops SDFM module - - - - - 3a4b33f0 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Improve a little bit the mixing of Ids and ClassIds tWeaks Don't use EG.rebuild as a view pattern Debuggging Touches Fix to representId over multiple (different) nablas Paper over Chagnes2 Then....Start going the other direction - - - - - 962e3438 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Revert "Improve a little bit the mixing of Ids and ClassIds" This reverts commit 84acba988c354c8e273895e815af41ccdf3e004e. - - - - - 5f7a8855 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Improvement to repId attempt submodule hegg update for no reason - - - - - 95a9d810 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Add TODO things - - - - - 8d8b20b4 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 break - - - - - dfd85e47 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Revert "break" This reverts commit a6fb3011fd4db37f0b0dbc7b99467ffd24b9ce25. - - - - - 9abe119c by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Revert "Improvement to repId attempt" This reverts commit 25f926d1484281df91837fbd4254f823912351a1. - - - - - 4b424b73 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Checkpoint clean Updates hegg submodule - - - - - 2303b376 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Yes - - - - - 0fa57edf by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Revert "Yes" This reverts commit cff3e43e9869bbf732376daac2c0ba6367d5d97a. - - - - - 851704d4 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Revert "Revert "Yes"" This reverts commit c4a0133695b325384e5f0920b37744bab4fdd27c. - - - - - 7edaa516 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Fixes - - - - - 3d6c0031 by Rodrigo Mesquita at 2023-07-13T23:06:39+01:00 Rework - - - - - 6c544197 by Rodrigo Mesquita at 2023-07-13T23:35:00+01:00 Not working alternative - - - - - 27 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitmodules - CODEOWNERS - HACKING.md - + TODO - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7539a46aa34f431fe019507a19b345e96fceeb7f...6c5441974bfc6b6f23e74e1983423204e7abc1a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7539a46aa34f431fe019507a19b345e96fceeb7f...6c5441974bfc6b6f23e74e1983423204e7abc1a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 23:14:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 13 Jul 2023 19:14:08 -0400 Subject: [Git][ghc/ghc][wip/T22404] Wibbles Message-ID: <64b08540e2e92_3f5efc41622474778754@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: f29e8062 by Simon Peyton Jones at 2023-07-14T00:13:55+01:00 Wibbles - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -945,7 +945,7 @@ occAnalBind occAnalBind env lvl ire (Rec pairs) thing_inside combine = addInScope env (map fst pairs) $ \env -> - let WUD body_uds body' = thing_inside env + let WUD body_uds body' = thing_inside env WUD bind_uds binds' = occAnalRecBind env lvl ire pairs body_uds in WUD bind_uds (combine binds' body') @@ -958,17 +958,15 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- Analyse the RHS and /then/ the body | NotTopLevel <- lvl , mb_join@(Just {}) <- isJoinId_maybe bndr - , not (isStableUnfolding (realIdUnfolding bndr)) - , not (idHasRules bndr) = let -- Analyse the rhs first, generating rhs_uds - WUD rhs_uds rhs' = adjustNonRecRhs mb_join $ - occAnalLamTail (setTailCtxt env) rhs + (rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs + rhs_uds = foldr1 orUDs rhs_uds_s -- Note orUDs -- Now analyse the body, adding the join point -- into the environment with addJoinPoint WUD body_uds (tagged_bndr, body) - = occAnalNonRecBody env lvl bndr $ \env -> - thing_inside (addJoinPoint env bndr rhs_uds) + = occAnalNonRecBody env NotTopLevel bndr' $ \env -> + thing_inside (addJoinPoint env bndr' rhs_uds) in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body @@ -978,13 +976,18 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- The normal case, including newly-discovered join points -- Analyse the body and /then/ the RHS | otherwise - = let WUD body_uds (tagged_bndr, body) = occAnalNonRecBody env lvl bndr thing_inside - WUD bind_uds binds = occAnalNonRecRhs env ire tagged_bndr rhs - in - if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] + = let + WUD body_uds (tagged_bndr, body) = occAnalNonRecBody env lvl bndr thing_inside + in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body - else WUD (bind_uds `andUDs` body_uds) -- Note `andUDs` - (combine binds body) + else let + -- Get the join info from the *new* decision + -- See Note [Join points and unfoldings/rules] + -- => join arity O of Note [Join arity prediction based on joinRhsArity] + mb_join = willBeJoinId_maybe tagged_bndr + (rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs + in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs` + (combine [NonRec final_bndr rhs'] body) ----------------- occAnalNonRecBody :: OccEnv -> TopLevelFlag -> Id @@ -997,17 +1000,14 @@ occAnalNonRecBody env lvl bndr thing_inside in WUD inner_uds (tagged_bndr, res) ----------------- -occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Id -> CoreExpr - -> WithUsageDetails [CoreBind] -occAnalNonRecRhs !env imp_rule_edges tagged_bndr rhs - = WUD (adj_rhs_uds `andUDs` adj_unf_uds `andUDs` adj_rule_uds) - [NonRec final_bndr final_rhs] +occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity + -> Id -> CoreExpr + -> ([UsageDetails], Id, CoreExpr) +occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs + = (adj_rhs_uds : adj_unf_uds : adj_rule_uds, + final_bndr, final_rhs ) where - -- Get the join info from the *new* decision - -- See Note [Join points and unfoldings/rules] - -- => join arity O of Note [Join arity prediction based on joinRhsArity] - mb_join_arity = willBeJoinId_maybe tagged_bndr - is_join_point = isJust mb_join_arity + is_join_point = isJust mb_join --------- Right hand side --------- env1 | is_join_point = setTailCtxt env @@ -1021,24 +1021,26 @@ occAnalNonRecRhs !env imp_rule_edges tagged_bndr rhs -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS - WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join_arity $ + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ occAnalLamTail rhs_env rhs - final_bndr = tagged_bndr `setIdSpecialisation` mkRuleInfo rules' - `setIdUnfolding` unf2 + final_bndr = bndr `setIdSpecialisation` mkRuleInfo rules' + `setIdUnfolding` unf2 --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] - unf = idUnfolding tagged_bndr + unf = idUnfolding bndr WTUD unf_tuds unf1 = occAnalUnfolding rhs_env unf - unf2 = markNonRecUnfoldingOneShots mb_join_arity unf1 - adj_unf_uds = adjustTailArity mb_join_arity unf_tuds + unf2 = markNonRecUnfoldingOneShots mb_join unf1 + adj_unf_uds = adjustTailArity mb_join unf_tuds --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] -- and Note [Join points and unfoldings/rules] - rules_w_uds = occAnalRules rhs_env tagged_bndr + rules_w_uds = occAnalRules rhs_env bndr rules' = map fstOf3 rules_w_uds - imp_rule_uds = impRulesScopeUsage (lookupImpRules imp_rule_edges tagged_bndr) + imp_rule_infos = lookupImpRules imp_rule_edges bndr + imp_rule_uds | null imp_rule_infos = [] -- Very common case + | otherwise = [impRulesScopeUsage imp_rule_infos] -- imp_rule_uds: consider -- h = ... -- g = ... @@ -1048,19 +1050,19 @@ occAnalNonRecRhs !env imp_rule_edges tagged_bndr rhs -- we make g mention h. adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds - add_rule_uds (_, l, r) uds - = l `andUDs` adjustTailArity mb_join_arity r `andUDs` uds + add_rule_uds (_, l, r) uds_s + = (l `andUDs` adjustTailArity mb_join r) : uds_s ---------- - occ = idOccInfo tagged_bndr certainly_inline -- See Note [Cascading inlines] - = case occ of + = -- certainly_inline is only used for non-join points,so idOccInfo is valid + case idOccInfo bndr of OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 } -> active && not_stable _ -> False - dmd = idDemandInfo tagged_bndr - active = isAlwaysActive (idInlineActivation tagged_bndr) + dmd = idDemandInfo bndr + active = isAlwaysActive (idInlineActivation bndr) not_stable = not (isStableUnfolding unf) ----------------- @@ -1128,7 +1130,7 @@ occAnalRec env lvl (CyclicSCC details_s) (WUD body_uds binds) -- See Note [Choosing loop breakers] for loop_breaker_nodes final_uds :: UsageDetails loop_breaker_nodes :: [LoopBreakerNode] - (WUD final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s + WUD final_uds loop_breaker_nodes = mkLoopBreakerNodes env lvl body_uds details_s ------------------------------ weak_fvs :: VarSet @@ -2946,7 +2948,7 @@ mkZeroedForm (UD { ud_env = rhs_occs }) = emptyDetails { ud_env = mapMaybeUFM do_one rhs_occs } where do_one :: LocalOcc -> Maybe LocalOcc - do_one ManyOccL = Nothing + do_one (ManyOccL {}) = Nothing do_one occ@(OneOccL {}) = Just (occ { lo_n_br = 0 }) -------------------- @@ -3377,7 +3379,16 @@ data LocalOcc -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3) -- gives NoTailCallInfo , lo_int_cxt :: !InterestingCxt } - | ManyOccL + | ManyOccL !TailCallInfo + +instance Outputable LocalOcc where + ppr (OneOccL { lo_n_br = n, lo_tail = tci }) + = text "OneOccL" <> braces (ppr n <> comma <> ppr tci) + ppr (ManyOccL tci) = text "ManyOccL" <> braces (ppr tci) + +localTailCallInfo :: LocalOcc -> TailCallInfo +localTailCallInfo (OneOccL { lo_tail = tci }) = tci +localTailCallInfo (ManyOccL tci) = tci type ZappedSet = OccInfoEnv -- Values are ignored @@ -3393,6 +3404,7 @@ instance Outputable UsageDetails where ppr ud = text "UD" <+> (braces $ fsep $ punctuate comma $ [ ppr uq <+> text ":->" <+> ppr (mkOccInfoByUnique ud uq local_occ) | (uq, local_occ) <- nonDetStrictFoldVarEnv_Directly do_one [] (ud_env ud) ]) + $$ nest 2 (text "ud_z_tail" <+> ppr (ud_z_tail ud)) where do_one :: Unique -> LocalOcc -> [(Unique,LocalOcc)] -> [(Unique,LocalOcc)] do_one uniq occ occs = (uniq, occ) : occs @@ -3442,7 +3454,8 @@ mkOneOcc !env id int_cxt arity addManyOccId :: UsageDetails -> Id -> UsageDetails -- Add the non-committal (id :-> noOccInfo) to the usage details -addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id ManyOccL } +addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id + (ManyOccL NoTailCallInfo) } -- Add several occurrences, assumed not to be tail calls addManyOcc :: Var -> UsageDetails -> UsageDetails @@ -3508,8 +3521,8 @@ lookupLocalDetails uds id = lookupVarEnv (ud_env uds) id lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo lookupTailCallInfo uds id | not (id `elemVarEnv` ud_z_tail uds) - , Just (OneOccL { lo_tail = tail_info }) <- lookupLocalDetails uds id - = tail_info + , Just occ <- lookupLocalDetails uds id + = localTailCallInfo occ | otherwise = NoTailCallInfo @@ -3555,21 +3568,23 @@ mkOccInfoByUnique (UD { ud_z_many = z_many OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt , lo_tail = tail_info } | uniq `elemVarEnvByKey`z_many - -> ManyOccs { occ_tail = tail_info' } -- Hack alert + -> ManyOccs { occ_tail = mk_tail_info tail_info } | otherwise -> OneOcc { occ_in_lam = in_lam , occ_n_br = n_br , occ_int_cxt = int_cxt - , occ_tail = tail_info' } + , occ_tail = mk_tail_info tail_info } where - tail_info' | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo - | otherwise = tail_info - in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam | otherwise = NotInsideLam - ManyOccL -> ManyOccs { occ_tail = NoTailCallInfo } - -- I think this is redundant; remove from ManyOccs + ManyOccL tail_info -> ManyOccs { occ_tail = mk_tail_info tail_info } + where + mk_tail_info ti + | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo + | otherwise = ti + + ------------------- -- See Note [Adjusting right-hand sides] @@ -3755,7 +3770,8 @@ decideJoinPointHood TopLevel _ _ decideJoinPointHood NotTopLevel usage bndrs | isJoinId bndr1 = warnPprTrace lost_join_point - "OccurAnal failed to rediscover join point(s)" (ppr bndrs) + "OccurAnal failed to rediscover join point(s)" + lost_join_doc all_ok -- = assertPpr (not lost_join_point) (ppr bndrs) -- True @@ -3764,21 +3780,6 @@ decideJoinPointHood NotTopLevel usage bndrs = all_ok where bndr1 = NE.head bndrs - lost_join_point - | isNothing (lookupLocalDetails usage bndr1) = False -- Dead - | all_ok = False - | otherwise - = pprTrace "djph" - (let arity = case lookupTailCallInfo usage bndr1 of - AlwaysTailCalled ar -> ar - NoTailCallInfo -> 0 - in vcat [ text "bndr1:" <+> ppr bndr1 - , text "occ:" <+> ppr (lookupDetails usage bndr1) - , text "arity:" <+> ppr arity - , text "rules:" <+> ppr (idCoreRules bndr1) - , text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr1)) - , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr1)) ]) $ - True -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. @@ -3817,6 +3818,24 @@ decideJoinPointHood NotTopLevel usage bndrs ok_unfolding _ _ = True + lost_join_point :: Bool + lost_join_point + | isNothing (lookupLocalDetails usage bndr1) = False -- Dead + | all_ok = False + | otherwise = True + + lost_join_doc + = vcat [ text "bndrs:" <+> ppr bndrs + , text "occ:" <+> ppr (lookupDetails usage bndr1) + , text "arity:" <+> ppr arity + , text "rules:" <+> ppr (idCoreRules bndr1) + , text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr1)) + , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr1)) ] + where + arity = case lookupTailCallInfo usage bndr1 of + AlwaysTailCalled ar -> ar + NoTailCallInfo -> 0 + willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity willBeJoinId_maybe bndr | isId bndr @@ -3867,28 +3886,21 @@ markNonTail :: OccInfo -> OccInfo markNonTail IAmDead = IAmDead markNonTail occ = occ { occ_tail = NoTailCallInfo } -andOccInfo, orOccInfo :: LocalOcc -> LocalOcc -> LocalOcc - -andOccInfo (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = ar1 }) - (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = ar2 }) - | AlwaysTailCalled n1 <- ar1 - , AlwaysTailCalled n2 <- ar2 - , n1 == n2 - = -- Hack alert - OneOccL { lo_n_br = nbr1 + nbr2 - , lo_int_cxt = int_cxt1 `mappend` int_cxt2 - , lo_tail = AlwaysTailCalled n1 } -andOccInfo _ _ = ManyOccL +andOccInfo :: LocalOcc -> LocalOcc -> LocalOcc +andOccInfo occ1 occ2 = ManyOccL (tci1 `andTailCallInfo` tci2) + where + !tci1 = localTailCallInfo occ1 + !tci2 = localTailCallInfo occ2 --- (orOccInfo orig new) is used +orOccInfo :: LocalOcc -> LocalOcc -> LocalOcc +-- (orOccInfo occ1 occ2) is used -- when combining occurrence info from branches of a case - -orOccInfo (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = ar1 }) - (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = ar2 }) +orOccInfo (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = tci1 }) + (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = tci2 }) = OneOccL { lo_n_br = nbr1 + nbr2 , lo_int_cxt = int_cxt1 `mappend` int_cxt2 - , lo_tail = ar1 `andTailCallInfo` ar2 } -orOccInfo _ _ = ManyOccL + , lo_tail = tci1 `andTailCallInfo` tci2 } +orOccInfo occ1 occ2 = andOccInfo occ1 occ2 andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f29e8062316124752f47a22e500c1ffa35e9610f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f29e8062316124752f47a22e500c1ffa35e9610f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 23:45:47 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 13 Jul 2023 19:45:47 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Retrying from the working stage. Message-ID: <64b08cab8d78d_3f5efcb31a078128d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: ebacbf5c by Rodrigo Mesquita at 2023-07-14T00:45:30+01:00 Retrying from the working stage. - - - - - 7 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -338,7 +338,7 @@ instance Ord a => Ord (DeBruijn (CoreAltF a)) where cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where - go (Breakpoint lext lid lids) (Breakpoint rext rid rids) + go (Breakpoint lext lid lids _) (Breakpoint rext rid rids _) = case compare lid rid of LT -> LT EQ -> case compare (D env1 lids) (D env2 rids) of ===================================== compiler/GHC/HsToCore/Errors/Ppr.hs ===================================== @@ -22,6 +22,8 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt import GHC.HsToCore.Pmc.Ppr +import GHC.HsToCore.Pmc.Solver.Types (lookupMatchIdMap) +import Data.Maybe (fromJust) instance Diagnostic DsMessage where @@ -71,7 +73,8 @@ instance Diagnostic DsMessage where pprContext False kind (text "are non-exhaustive") $ \_ -> case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" - _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas + -- See Note (TODO) [The MatchIds for error reporting] (and possibly factor this map lookupMatchIdMap outside) + _ -> let us = map (\nabla -> pprUncovered nabla (map (fromJust . (`lookupMatchIdMap` nabla)) vars)) nablas -- pp_tys = pprQuotedList $ map idType vars pp_tys = empty in hang ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -101,7 +101,7 @@ data DsMessage | DsNonExhaustivePatterns !(HsMatchContext GhcRn) !ExhaustivityCheckType !MaxUncoveredPatterns - [ClassId] + [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] [Nabla] | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -75,7 +75,7 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Coerce -import Data.Equality.Graph (ClassId) +import Data.Maybe (fromJust) -- -- * Exported entry points to the checker @@ -104,22 +104,15 @@ pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do !missing <- getLdiNablas + + -- See Note (TODO) [Represent the MatchIds before the CheckAction] + let missing' = representIdNablas var missing + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) - result0 <- unCA (checkPatBind pat_bind) missing - tracePm "}: " (ppr (cr_uncov result0)) - -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph - -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas - -- DESIGN:TODO: However, if we represent the variables while desugaring, we - -- would no longer need representId to represent VarF in the e-class, and can - -- instead do newEClass. This would further reduce allocations. - -- The reason why we can't do that currently is that on checkPatBind we'll - -- representIds, and when we represent them again in the next line, we want - -- them to match the ones we represented during checkPatBind. If we made - -- empty-eclasses, the representId on the next line wouldn't match the match - -- ids we defined in checkPatBind. - let (varid, cr_uncov') = representId var (cr_uncov result0) - formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} + result <- unCA (checkPatBind pat_bind) missing' + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings ReportPatBind ctxt [var] result pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -173,28 +166,27 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 (vcat (map ppr matches) $$ ppr missing) + + -- See Note (TODO) [Represent the MatchIds before the CheckAction] + let missing' = representIdsNablas vars missing + case NE.nonEmpty matches of Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars empty_case <- noCheckDs $ desugarEmptyCase var - result0 <- unCA (checkEmptyCase empty_case) missing - tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph - formatReportWarnings ReportEmptyCase ctxt varids result0{cr_uncov=cr_uncov'} + result <- unCA (checkEmptyCase empty_case) missing' + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings ReportEmptyCase ctxt vars result return [] Just matches -> do matches <- {-# SCC "desugarMatches" #-} noCheckDs $ desugarMatches vars matches - result0 <- {-# SCC "checkMatchGroup" #-} - unCA (checkMatchGroup matches) missing - tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) - -- romes:todo: this seems redundant, hints that the right thing might be - -- for desugar to return already the match variables already "represented" - -- in the e-graph - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} - return (NE.toList (ldiMatchGroup (cr_ret result0))) + result <- {-# SCC "checkMatchGroup" #-} + unCA (checkMatchGroup matches) missing' + tracePm "}: " (ppr (cr_uncov result)) + {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result + return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -358,7 +350,11 @@ collectInMode ReportEmptyCase = cirbsEmptyCase -- | Given a 'FormatReportWarningsMode', this function will emit warnings -- for a 'CheckResult'. -formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult ann -> DsM () +formatReportWarnings :: FormatReportWarningsMode ann + -> DsMatchContext + -> [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] + -> CheckResult ann + -> DsM () formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do cov_info <- collectInMode report_mode ann dflags <- getDynFlags @@ -366,7 +362,7 @@ formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do -- | Issue all the warnings -- (redundancy, inaccessibility, exhaustiveness, redundant bangs). -reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult CIRB -> DsM () +reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () reportWarnings dflags report_mode (DsMatchContext kind loc) vars CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss , cirb_red = redundant_rhss @@ -405,13 +401,16 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars maxPatterns = maxUncoveredPatterns dflags -getNFirstUncovered :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered :: GenerateInhabitingPatternsMode + -> [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] + -> Int -> Nablas -> DsM [Nabla] getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- generateInhabitingPatterns mode vars n nabla + -- See Note (TODO) [The MatchIds for error reporting] (and possibly factor this map lookupMatchIdMap to an independent function since its used twice, here and in the call of pprUncovered) + front <- generateInhabitingPatterns mode (map (fromJust . (`lookupMatchIdMap` nabla)) vars) n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -448,8 +447,9 @@ addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k addCoreScrutTmCs (scr:scrs) (x0:xs) k = flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> - let (x, nablas) = representId x0 nablas0 - in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) + liftNablasM (\d -> + let (x, d') = representId x0 d + in addPhiCts d' (unitBag (PhiCoreCt x scr))) nablas0 addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. @@ -500,4 +500,18 @@ unreachable. We make sure to always start from an inhabited 'Nablas' by calling 'getLdiNablas', which falls back to the trivially inhabited 'Nablas' if the long-distance info returned by 'GHC.HsToCore.Monad.getPmNablas' is empty. + +Note [The MatchId for error reporting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Something sometihng, when we're talking about MatchIds that might occur in +Nablas (rather than just in a Nabla), we have to refer to them by Id, rather +than by e-class-id. + +This is because e-class-ids will vary between Nabla, but each Nabla maps Ids to e-class-ids. +So an Id is the only identifier that identifies the same match-id across Nablas. + +We can safely query each Nabla for the MatchIds because we make sure to +represent the MatchIds in the Nablas as soon as possible (in pmcMatches and +friends) + -} ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -1,4 +1,5 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -103,22 +104,18 @@ emptyRedSets :: RedSets emptyRedSets = RedSets mempty mempty mempty checkGrd :: PmGrd -> CheckAction RedSets -checkGrd grd = CA $ \inc0 -> case grd of +checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e - PmLet x0 e -> do - let (x, inc) = representId x0 inc0 - -- romes: we could potentially do update the trees to use e-class ids here, - -- or in pmcMatches - matched <- addPhiCtNablas inc (PhiCoreCt x e) + PmLet x e -> do + matched <- addPhiCtNablasWithRep inc x (`PhiCoreCt` e) tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ - PmBang x0 mb_info -> do - let (x, inc) = representId x0 inc0 - div <- addPhiCtNablas inc (PhiBotCt x) - matched <- addPhiCtNablas inc (PhiNotBotCt x) + PmBang x mb_info -> do + div <- addPhiCtNablasWithRep inc x PhiBotCt + matched <- addPhiCtNablasWithRep inc x PhiNotBotCt -- it will do a redundant lookup to represent x again... we would like @inc@ to have the rep already for both -- See Note [Dead bang patterns] -- mb_info = Just info <==> PmBang originates from bang pattern in source let bangs | Just info <- mb_info = unitOL (div, info) @@ -135,14 +132,13 @@ checkGrd grd = CA $ \inc0 -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x0 con tvs dicts args0 -> do - let (x, inc1) = representId x0 inc0 - (args, inc) = representIds args0 inc1 + PmCon x con tvs dicts args -> do + -- romes: for now we do the redundant representation of vars, but whatever !div <- if isPmAltConMatchStrict con - then addPhiCtNablas inc (PhiBotCt x) + then addPhiCtNablasWithRep inc x PhiBotCt else pure mempty - !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) - !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + !matched <- addPhiCtNablasWithReps inc (x:args) (\case (xi:argsi) -> PhiConCt xi con tvs (map evVarPred dicts) argsi; _ -> error "impossible") + !uncov <- addPhiCtNablasWithRep inc x (`PhiNotConCt` con) tracePm "check:Con" $ vcat [ ppr grd , ppr inc @@ -185,8 +181,7 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - let (varid, inc') = representId var inc - unc <- addPhiCtNablas inc' (PhiNotBotCt varid) + unc <- addPhiCtNablasWithRep inc var PhiNotBotCt pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -29,6 +29,9 @@ module GHC.HsToCore.Pmc.Solver ( PhiCt(..), PhiCts, addPhiCtNablas, addPhiCtsNablas, + addPhiCtNablasWithRep, addPhiCtNablasWithReps, + liftNablasM, + addPhiCts, isInhabited, generateInhabitingPatterns, GenerateInhabitingPatternsMode(..) @@ -121,6 +124,16 @@ addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) +-- | 'addPmCtsNablas' for a single 'PmCt', but first represent the Id in each Nabla. +addPhiCtNablasWithRep :: Nablas -> Id -> (ClassId -> PhiCt) -> DsM Nablas +addPhiCtNablasWithRep nablas x ctf + = liftNablasM (\d -> let (xi, d') = representId x d in addPhiCts d' (unitBag (ctf xi))) nablas + +-- | Represent all Id in each Nabla. +addPhiCtNablasWithReps :: Nablas -> [Id] -> ([ClassId] -> PhiCt) -> DsM Nablas +addPhiCtNablasWithReps nablas xs ctf + = liftNablasM (\d -> let (xsi, d') = representIds xs d in addPhiCts d' (unitBag (ctf xsi))) nablas + liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE RankNTypes #-} @@ -21,7 +22,10 @@ module GHC.HsToCore.Pmc.Solver.Types ( lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, representIds, representIdNablas, representIdsNablas, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, + + representId, representIds, representIdNablas, representIdsNablas, + lookupMatchIdMap, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -88,7 +92,7 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second, bimap, first) +import Data.Bifunctor (second) import Control.Monad.Trans.State (runState, state, execState) -- import GHC.Driver.Ppr @@ -166,6 +170,9 @@ data TmState -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } +lookupMatchIdMap :: Id -> Nabla -> Maybe ClassId +lookupMatchIdMap id (MkNabla _ TmSt{ts_reps}) = lookupVarEnv ts_reps id + -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set @@ -243,6 +250,9 @@ instance Outputable BotInfo where ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" +instance Outputable IntSet where + ppr = text . show + -- | Not user-facing. instance Outputable TmState where ppr (TmSt eg idmp dirty) = text (show eg) $$ ppr idmp $$ ppr dirty @@ -843,6 +853,7 @@ representIdNablas x (MkNablas nbs) = MkNablas $ mapBag (snd . representId x) nbs representIdsNablas :: [Id] -> Nablas -> Nablas representIdsNablas xs = execState (mapM (\x -> state (((),) . representIdNablas x)) xs) +-- Are these even used? don't we always use the ones above? -- | Like 'representId' but for a single Nabla representId :: Id -> Nabla -> (ClassId, Nabla) representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebacbf5c1bfb47ba4dcf222626cb1b2c41867edc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebacbf5c1bfb47ba4dcf222626cb1b2c41867edc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 13 23:51:38 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 13 Jul 2023 19:51:38 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Build stage one with a weird innacessible pattern error in cabal Message-ID: <64b08e09e253e_3f5efc446cd1007836de@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 6e33eec3 by Rodrigo Mesquita at 2023-07-14T00:50:35+01:00 Build stage one with a weird innacessible pattern error in cabal - - - - - 8 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Hint.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -338,7 +338,7 @@ instance Ord a => Ord (DeBruijn (CoreAltF a)) where cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where - go (Breakpoint lext lid lids) (Breakpoint rext rid rids) + go (Breakpoint lext lid lids _) (Breakpoint rext rid rids _) = case compare lid rid of LT -> LT EQ -> case compare (D env1 lids) (D env2 rids) of ===================================== compiler/GHC/HsToCore/Errors/Ppr.hs ===================================== @@ -22,6 +22,8 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt import GHC.HsToCore.Pmc.Ppr +import GHC.HsToCore.Pmc.Solver.Types (lookupMatchIdMap) +import Data.Maybe (fromJust) instance Diagnostic DsMessage where @@ -71,7 +73,8 @@ instance Diagnostic DsMessage where pprContext False kind (text "are non-exhaustive") $ \_ -> case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" - _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas + -- See Note (TODO) [The MatchIds for error reporting] (and possibly factor this map lookupMatchIdMap outside) + _ -> let us = map (\nabla -> pprUncovered nabla (map (fromJust . (`lookupMatchIdMap` nabla)) vars)) nablas -- pp_tys = pprQuotedList $ map idType vars pp_tys = empty in hang ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -20,8 +20,6 @@ import GHC.Types.Id import GHC.Types.Name (Name) import qualified GHC.LanguageExtensions as LangExt -import Data.Equality.Graph (ClassId) - import GHC.Generics (Generic) newtype MinBound = MinBound Integer @@ -101,7 +99,7 @@ data DsMessage | DsNonExhaustivePatterns !(HsMatchContext GhcRn) !ExhaustivityCheckType !MaxUncoveredPatterns - [ClassId] + [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] [Nabla] | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -75,7 +75,7 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Coerce -import Data.Equality.Graph (ClassId) +import Data.Maybe (fromJust) -- -- * Exported entry points to the checker @@ -104,22 +104,15 @@ pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do !missing <- getLdiNablas + + -- See Note (TODO) [Represent the MatchIds before the CheckAction] + let missing' = representIdNablas var missing + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) - result0 <- unCA (checkPatBind pat_bind) missing - tracePm "}: " (ppr (cr_uncov result0)) - -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph - -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas - -- DESIGN:TODO: However, if we represent the variables while desugaring, we - -- would no longer need representId to represent VarF in the e-class, and can - -- instead do newEClass. This would further reduce allocations. - -- The reason why we can't do that currently is that on checkPatBind we'll - -- representIds, and when we represent them again in the next line, we want - -- them to match the ones we represented during checkPatBind. If we made - -- empty-eclasses, the representId on the next line wouldn't match the match - -- ids we defined in checkPatBind. - let (varid, cr_uncov') = representId var (cr_uncov result0) - formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} + result <- unCA (checkPatBind pat_bind) missing' + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings ReportPatBind ctxt [var] result pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -173,28 +166,27 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 (vcat (map ppr matches) $$ ppr missing) + + -- See Note (TODO) [Represent the MatchIds before the CheckAction] + let missing' = representIdsNablas vars missing + case NE.nonEmpty matches of Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars empty_case <- noCheckDs $ desugarEmptyCase var - result0 <- unCA (checkEmptyCase empty_case) missing - tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph - formatReportWarnings ReportEmptyCase ctxt varids result0{cr_uncov=cr_uncov'} + result <- unCA (checkEmptyCase empty_case) missing' + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings ReportEmptyCase ctxt vars result return [] Just matches -> do matches <- {-# SCC "desugarMatches" #-} noCheckDs $ desugarMatches vars matches - result0 <- {-# SCC "checkMatchGroup" #-} - unCA (checkMatchGroup matches) missing - tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) - -- romes:todo: this seems redundant, hints that the right thing might be - -- for desugar to return already the match variables already "represented" - -- in the e-graph - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} - return (NE.toList (ldiMatchGroup (cr_ret result0))) + result <- {-# SCC "checkMatchGroup" #-} + unCA (checkMatchGroup matches) missing' + tracePm "}: " (ppr (cr_uncov result)) + {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result + return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -358,7 +350,11 @@ collectInMode ReportEmptyCase = cirbsEmptyCase -- | Given a 'FormatReportWarningsMode', this function will emit warnings -- for a 'CheckResult'. -formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult ann -> DsM () +formatReportWarnings :: FormatReportWarningsMode ann + -> DsMatchContext + -> [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] + -> CheckResult ann + -> DsM () formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do cov_info <- collectInMode report_mode ann dflags <- getDynFlags @@ -366,7 +362,7 @@ formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do -- | Issue all the warnings -- (redundancy, inaccessibility, exhaustiveness, redundant bangs). -reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult CIRB -> DsM () +reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () reportWarnings dflags report_mode (DsMatchContext kind loc) vars CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss , cirb_red = redundant_rhss @@ -405,13 +401,16 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars maxPatterns = maxUncoveredPatterns dflags -getNFirstUncovered :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered :: GenerateInhabitingPatternsMode + -> [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] + -> Int -> Nablas -> DsM [Nabla] getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- generateInhabitingPatterns mode vars n nabla + -- See Note (TODO) [The MatchIds for error reporting] (and possibly factor this map lookupMatchIdMap to an independent function since its used twice, here and in the call of pprUncovered) + front <- generateInhabitingPatterns mode (map (fromJust . (`lookupMatchIdMap` nabla)) vars) n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -448,8 +447,9 @@ addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k addCoreScrutTmCs (scr:scrs) (x0:xs) k = flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> - let (x, nablas) = representId x0 nablas0 - in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) + liftNablasM (\d -> + let (x, d') = representId x0 d + in addPhiCts d' (unitBag (PhiCoreCt x scr))) nablas0 addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. @@ -500,4 +500,18 @@ unreachable. We make sure to always start from an inhabited 'Nablas' by calling 'getLdiNablas', which falls back to the trivially inhabited 'Nablas' if the long-distance info returned by 'GHC.HsToCore.Monad.getPmNablas' is empty. + +Note [The MatchId for error reporting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Something sometihng, when we're talking about MatchIds that might occur in +Nablas (rather than just in a Nabla), we have to refer to them by Id, rather +than by e-class-id. + +This is because e-class-ids will vary between Nabla, but each Nabla maps Ids to e-class-ids. +So an Id is the only identifier that identifies the same match-id across Nablas. + +We can safely query each Nabla for the MatchIds because we make sure to +represent the MatchIds in the Nablas as soon as possible (in pmcMatches and +friends) + -} ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -1,4 +1,5 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -103,22 +104,18 @@ emptyRedSets :: RedSets emptyRedSets = RedSets mempty mempty mempty checkGrd :: PmGrd -> CheckAction RedSets -checkGrd grd = CA $ \inc0 -> case grd of +checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e - PmLet x0 e -> do - let (x, inc) = representId x0 inc0 - -- romes: we could potentially do update the trees to use e-class ids here, - -- or in pmcMatches - matched <- addPhiCtNablas inc (PhiCoreCt x e) + PmLet x e -> do + matched <- addPhiCtNablasWithRep inc x (`PhiCoreCt` e) tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ - PmBang x0 mb_info -> do - let (x, inc) = representId x0 inc0 - div <- addPhiCtNablas inc (PhiBotCt x) - matched <- addPhiCtNablas inc (PhiNotBotCt x) + PmBang x mb_info -> do + div <- addPhiCtNablasWithRep inc x PhiBotCt + matched <- addPhiCtNablasWithRep inc x PhiNotBotCt -- it will do a redundant lookup to represent x again... we would like @inc@ to have the rep already for both -- See Note [Dead bang patterns] -- mb_info = Just info <==> PmBang originates from bang pattern in source let bangs | Just info <- mb_info = unitOL (div, info) @@ -135,14 +132,13 @@ checkGrd grd = CA $ \inc0 -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x0 con tvs dicts args0 -> do - let (x, inc1) = representId x0 inc0 - (args, inc) = representIds args0 inc1 + PmCon x con tvs dicts args -> do + -- romes: for now we do the redundant representation of vars, but whatever !div <- if isPmAltConMatchStrict con - then addPhiCtNablas inc (PhiBotCt x) + then addPhiCtNablasWithRep inc x PhiBotCt else pure mempty - !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) - !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + !matched <- addPhiCtNablasWithReps inc (x:args) (\case (xi:argsi) -> PhiConCt xi con tvs (map evVarPred dicts) argsi; _ -> error "impossible") + !uncov <- addPhiCtNablasWithRep inc x (`PhiNotConCt` con) tracePm "check:Con" $ vcat [ ppr grd , ppr inc @@ -185,8 +181,7 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - let (varid, inc') = representId var inc - unc <- addPhiCtNablas inc' (PhiNotBotCt varid) + unc <- addPhiCtNablasWithRep inc var PhiNotBotCt pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -29,6 +29,9 @@ module GHC.HsToCore.Pmc.Solver ( PhiCt(..), PhiCts, addPhiCtNablas, addPhiCtsNablas, + addPhiCtNablasWithRep, addPhiCtNablasWithReps, + liftNablasM, + addPhiCts, isInhabited, generateInhabitingPatterns, GenerateInhabitingPatternsMode(..) @@ -121,6 +124,16 @@ addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) +-- | 'addPmCtsNablas' for a single 'PmCt', but first represent the Id in each Nabla. +addPhiCtNablasWithRep :: Nablas -> Id -> (ClassId -> PhiCt) -> DsM Nablas +addPhiCtNablasWithRep nablas x ctf + = liftNablasM (\d -> let (xi, d') = representId x d in addPhiCts d' (unitBag (ctf xi))) nablas + +-- | Represent all Id in each Nabla. +addPhiCtNablasWithReps :: Nablas -> [Id] -> ([ClassId] -> PhiCt) -> DsM Nablas +addPhiCtNablasWithReps nablas xs ctf + = liftNablasM (\d -> let (xsi, d') = representIds xs d in addPhiCts d' (unitBag (ctf xsi))) nablas + liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE RankNTypes #-} @@ -21,7 +22,10 @@ module GHC.HsToCore.Pmc.Solver.Types ( lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, representIds, representIdNablas, representIdsNablas, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, + + representId, representIds, representIdNablas, representIdsNablas, + lookupMatchIdMap, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -88,7 +92,7 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second, bimap, first) +import Data.Bifunctor (second) import Control.Monad.Trans.State (runState, state, execState) -- import GHC.Driver.Ppr @@ -166,6 +170,9 @@ data TmState -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } +lookupMatchIdMap :: Id -> Nabla -> Maybe ClassId +lookupMatchIdMap id (MkNabla _ TmSt{ts_reps}) = lookupVarEnv ts_reps id + -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set @@ -243,6 +250,9 @@ instance Outputable BotInfo where ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" +instance Outputable IntSet where + ppr = text . show + -- | Not user-facing. instance Outputable TmState where ppr (TmSt eg idmp dirty) = text (show eg) $$ ppr idmp $$ ppr dirty @@ -843,6 +853,7 @@ representIdNablas x (MkNablas nbs) = MkNablas $ mapBag (snd . representId x) nbs representIdsNablas :: [Id] -> Nablas -> Nablas representIdsNablas xs = execState (mapM (\x -> state (((),) . representIdNablas x)) xs) +-- Are these even used? don't we always use the ones above? -- | Like 'representId' but for a single Nabla representId :: Id -> Nabla -> (ClassId, Nabla) representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -21,7 +21,6 @@ module GHC.Types.Hint ( , noStarIsTypeHints ) where -import Language.Haskell.Syntax.Expr (LHsExpr) import Language.Haskell.Syntax (LPat, LIdP) import GHC.Prelude @@ -48,9 +47,6 @@ import GHC.Data.FastString (fsLit, FastString) import Data.Typeable ( Typeable ) import Language.Haskell.Syntax.Expr -import GHC.Unit.Module.Imported (ImportedModsVal) -import GHC.Data.FastString (fsLit) -import Language.Haskell.Syntax (LPat, LIdP) -- This {-# SOURCE #-} import should be removable once -- 'Language.Haskell.Syntax.Bind' no longer depends on 'GHC.Tc.Types.Evidence'. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e33eec3ac9a832ccd69b10dfc98a5852f3bae78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e33eec3ac9a832ccd69b10dfc98a5852f3bae78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 01:06:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 13 Jul 2023 21:06:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] Revert "CI: add JS release and debug builds, regen CI jobs" Message-ID: <64b09f8e244ce_3f5efcb368c79196@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 358157c5 by Matthew Pickering at 2023-07-13T21:06:10-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 4 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - testsuite/config/ghc - testsuite/driver/testlib.py Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -228,16 +228,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -jsDebug :: BuildConfig -> BuildConfig -jsDebug c = c { bignumBackend = Native - -- make the job a debug job - , buildFlavour = SlowValidate - , withAssertions = True - } - -jsPerf :: BuildConfig -> BuildConfig -jsPerf c = c { bignumBackend = Native } - zstdIpe :: BuildConfig zstdIpe = vanilla { withZstd = True } @@ -935,8 +925,10 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) - , standardBuildsWithConfig Amd64 (Linux Debian11) (jsPerf $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) - , validateBuilds Amd64 (Linux Debian11) (jsDebug $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") + ) + { bignumBackend = Native + } , make_wasm_jobs wasm_build_config , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {bignumBackend = Native} @@ -1011,7 +1003,7 @@ platform_mapping = Map.map go $ hasReleaseBuild (StandardTriple{}) = True hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { _bindistName :: String } +data BindistInfo = BindistInfo { bindistName :: String } instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] @@ -1026,7 +1018,6 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" -write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -1585,71 +1585,6 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "8 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "XZ_OPT": "-9" - } - }, "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3060,73 +2995,6 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "HADRIAN_ARGS": "--hash-unit-ids", - "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "XZ_OPT": "-9" - } - }, "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4777,70 +4645,6 @@ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, - "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "2 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" - } - }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== testsuite/config/ghc ===================================== @@ -80,7 +80,6 @@ if not config.arch == "javascript": config.compile_ways.append('hpc') config.run_ways.append('hpc') -# WASM if config.arch == "wasm32": config.have_process = False config.supports_dynamic_libs = False @@ -270,12 +269,7 @@ def get_compiler_info(): config.have_vanilla = compiler_supports_way([]) config.have_dynamic = compiler_supports_way(['-dynamic']) - - # JavaScript doesn't support profiling yet. See #22261 - if config.arch == "javascript": - config.have_profiling = False - else: - config.have_profiling = compiler_supports_way(['-prof']) + config.have_profiling = compiler_supports_way(['-prof']) if config.have_profiling: config.compile_ways.append('profasm') ===================================== testsuite/driver/testlib.py ===================================== @@ -236,11 +236,6 @@ def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: opts.expect = 'fail' - # many profiling tests must be skipped for the JS backend. That is - # because they unexpectedly pass even though the JS backend does not - # support profiling yet. See #22251 - if js_arch(): - js_skip(name, opts) # JS backend doesn't support profiling yet if arch("js"): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/358157c5ca226b99c15e8190a324edd56e7acf2d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/358157c5ca226b99c15e8190a324edd56e7acf2d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 02:12:58 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Thu, 13 Jul 2023 22:12:58 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] 83 commits: hadrian: Fix dependencies of docs:* rule Message-ID: <64b0af2af887_3f5efcb31a0807022@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - ee621369 by Gergő Érdi at 2023-07-14T03:12:47+01:00 Desugar bindings in the context of their evidence Closes #23172 - - - - - d6ce0615 by Gergő Érdi at 2023-07-14T03:12:48+01:00 Add flag to `-f{no-}specialise-incoherents` to enable/disable specialisation of incoherent instances Fixes #23287 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b15ac27629dda6daea8e3963afa930660873f5b...d6ce06158dd1cd3439e7ae6aa88ee3de82541850 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6b15ac27629dda6daea8e3963afa930660873f5b...d6ce06158dd1cd3439e7ae6aa88ee3de82541850 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 07:25:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 14 Jul 2023 03:25:21 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 14 commits: Hadrian: enable GHCi support on riscv64 Message-ID: <64b0f86133252_3f5efc416224748343e2@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 08574ca2 by Matthew Craven at 2023-07-14T08:24:49+01:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b782e1842a84d0a6689a2573ce8631a2abc12de4...08574ca279bc6b234734e8d45d47b1d971de1d11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b782e1842a84d0a6689a2573ce8631a2abc12de4...08574ca279bc6b234734e8d45d47b1d971de1d11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 08:30:20 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 14 Jul 2023 04:30:20 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Get compilation with more exhaustiveness working again, Message-ID: <64b1079c69091_3f5efcb31a08620b4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 84bd5fca by Rodrigo Mesquita at 2023-07-14T09:28:39+01:00 Get compilation with more exhaustiveness working again, but this time with a cleaner story, since in PhiCt we already only have ClassIds. It works for the first two examples in #19272, but it does not solve the latest contrived example we came up with -- I think it's likely because of rebuilding. RE rebuilding: It doesn't look like usually there are many/any things in the worklist, meaning it's probably quite cheap to rebuild often. - - - - - 8 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Hint.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -338,7 +338,7 @@ instance Ord a => Ord (DeBruijn (CoreAltF a)) where cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where - go (Breakpoint lext lid lids) (Breakpoint rext rid rids) + go (Breakpoint lext lid lids _) (Breakpoint rext rid rids _) = case compare lid rid of LT -> LT EQ -> case compare (D env1 lids) (D env2 rids) of ===================================== compiler/GHC/HsToCore/Errors/Ppr.hs ===================================== @@ -22,6 +22,8 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt import GHC.HsToCore.Pmc.Ppr +import GHC.HsToCore.Pmc.Solver.Types (lookupMatchIdMap) +import Data.Maybe (fromJust) instance Diagnostic DsMessage where @@ -71,9 +73,9 @@ instance Diagnostic DsMessage where pprContext False kind (text "are non-exhaustive") $ \_ -> case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" - _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas - -- pp_tys = pprQuotedList $ map idType vars - pp_tys = empty + -- See Note (TODO) [The MatchIds for error reporting] (and possibly factor this map lookupMatchIdMap outside) + _ -> let us = map (\nabla -> pprUncovered nabla (map (fromJust . (`lookupMatchIdMap` nabla)) vars)) nablas + pp_tys = pprQuotedList $ map idType vars in hang (text "Patterns of type" <+> pp_tys <+> text "not matched:") 4 ===================================== compiler/GHC/HsToCore/Errors/Types.hs ===================================== @@ -20,8 +20,6 @@ import GHC.Types.Id import GHC.Types.Name (Name) import qualified GHC.LanguageExtensions as LangExt -import Data.Equality.Graph (ClassId) - import GHC.Generics (Generic) newtype MinBound = MinBound Integer @@ -101,7 +99,7 @@ data DsMessage | DsNonExhaustivePatterns !(HsMatchContext GhcRn) !ExhaustivityCheckType !MaxUncoveredPatterns - [ClassId] + [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] [Nabla] | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -75,7 +75,7 @@ import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Coerce -import Data.Equality.Graph (ClassId) +import Data.Maybe (fromJust) -- -- * Exported entry points to the checker @@ -104,22 +104,15 @@ pmcPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [pmcPatBind only checks PatBindRhs] pmcPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do !missing <- getLdiNablas + + -- See Note (TODO) [Represent the MatchIds before the CheckAction] + let missing' = representIdNablas var missing + pat_bind <- noCheckDs $ desugarPatBind loc var p tracePm "pmcPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) - result0 <- unCA (checkPatBind pat_bind) missing - tracePm "}: " (ppr (cr_uncov result0)) - -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph - -- doing this, however, wouuld require for desugar pat binds to care about/thread through nablas - -- DESIGN:TODO: However, if we represent the variables while desugaring, we - -- would no longer need representId to represent VarF in the e-class, and can - -- instead do newEClass. This would further reduce allocations. - -- The reason why we can't do that currently is that on checkPatBind we'll - -- representIds, and when we represent them again in the next line, we want - -- them to match the ones we represented during checkPatBind. If we made - -- empty-eclasses, the representId on the next line wouldn't match the match - -- ids we defined in checkPatBind. - let (varid, cr_uncov') = representId var (cr_uncov result0) - formatReportWarnings ReportPatBind ctxt [varid] result0{cr_uncov = cr_uncov'} + result <- unCA (checkPatBind pat_bind) missing' + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings ReportPatBind ctxt [var] result pmcPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and @@ -173,28 +166,27 @@ pmcMatches ctxt vars matches = {-# SCC "pmcMatches" #-} do hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 (vcat (map ppr matches) $$ ppr missing) + + -- See Note (TODO) [Represent the MatchIds before the CheckAction] + let missing' = representIdsNablas vars missing + case NE.nonEmpty matches of Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] let var = only vars empty_case <- noCheckDs $ desugarEmptyCase var - result0 <- unCA (checkEmptyCase empty_case) missing - tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) -- romes:todo: this seems redundant, hints that the right thing might be for desugar to return already the match variables already "represented" in the e-graph - formatReportWarnings ReportEmptyCase ctxt varids result0{cr_uncov=cr_uncov'} + result <- unCA (checkEmptyCase empty_case) missing' + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings ReportEmptyCase ctxt vars result return [] Just matches -> do matches <- {-# SCC "desugarMatches" #-} noCheckDs $ desugarMatches vars matches - result0 <- {-# SCC "checkMatchGroup" #-} - unCA (checkMatchGroup matches) missing - tracePm "}: " (ppr (cr_uncov result0)) - let (varids, cr_uncov') = representIds vars (cr_uncov result0) - -- romes:todo: this seems redundant, hints that the right thing might be - -- for desugar to return already the match variables already "represented" - -- in the e-graph - {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt varids result0{cr_uncov=cr_uncov'} - return (NE.toList (ldiMatchGroup (cr_ret result0))) + result <- {-# SCC "checkMatchGroup" #-} + unCA (checkMatchGroup matches) missing' + tracePm "}: " (ppr (cr_uncov result)) + {-# SCC "formatReportWarnings" #-} formatReportWarnings ReportMatchGroup ctxt vars result + return (NE.toList (ldiMatchGroup (cr_ret result))) {- Note [pmcPatBind only checks PatBindRhs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -358,7 +350,11 @@ collectInMode ReportEmptyCase = cirbsEmptyCase -- | Given a 'FormatReportWarningsMode', this function will emit warnings -- for a 'CheckResult'. -formatReportWarnings :: FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult ann -> DsM () +formatReportWarnings :: FormatReportWarningsMode ann + -> DsMatchContext + -> [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] + -> CheckResult ann + -> DsM () formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do cov_info <- collectInMode report_mode ann dflags <- getDynFlags @@ -366,7 +362,7 @@ formatReportWarnings report_mode ctx vars cr at CheckResult { cr_ret = ann } = do -- | Issue all the warnings -- (redundancy, inaccessibility, exhaustiveness, redundant bangs). -reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [ClassId] -> CheckResult CIRB -> DsM () +reportWarnings :: DynFlags -> FormatReportWarningsMode ann -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () reportWarnings dflags report_mode (DsMatchContext kind loc) vars CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss , cirb_red = redundant_rhss @@ -405,13 +401,16 @@ reportWarnings dflags report_mode (DsMatchContext kind loc) vars maxPatterns = maxUncoveredPatterns dflags -getNFirstUncovered :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered :: GenerateInhabitingPatternsMode + -> [Id] -- ^ The MatchIds, see Note (TODO) [The MatchIds for error reporting] + -> Int -> Nablas -> DsM [Nabla] getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- generateInhabitingPatterns mode vars n nabla + -- See Note (TODO) [The MatchIds for error reporting] (and possibly factor this map lookupMatchIdMap to an independent function since its used twice, here and in the call of pprUncovered) + front <- generateInhabitingPatterns mode (map (fromJust . (`lookupMatchIdMap` nabla)) vars) n nabla back <- go (n - length front) nablas pure (front ++ back) @@ -448,8 +447,9 @@ addCoreScrutTmCs :: [CoreExpr] -> [Id] -> DsM a -> DsM a addCoreScrutTmCs [] _ k = k addCoreScrutTmCs (scr:scrs) (x0:xs) k = flip locallyExtendPmNablas (addCoreScrutTmCs scrs xs k) $ \nablas0 -> - let (x, nablas) = representId x0 nablas0 - in addPhiCtsNablas nablas (unitBag (PhiCoreCt x scr)) + liftNablasM (\d -> + let (x, d') = representId x0 d + in addPhiCts d' (unitBag (PhiCoreCt x scr))) nablas0 addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: numbers of scrutinees and match ids differ" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr's first. @@ -500,4 +500,18 @@ unreachable. We make sure to always start from an inhabited 'Nablas' by calling 'getLdiNablas', which falls back to the trivially inhabited 'Nablas' if the long-distance info returned by 'GHC.HsToCore.Monad.getPmNablas' is empty. + +Note [The MatchId for error reporting] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Something sometihng, when we're talking about MatchIds that might occur in +Nablas (rather than just in a Nabla), we have to refer to them by Id, rather +than by e-class-id. + +This is because e-class-ids will vary between Nabla, but each Nabla maps Ids to e-class-ids. +So an Id is the only identifier that identifies the same match-id across Nablas. + +We can safely query each Nabla for the MatchIds because we make sure to +represent the MatchIds in the Nablas as soon as possible (in pmcMatches and +friends) + -} ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -1,4 +1,5 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -103,22 +104,18 @@ emptyRedSets :: RedSets emptyRedSets = RedSets mempty mempty mempty checkGrd :: PmGrd -> CheckAction RedSets -checkGrd grd = CA $ \inc0 -> case grd of +checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e - PmLet x0 e -> do - let (x, inc) = representId x0 inc0 - -- romes: we could potentially do update the trees to use e-class ids here, - -- or in pmcMatches - matched <- addPhiCtNablas inc (PhiCoreCt x e) + PmLet x e -> do + matched <- addPhiCtNablasWithRep inc x (`PhiCoreCt` e) tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x ≁ ⊥ - PmBang x0 mb_info -> do - let (x, inc) = representId x0 inc0 - div <- addPhiCtNablas inc (PhiBotCt x) - matched <- addPhiCtNablas inc (PhiNotBotCt x) + PmBang x mb_info -> do + div <- addPhiCtNablasWithRep inc x PhiBotCt + matched <- addPhiCtNablasWithRep inc x PhiNotBotCt -- it will do a redundant lookup to represent x again... we would like @inc@ to have the rep already for both -- See Note [Dead bang patterns] -- mb_info = Just info <==> PmBang originates from bang pattern in source let bangs | Just info <- mb_info = unitOL (div, info) @@ -135,14 +132,13 @@ checkGrd grd = CA $ \inc0 -> case grd of , cr_uncov = mempty , cr_approx = Precise } -- Con: Fall through on x ≁ K and refine with x ~ K ys and type info - PmCon x0 con tvs dicts args0 -> do - let (x, inc1) = representId x0 inc0 - (args, inc) = representIds args0 inc1 + PmCon x con tvs dicts args -> do + -- romes: for now we do the redundant representation of vars, but whatever !div <- if isPmAltConMatchStrict con - then addPhiCtNablas inc (PhiBotCt x) + then addPhiCtNablasWithRep inc x PhiBotCt else pure mempty - !matched <- addPhiCtNablas inc (PhiConCt x con tvs (map evVarPred dicts) args) - !uncov <- addPhiCtNablas inc (PhiNotConCt x con) + !matched <- addPhiCtNablasWithReps inc (x:args) (\case (xi:argsi) -> PhiConCt xi con tvs (map evVarPred dicts) argsi; _ -> error "impossible") + !uncov <- addPhiCtNablasWithRep inc x (`PhiNotConCt` con) tracePm "check:Con" $ vcat [ ppr grd , ppr inc @@ -185,8 +181,7 @@ checkGRHS (PmGRHS { pg_grds = GrdVec grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase -- See Note [Checking EmptyCase] checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - let (varid, inc') = representId var inc - unc <- addPhiCtNablas inc' (PhiNotBotCt varid) + unc <- addPhiCtNablasWithRep inc var PhiNotBotCt pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -29,6 +29,9 @@ module GHC.HsToCore.Pmc.Solver ( PhiCt(..), PhiCts, addPhiCtNablas, addPhiCtsNablas, + addPhiCtNablasWithRep, addPhiCtNablasWithReps, + liftNablasM, + addPhiCts, isInhabited, generateInhabitingPatterns, GenerateInhabitingPatternsMode(..) @@ -121,6 +124,16 @@ addPhiCtsNablas nablas cts = liftNablasM (\d -> addPhiCts d cts) nablas addPhiCtNablas :: Nablas -> PhiCt -> DsM Nablas addPhiCtNablas nablas ct = addPhiCtsNablas nablas (unitBag ct) +-- | 'addPmCtsNablas' for a single 'PmCt', but first represent the Id in each Nabla. +addPhiCtNablasWithRep :: Nablas -> Id -> (ClassId -> PhiCt) -> DsM Nablas +addPhiCtNablasWithRep nablas x ctf + = liftNablasM (\d -> let (xi, d') = representId x d in addPhiCts d' (unitBag (ctf xi))) nablas + +-- | Represent all Id in each Nabla. +addPhiCtNablasWithReps :: Nablas -> [Id] -> ([ClassId] -> PhiCt) -> DsM Nablas +addPhiCtNablasWithReps nablas xs ctf + = liftNablasM (\d -> let (xsi, d') = representIds xs d in addPhiCts d' (unitBag (ctf xsi))) nablas + liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) @@ -889,7 +902,7 @@ addCoreCt :: Nabla -> ClassId -> CoreExpr -> MaybeT DsM Nabla addCoreCt nabla x e = do simpl_opts <- initSimpleOpts <$> getDynFlags let e' = simpleOptExpr simpl_opts e - -- lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e') + lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (eclassType x nabla) $$ ppr e $$ ppr e') execStateT (core_expr x e') nabla where -- Takes apart a 'CoreExpr' and tries to extract as much information about @@ -919,7 +932,7 @@ addCoreCt nabla x e = do <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args | otherwise - = do -- equate_with_similar_expr x e + = do nabla' <- get if -- See Note [Detecting pattern synonym applications in expressions] @@ -927,8 +940,7 @@ addCoreCt nabla x e = do | Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') -- We don't consider DataCons flexible variables -> modifyT (\nabla -> let (yid, nabla') = representId y nabla - in addVarCt nabla' x yid) - -- -> modifyT (\nabla -> addVarCt nabla' x y) + in lift (tracePm "foundIdVar:" (ppr y <+> text "->>>" <+> ppr yid)) >> addVarCt nabla' x yid) | otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE RankNTypes #-} @@ -21,7 +22,10 @@ module GHC.HsToCore.Pmc.Solver.Types ( lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, representIds, representIdNablas, representIdsNablas, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, + + representId, representIds, representIdNablas, representIdsNablas, + lookupMatchIdMap, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -88,7 +92,7 @@ import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) import qualified Data.IntSet as IS (empty) -import Data.Bifunctor (second, bimap, first) +import Data.Bifunctor (second) import Control.Monad.Trans.State (runState, state, execState) -- import GHC.Driver.Ppr @@ -166,6 +170,9 @@ data TmState -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } +lookupMatchIdMap :: Id -> Nabla -> Maybe ClassId +lookupMatchIdMap id (MkNabla _ TmSt{ts_reps}) = lookupVarEnv ts_reps id + -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set @@ -243,6 +250,9 @@ instance Outputable BotInfo where ppr IsBot = text "~⊥" ppr IsNotBot = text "≁⊥" +instance Outputable IntSet where + ppr = text . show + -- | Not user-facing. instance Outputable TmState where ppr (TmSt eg idmp dirty) = text (show eg) $$ ppr idmp $$ ppr dirty @@ -843,11 +853,17 @@ representIdNablas x (MkNablas nbs) = MkNablas $ mapBag (snd . representId x) nbs representIdsNablas :: [Id] -> Nablas -> Nablas representIdsNablas xs = execState (mapM (\x -> state (((),) . representIdNablas x)) xs) +-- Are these even used? don't we always use the ones above? -- | Like 'representId' but for a single Nabla representId :: Id -> Nabla -> (ClassId, Nabla) representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) = case lookupVarEnv idmp x of - Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of + -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representDBCoreExpr' + -- In particular, if we represent "reverse @a xs" in the e-graph, the + -- node in which "xs" will be represented won't match the e-class id + -- representing "xs", because that class doesn't contain "VarF xs" + -- Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of + Nothing -> case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) Just xid -> (xid, MkNabla tyst tmst) ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -21,7 +21,6 @@ module GHC.Types.Hint ( , noStarIsTypeHints ) where -import Language.Haskell.Syntax.Expr (LHsExpr) import Language.Haskell.Syntax (LPat, LIdP) import GHC.Prelude @@ -48,9 +47,6 @@ import GHC.Data.FastString (fsLit, FastString) import Data.Typeable ( Typeable ) import Language.Haskell.Syntax.Expr -import GHC.Unit.Module.Imported (ImportedModsVal) -import GHC.Data.FastString (fsLit) -import Language.Haskell.Syntax (LPat, LIdP) -- This {-# SOURCE #-} import should be removable once -- 'Language.Haskell.Syntax.Bind' no longer depends on 'GHC.Tc.Types.Evidence'. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84bd5fcaaf1b37b17c138ea3a67c7dbf1eca4803 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84bd5fcaaf1b37b17c138ea3a67c7dbf1eca4803 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 08:52:11 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 14 Jul 2023 04:52:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/lint-ci-config Message-ID: <64b10cbb14110_3f5efc4d5660ec873048@gitlab.mail> Matthew Pickering pushed new branch wip/lint-ci-config at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/lint-ci-config You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 09:00:48 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 14 Jul 2023 05:00:48 -0400 Subject: [Git][ghc/ghc][wip/lint-ci-config] lint-ci-config: Generate jobs-metadata.json Message-ID: <64b10ec0ec1d9_3f5efc446cd100878492@gitlab.mail> Matthew Pickering pushed to branch wip/lint-ci-config at Glasgow Haskell Compiler / GHC Commits: a687eb89 by Matthew Pickering at 2023-07-14T10:00:25+01:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -278,6 +278,12 @@ lint-ci-config: - nix run .gitlab/generate-ci#generate-jobs # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code + # And run this to generate the .gitlab/jobs-metadata.json + - nix run .gitlab/generate-ci#generate-job-metadata + artifacts: + paths: + - .gitlab/jobs-metadata.json + - .gitlab/jobs.yaml dependencies: [] lint-submods: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a687eb893e30e885873e399b2e463ef3f2b78511 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a687eb893e30e885873e399b2e463ef3f2b78511 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 09:02:12 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 14 Jul 2023 05:02:12 -0400 Subject: [Git][ghc/ghc][wip/lint-ci-config] lint-ci-config: Generate jobs-metadata.json Message-ID: <64b10f14f0a41_3f5efc65c9ff88794a@gitlab.mail> Matthew Pickering pushed to branch wip/lint-ci-config at Glasgow Haskell Compiler / GHC Commits: d42785da by Matthew Pickering at 2023-07-14T10:01:56+01:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -278,6 +278,13 @@ lint-ci-config: - nix run .gitlab/generate-ci#generate-jobs # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code + # And run this to generate the .gitlab/jobs-metadata.json + - nix run .gitlab/generate-ci#generate-job-metadata + artifacts: + when: always + paths: + - .gitlab/jobs-metadata.json + - .gitlab/jobs.yaml dependencies: [] lint-submods: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d42785da8c2035bbe5e4ca573c13fcfa6735a926 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d42785da8c2035bbe5e4ca573c13fcfa6735a926 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 09:46:54 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 14 Jul 2023 05:46:54 -0400 Subject: [Git][ghc/ghc][wip/test-primops] 4 commits: lint-ci-config: Generate jobs-metadata.json Message-ID: <64b1198ec57ed_3f5efc5929cb2088739@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 80466b75 by Matthew Pickering at 2023-07-14T09:50:06+01:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 01f09267 by Matthew Pickering at 2023-07-14T09:53:24+01:00 Generate v in job metadata - - - - - cf27af11 by Matthew Pickering at 2023-07-14T10:46:32+01:00 project version always - - - - - 25cd23f5 by Matthew Pickering at 2023-07-14T10:46:46+01:00 fix - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -278,6 +278,12 @@ lint-ci-config: - nix run .gitlab/generate-ci#generate-jobs # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code + # And run this to generate the .gitlab/jobs-metadata.json + - nix run .gitlab/generate-ci#generate-job-metadata + artifacts: + paths: + - .gitlab/jobs-metadata.json + - .gitlab/jobs.yaml dependencies: [] lint-submods: @@ -1026,9 +1032,6 @@ project-version: artifacts: paths: - version.sh - rules: - - if: '$NIGHTLY' - - if: '$RELEASE_JOB == "yes"' .ghcup-metadata: stage: deploy ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -853,7 +853,8 @@ data JobGroup a = StandardTriple { v :: NamedJob a instance ToJSON a => ToJSON (JobGroup a) where toJSON jg = object - [ "n" A..= n jg + [ "v" A..= v jg + , "n" A..= n jg , "r" A..= r jg ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30371d6b34e8b2ab4519b9a5c87405f928dc8ac5...25cd23f57c6b428fca8eabcaded7e2fe3a3dbfd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/30371d6b34e8b2ab4519b9a5c87405f928dc8ac5...25cd23f57c6b428fca8eabcaded7e2fe3a3dbfd2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 10:14:36 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 14 Jul 2023 06:14:36 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Add comment about HstyPatRn Message-ID: <64b1200c4c509_3f5efcb31a09004f3@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 07dd34ec by Andrei Borzenkov at 2023-07-14T14:14:26+04:00 Add comment about HstyPatRn - - - - - 1 changed file: - compiler/GHC/Hs/Type.hs Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -232,6 +232,13 @@ data HsPSRn = HsPSRn } deriving Data +-- HsTyPatRn is the extension field for `HsTyPat`, after renaming +-- E.g. pattern K @(Maybe (_x, a, b::Proxy k) +-- In the type pattern @(Maybe ...): +-- '_x' is a named wildcard +-- 'a' is explicitly bound +-- 'k' is implicitly bound +-- See Note [Implicit and explicit type variable binders] in GHC.Rename.Pat data HsTyPatRn = HsTPRn { hstp_nwcs :: [Name] -- ^ Wildcard names , hstp_imp_tvs :: [Name] -- ^ Implicitly bound variable names View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07dd34ec00956acf326fab0fad8b2b2b947760a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07dd34ec00956acf326fab0fad8b2b2b947760a3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 11:35:28 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 14 Jul 2023 07:35:28 -0400 Subject: [Git][ghc/ghc][wip/T22404] Sundry perf improvements Message-ID: <64b13300d579b_3f5efc4d5660ec939592@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 78e96385 by Simon Peyton Jones at 2023-07-14T12:34:57+01:00 Sundry perf improvements - - - - - 4 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -954,17 +954,37 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine = let !(WUD body_uds res) = addInScope env [bndr] thing_inside in WUD body_uds (combine [NonRec bndr rhs] res) + -- Fast path for top level, non-recursive bindings, with no unfoldings or rules + | TopLevel <- lvl + , not (idHasRules bndr) + , not (bndr `elemVarEnv` ire) + = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside + in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else let + unf = idUnfolding bndr + rhs_env = addOneShotsFromDmd bndr $ + setNonTailCtxt OccRhs env + !rhs_wuds@(WTUD _ rhs') = occAnalLamTail rhs_env rhs + !(WTUD (TUD _ unf_uds) _) = occAnalUnfolding rhs_env unf + rhs_uds = adjustTailUsage Nothing rhs_wuds + full_rhs_uds | isStableUnfolding unf = rhs_uds `andUDs` markAllNonTail unf_uds + | otherwise = rhs_uds + + in WUD (full_rhs_uds `andUDs` body_uds) -- Note `andUDs` + (combine [NonRec tagged_bndr rhs'] body) + -- /Existing/ non-recursive join points -- Analyse the RHS and /then/ the body | NotTopLevel <- lvl , mb_join@(Just {}) <- isJoinId_maybe bndr = let -- Analyse the rhs first, generating rhs_uds - (rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs + !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs rhs_uds = foldr1 orUDs rhs_uds_s -- Note orUDs -- Now analyse the body, adding the join point -- into the environment with addJoinPoint - WUD body_uds (tagged_bndr, body) + !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env NotTopLevel bndr' $ \env -> thing_inside (addJoinPoint env bndr' rhs_uds) in @@ -977,7 +997,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- Analyse the body and /then/ the RHS | otherwise = let - WUD body_uds (tagged_bndr, body) = occAnalNonRecBody env lvl bndr thing_inside + !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body else let @@ -985,7 +1005,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- See Note [Join points and unfoldings/rules] -- => join arity O of Note [Join arity prediction based on joinRhsArity] mb_join = willBeJoinId_maybe tagged_bndr - (rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs + !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs` (combine [NonRec final_bndr rhs'] body) @@ -993,6 +1013,8 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine occAnalNonRecBody :: OccEnv -> TopLevelFlag -> Id -> (OccEnv -> WithUsageDetails r) -- Scope of the bind -> (WithUsageDetails (Id, r)) +{-# INLINE occAnalNonRecBody #-} +-- INLINE: it's small and higher order, just a macro really occAnalNonRecBody env lvl bndr thing_inside = addInScope env [bndr] $ \env -> let !(WUD inner_uds res) = thing_inside env @@ -1016,7 +1038,7 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs | otherwise = OccRhs -- See Note [Sources of one-shot information] - rhs_env = env1 { occ_one_shots = argOneShots dmd } + rhs_env = addOneShotsFromDmd bndr env1 -- See Note [Join arity prediction based on joinRhsArity] -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; @@ -1061,7 +1083,6 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs -> active && not_stable _ -> False - dmd = idDemandInfo bndr active = isAlwaysActive (idInlineActivation bndr) not_stable = not (isStableUnfolding unf) @@ -1108,7 +1129,7 @@ occAnalRec !_ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds })) (WUD body_uds binds) = WUD (body_uds `andUDs` rhs_uds') - (NonRec bndr' rhs' : binds) + (NonRec bndr' rhs' : binds) where tagged_bndr = tagNonRecBinder lvl body_uds bndr mb_join_arity = willBeJoinId_maybe tagged_bndr @@ -2114,7 +2135,7 @@ occAnalLamTail :: OccEnv -> CoreExpr -> WithTailUsageDetails CoreExpr -- manifest arity and adjustTailUsage does the fixup. -- See Note [Adjusting right-hand sides] occAnalLamTail env expr - = let WUD usage expr' = occ_anal_lam_tail env expr + = let !(WUD usage expr') = occ_anal_lam_tail env expr in WTUD (TUD (joinRhsArity expr) usage) expr' occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr @@ -2122,7 +2143,7 @@ occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr occ_anal_lam_tail env (Lam bndr expr) | isTyVar bndr = addInScope env [bndr] $ \env -> - let WUD usage expr' = occ_anal_lam_tail env expr + let !(WUD usage expr') = occ_anal_lam_tail env expr in WUD usage (Lam bndr expr') -- Important: Do not modify occ_encl, so that with a RHS like -- \(@ x) -> K @x (f @x) @@ -2141,7 +2162,7 @@ occ_anal_lam_tail env (Lam bndr expr) -- See Note [The oneShot function] env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - WUD usage expr' = occ_anal_lam_tail env1 expr + !(WUD usage expr') = occ_anal_lam_tail env1 expr bndr2 = tagLamBinder usage bndr1 in WUD usage (Lam bndr2 expr') @@ -2454,7 +2475,7 @@ occAnal env (Tick tickish body) = WUD (markAllNonTail usage) (Tick tickish body') | Breakpoint _ _ ids _ <- tickish - = WUD (usage_lam `andUDs` foldr addManyOcc emptyDetails ids) (Tick tickish body') + = WUD (usage_lam `andUDs` foldl' addManyOccId emptyDetails ids) (Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise @@ -2521,7 +2542,9 @@ occAnal env (Let bind body) = occAnalBind env NotTopLevel noImpRuleEdges bind (\env -> occAnal env body) mkLets -occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -> WithUsageDetails CoreExpr +occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] + -> [OneShots] -- Very commonly empty, notably prior to dmd anal + -> WithUsageDetails CoreExpr -- The `fun` argument is just an accumulating parameter, -- the base for building the application we return occAnalArgs !env fun args !one_shots @@ -2535,8 +2558,12 @@ occAnalArgs !env fun args !one_shots where !(WUD arg_uds arg') = occAnal arg_env arg !(arg_env, one_shots') - | isTypeArg arg = (env, one_shots) - | otherwise = addOneShots env_args one_shots + | isTypeArg arg + = (env, one_shots) + | otherwise + = case one_shots of + [] -> (env, []) -- Fast path; one_shots is often empty + (os : one_shots') -> (addOneShots os env_args, one_shots') {- Applications are dealt with specially because we want @@ -2856,11 +2883,13 @@ setTailCtxt !env -- Do not use OccRhs for the RHS of a join point (which is a tail ctxt): -- see Note [Join point RHSs] -addOneShots :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) -addOneShots !env one_shots - = case one_shots of - [] -> (env, []) - (os:oss) -> (env { occ_one_shots = os }, oss) +addOneShots :: OneShots -> OccEnv -> OccEnv +addOneShots os !env + | null os = env -- Fast path for common case + | otherwise = env { occ_one_shots = os } + +addOneShotsFromDmd :: Id -> OccEnv -> OccEnv +addOneShotsFromDmd bndr = addOneShots (argOneShots (idDemandInfo bndr)) isRhsEnv :: OccEnv -> Bool isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -443,23 +443,30 @@ emptyRuleEnv = RuleEnv { re_local_rules = emptyNameEnv getRules :: RuleEnv -> Id -> [CoreRule] -- Given a RuleEnv and an Id, find the visible rules for that Id -- See Note [Where rules are found] -getRules (RuleEnv { re_local_rules = local_rules - , re_home_rules = home_rules - , re_eps_rules = eps_rules +-- +-- This function is quite heavily used, so it's worth trying to make it efficient +getRules (RuleEnv { re_local_rules = local_rule_base + , re_home_rules = home_rule_base + , re_eps_rules = eps_rule_base , re_visible_orphs = orphs }) fn + | isLocalId fn + = idCoreRules fn + | Just {} <- isDataConId_maybe fn -- Short cut for data constructor workers = [] -- and wrappers, which never have any rules | otherwise - = idCoreRules fn ++ - get local_rules ++ - find_visible home_rules ++ - find_visible eps_rules - + = case (get local_rule_base, get home_rule_base, get eps_rule_base) of + ([], [], []) -> idCoreRules fn + (local_rules, home_rules, eps_rules) -> local_rules ++ + drop_orphs home_rules ++ + drop_orphs eps_rules ++ + idCoreRules fn where fn_name = idName fn - find_visible rb = filter (ruleIsVisible orphs) (get rb) + drop_orphs [] = [] -- Fast path + drop_orphs xs = filter (ruleIsVisible orphs) xs get rb = lookupNameEnv rb fn_name `orElse` [] ruleIsVisible :: ModuleSet -> CoreRule -> Bool ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -180,24 +180,6 @@ instance Outputable CallCtxt where ppr RuleArgCtxt = text "RuleArgCtxt" {- -Note [Occurrence analysis of unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We do occurrence-analysis of unfoldings once and for all, when the -unfolding is built, rather than each time we inline them. - -But given this decision it's vital that we do -*always* do it. Consider this unfolding - \x -> letrec { f = ...g...; g* = f } in body -where g* is (for some strange reason) the loop breaker. If we don't -occ-anal it when reading it in, we won't mark g as a loop breaker, and -we may inline g entirely in body, dropping its binding, and leaving -the occurrence in f out of scope. This happened in #8892, where -the unfolding in question was a DFun unfolding. - -But more generally, the simplifier is designed on the -basis that it is looking at occurrence-analysed expressions, so better -ensure that they actually are. - Note [Calculate unfolding guidance on the non-occ-anal'd expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Notice that we give the non-occur-analysed expression to ===================================== compiler/GHC/Core/Unfold/Make.hs ===================================== @@ -86,7 +86,7 @@ mkDFunUnfolding bndrs con ops = DFunUnfolding { df_bndrs = bndrs , df_con = con , df_args = map occurAnalyseExpr ops } - -- See Note [Occurrence analysis of unfoldings] + -- See Note [OccInfo in unfoldings and rules] in GHC.Core mkDataConUnfolding :: CoreExpr -> Unfolding -- Used for non-newtype data constructors with non-trivial wrappers @@ -338,7 +338,7 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr mkCoreUnfolding src top_lvl expr precomputed_cache guidance = CoreUnfolding { uf_tmpl = cache `seq` occurAnalyseExpr expr - -- occAnalyseExpr: see Note [Occurrence analysis of unfoldings] + -- occAnalyseExpr: see Note [OccInfo in unfoldings and rules] in GHC.Core -- See #20905 for what a discussion of this 'seq'. -- We are careful to make sure we only -- have one copy of an unfolding around at once. @@ -459,7 +459,7 @@ With that in mind we want to maintain the invariant that each unfolding only ref a single CoreExpr. One place where we have to be careful is in mkCoreUnfolding. * The template of the unfolding is the result of performing occurrence analysis - (Note [Occurrence analysis of unfoldings]) + (Note [OccInfo in unfoldings and rules] in GHC.Core) * Predicates are applied to the unanalysed expression Therefore if we are not thoughtful about forcing you can end up in a situation where the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78e96385b274a9e7804cc96525d1c6d586cfcdde -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78e96385b274a9e7804cc96525d1c6d586cfcdde You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 11:57:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 14 Jul 2023 07:57:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] Revert "CI: add JS release and debug builds, regen CI jobs" Message-ID: <64b138352f8c9_3f5efc4d5660ec9460fa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 114aee5f by Matthew Pickering at 2023-07-14T07:57:32-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 4 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - testsuite/config/ghc - testsuite/driver/testlib.py Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -228,16 +228,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -jsDebug :: BuildConfig -> BuildConfig -jsDebug c = c { bignumBackend = Native - -- make the job a debug job - , buildFlavour = SlowValidate - , withAssertions = True - } - -jsPerf :: BuildConfig -> BuildConfig -jsPerf c = c { bignumBackend = Native } - zstdIpe :: BuildConfig zstdIpe = vanilla { withZstd = True } @@ -935,8 +925,10 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) - , standardBuildsWithConfig Amd64 (Linux Debian11) (jsPerf $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) - , validateBuilds Amd64 (Linux Debian11) (jsDebug $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") + ) + { bignumBackend = Native + } , make_wasm_jobs wasm_build_config , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {bignumBackend = Native} @@ -1011,7 +1003,7 @@ platform_mapping = Map.map go $ hasReleaseBuild (StandardTriple{}) = True hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { _bindistName :: String } +data BindistInfo = BindistInfo { bindistName :: String } instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] @@ -1026,7 +1018,6 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" -write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -1585,71 +1585,6 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "8 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "XZ_OPT": "-9" - } - }, "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3060,73 +2995,6 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "HADRIAN_ARGS": "--hash-unit-ids", - "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "XZ_OPT": "-9" - } - }, "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4777,70 +4645,6 @@ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, - "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "2 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" - } - }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== testsuite/config/ghc ===================================== @@ -80,7 +80,6 @@ if not config.arch == "javascript": config.compile_ways.append('hpc') config.run_ways.append('hpc') -# WASM if config.arch == "wasm32": config.have_process = False config.supports_dynamic_libs = False @@ -270,12 +269,7 @@ def get_compiler_info(): config.have_vanilla = compiler_supports_way([]) config.have_dynamic = compiler_supports_way(['-dynamic']) - - # JavaScript doesn't support profiling yet. See #22261 - if config.arch == "javascript": - config.have_profiling = False - else: - config.have_profiling = compiler_supports_way(['-prof']) + config.have_profiling = compiler_supports_way(['-prof']) if config.have_profiling: config.compile_ways.append('profasm') ===================================== testsuite/driver/testlib.py ===================================== @@ -236,11 +236,6 @@ def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: opts.expect = 'fail' - # many profiling tests must be skipped for the JS backend. That is - # because they unexpectedly pass even though the JS backend does not - # support profiling yet. See #22251 - if js_arch(): - js_skip(name, opts) # JS backend doesn't support profiling yet if arch("js"): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/114aee5f7fe1da8cdcc78757ead03aa6d9f78acd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/114aee5f7fe1da8cdcc78757ead03aa6d9f78acd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 13:23:35 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 14 Jul 2023 09:23:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23496-take-three Message-ID: <64b14c57b675b_3f5efc65c9ff898055f@gitlab.mail> Ryan Scott pushed new branch wip/T23496-take-three at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23496-take-three You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 13:27:29 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 14 Jul 2023 09:27:29 -0400 Subject: [Git][ghc/ghc][wip/T23496-take-three] 3 commits: Bump Cabal submodule Message-ID: <64b14d418cf8e_3f5efc4162247498077a@gitlab.mail> Ryan Scott pushed to branch wip/T23496-take-three at Glasgow Haskell Compiler / GHC Commits: e7e9efcb by Ryan Scott at 2023-07-14T09:25:48-04:00 Bump Cabal submodule This bumps the `Cabal` submodule to bring in the changes from https://github.com/haskell/cabal/pull/9071, which are a pre-requisite to splitting out a `GHC.Generics.Internal` submodule from `GHC.Generics` (to be done in a subsequent commit). Without these changes, compiling `Cabal` would fail, since `Cabal-syntax`'s `Distribution.Compat.Prelude` was implicitly relying on the bug documented in #23570, and when the modules are split apart, the bug no longer triggers. - - - - - bfd29444 by Ryan Scott at 2023-07-14T09:27:20-04:00 Split GHC.Generics into two modules Most of `GHC.Generics` has now been moved to `GHC.Generics.Internal`, which `GHC.Generics` re-exports. The only things now defined in `GHC.Generics` are the derived `Generic(1)` instances. These need to be put in a different module because of GHC's new approach to dependency analysis used in a fix for #23496 (to be done in a subsequent commit), which is perfectly within its rights to typecheck a generated `Rep` instance before it typechecks any of the definitions that are referenced in the right-hand side of the instance. Putting the definitions in a separate module from the derived `Generic` instances (and therefore the generated `Rep` instances) is a sure-fire way to ensure that this doesn't happen. This causes a fair bit of churn in the expected output of test cases in the test suite, but all of the changes are simply from switching to displaying "`GHC.Generics.Internal`" instead of "`GHC.Generics`". Similarly, this bumps the `haddock` submodule to bring in some changes to test cases in the Haddock test suite. - - - - - c955449e by Ryan Scott at 2023-07-14T09:27:20-04:00 deriving: Typecheck associated family instances before instance bindings This is a significant overhaul of the way that `deriving` clauses and standalone `deriving` declarations are typechecked. The highlights: * Standalone `deriving` declarations are located in the new `DerivInstD` constructor of `ClsInstDecl`, rather than as part of the `DerivD` constructor of `HsGroup`. This move now means that standalone `deriving` instance declarations are located alongside other forms of instance declarations, which makes it easier to perform SCC analysis on them, as they are now part of a `TyClGroup`. * Now that everything `deriving`-related lives in `TyClGroup`s, we now typecheck all of the associated type family instances that are generated from `deriving` clauses/declarations first (in `tcTyClGroup`) _before_ typechecking any of the generated instance bindings, which happen after all of the `TyClGroup`s have been processed. Doing so is essential to ensuring that these associated type instances are in scope when needed to typecheck other code in later `TyClGroup`s, such as the failing examples seen in #23496. I have written an extensive `Note [Staging of deriving]` (previously `Note [Staging of tcDeriving]`) to describe how everything works. The second bullet point above involves quite a bit of churn in the expected output of several test cases. This is for two reasons: 1. The order in which things are printed with `-ddump-deriv` is now different, since `deriving`-related family instances are now generated earlier in the typechecker. 2. If a test case errors out when typechecking a `deriving`-related family instance, then GHC will stop there before printing any errors involving the generated instance bindings. (Previously, both sorts of errors were printed simultaneously.) As such, some expected-to-fail test cases do not print out as many errors as before. Fixes #23496. - - - - - 23 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Hs/Decls.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/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/Instance.hs-boot - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - libraries/Cabal - libraries/base/GHC/Generics.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57f0ceb5ff6059df0a4f229cd143c8af247feef5...c955449e244a027fc12f86c387dac6be773aa27f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57f0ceb5ff6059df0a4f229cd143c8af247feef5...c955449e244a027fc12f86c387dac6be773aa27f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 14:28:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 14 Jul 2023 10:28:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: base: fix haddock syntax in GHC.Profiling Message-ID: <64b15b94cb41_3f5efc41622474100283f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 246c8ba1 by Teo Camarasu at 2023-07-14T10:28:23-04:00 base: fix haddock syntax in GHC.Profiling - - - - - c54a0f0e by Matthew Pickering at 2023-07-14T10:28:24-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 5 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - libraries/base/GHC/Profiling.hs - testsuite/config/ghc - testsuite/driver/testlib.py Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -228,16 +228,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -jsDebug :: BuildConfig -> BuildConfig -jsDebug c = c { bignumBackend = Native - -- make the job a debug job - , buildFlavour = SlowValidate - , withAssertions = True - } - -jsPerf :: BuildConfig -> BuildConfig -jsPerf c = c { bignumBackend = Native } - zstdIpe :: BuildConfig zstdIpe = vanilla { withZstd = True } @@ -935,8 +925,10 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) - , standardBuildsWithConfig Amd64 (Linux Debian11) (jsPerf $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) - , validateBuilds Amd64 (Linux Debian11) (jsDebug $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") + ) + { bignumBackend = Native + } , make_wasm_jobs wasm_build_config , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {bignumBackend = Native} @@ -1011,7 +1003,7 @@ platform_mapping = Map.map go $ hasReleaseBuild (StandardTriple{}) = True hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { _bindistName :: String } +data BindistInfo = BindistInfo { bindistName :: String } instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] @@ -1026,7 +1018,6 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" -write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -1585,71 +1585,6 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "8 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "XZ_OPT": "-9" - } - }, "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3060,73 +2995,6 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "HADRIAN_ARGS": "--hash-unit-ids", - "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "XZ_OPT": "-9" - } - }, "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4777,70 +4645,6 @@ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, - "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "2 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" - } - }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -27,6 +27,7 @@ foreign import ccall startProfTimer :: IO () -- | Request a heap census on the next context switch. The census can be -- requested whether or not the heap profiling timer is running. +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- @@ -34,7 +35,8 @@ foreign import ccall startProfTimer :: IO () foreign import ccall requestHeapCensus :: IO () -- | Start heap profiling. This is called normally by the RTS on start-up, --- but can be disabled using the rts flag `--no-automatic-heap-samples` +-- but can be disabled using the rts flag @--no-automatic-heap-samples at . +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- @@ -42,6 +44,7 @@ foreign import ccall requestHeapCensus :: IO () foreign import ccall startHeapProfTimer :: IO () -- | Stop heap profiling. +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- ===================================== testsuite/config/ghc ===================================== @@ -80,7 +80,6 @@ if not config.arch == "javascript": config.compile_ways.append('hpc') config.run_ways.append('hpc') -# WASM if config.arch == "wasm32": config.have_process = False config.supports_dynamic_libs = False @@ -270,12 +269,7 @@ def get_compiler_info(): config.have_vanilla = compiler_supports_way([]) config.have_dynamic = compiler_supports_way(['-dynamic']) - - # JavaScript doesn't support profiling yet. See #22261 - if config.arch == "javascript": - config.have_profiling = False - else: - config.have_profiling = compiler_supports_way(['-prof']) + config.have_profiling = compiler_supports_way(['-prof']) if config.have_profiling: config.compile_ways.append('profasm') ===================================== testsuite/driver/testlib.py ===================================== @@ -236,11 +236,6 @@ def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: opts.expect = 'fail' - # many profiling tests must be skipped for the JS backend. That is - # because they unexpectedly pass even though the JS backend does not - # support profiling yet. See #22251 - if js_arch(): - js_skip(name, opts) # JS backend doesn't support profiling yet if arch("js"): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/114aee5f7fe1da8cdcc78757ead03aa6d9f78acd...c54a0f0e3d10a73597c037890f4e946052d44a9b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/114aee5f7fe1da8cdcc78757ead03aa6d9f78acd...c54a0f0e3d10a73597c037890f4e946052d44a9b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 15:59:25 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 14 Jul 2023 11:59:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/fixes-3 Message-ID: <64b170dd79f01_3edd85b3e7074281@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/fixes-3 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/fixes-3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 16:57:36 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 14 Jul 2023 12:57:36 -0400 Subject: [Git][ghc/ghc][wip/T22404] Wibbles to efficiency Message-ID: <64b17e80cba84_3edd85b3e5c977d0@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: f15c4107 by Simon Peyton Jones at 2023-07-14T17:57:11+01:00 Wibbles to efficiency Esp simplify occ_join_points - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1677,7 +1677,8 @@ makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> LetrecNode -- See Note [Recursive bindings: the grand plan] makeNode !env imp_rule_edges bndr_set (bndr, rhs) - = DigraphNode { node_payload = details + = -- pprTrace "makeNode" (ppr bndr <+> ppr (sizeVarSet bndr_set)) $ + DigraphNode { node_payload = details , node_key = varUnique bndr , node_dependencies = nonDetKeysUniqSet scope_fvs } -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR @@ -1706,7 +1707,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) inl_fvs = udFreeVars bndr_set unadj_inl_uds -- inl_fvs: vars that would become free if the function was inlined. - -- We conservatively approximate that by thefree vars from the RHS + -- We conservatively approximate that by the free vars from the RHS -- and the unfolding together. -- See Note [inl_fvs] @@ -2475,7 +2476,7 @@ occAnal env (Tick tickish body) = WUD (markAllNonTail usage) (Tick tickish body') | Breakpoint _ _ ids _ <- tickish - = WUD (usage_lam `andUDs` foldl' addManyOccId emptyDetails ids) (Tick tickish body') + = WUD (addManyOccs usage_lam (mkVarSet ids)) (Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise @@ -2786,7 +2787,7 @@ data OccEnv -- Vars (TyVars and Ids) free in the range of occ_bs_env -- Usage details of the RHS of in-scope non-recursive join points - , occ_join_points :: !(IdEnv UsageDetails) + , occ_join_points :: !(IdEnv OccInfoEnv) -- Invariant: no Id maps to emptyDetails } @@ -2870,7 +2871,7 @@ setNonTailCtxt ctxt !env -- emptyDetails, which in turn causes a panic in mkOneOcc #ifdef DEBUG zapped_jp_env - = mapVarEnv (\ _ -> emptyDetails) $ + = mapVarEnv (\ _ -> emptyVarEnv) $ occ_join_points env #else zapped_jp_env = emptyVarEnv @@ -2938,22 +2939,25 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points with_co_var_occs = trimmed_uds `addManyOccs` coVarOccs bndrs add_bad_joins :: WithUsageDetails a -> WithUsageDetails a - -- Add usage infor for occ_join_points that we cannot push inwards + -- Add usage info for occ_join_points that we cannot push inwardsa -- because of shadowing - add_bad_joins wuds@(WUD uds res) - | isEmptyVarEnv bad_joins -- Fast path for common case - = wuds - | otherwise - = WUD (nonDetStrictFoldUFM_Directly add_bad_join uds bad_joins) res - - add_bad_join :: Unique -> UsageDetails -- Bad join and its usage details - -> UsageDetails -> UsageDetails -- See Note [Occurrence analysis for join points] wrinkle (W2) - add_bad_join uniq bad_join_uds uds - | uniq `elemUFM_Directly` ud_env uds = uds `andUDs` bad_join_uds - | otherwise = uds + add_bad_joins wuds@(WUD body_uds res) + | isEmptyVarEnv bad_joins = wuds -- Fast path for common case + | otherwise = WUD (modifyUDEnv extend_with_bad_joins body_uds) res + where + bad_joins :: IdEnv OccInfoEnv + bad_joins = join_points -- All of them, for simplicity + + extend_with_bad_joins :: OccInfoEnv -> OccInfoEnv + extend_with_bad_joins env + = nonDetStrictFoldUFM_Directly add_bad_join env bad_joins + + add_bad_join :: Unique -> OccInfoEnv -> OccInfoEnv -> OccInfoEnv + add_bad_join uniq join_env env + | uniq `elemVarEnvByKey` env = env `plusVarEnv` join_env + | otherwise = env - bad_joins = join_points {- bad_joins, good_joins :: IdEnv UsageDetails (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points @@ -2964,17 +2968,19 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv addJoinPoint env bndr rhs_uds - | isEmptyDetails zeroed_form + | isEmptyVarEnv zeroed_form = env | otherwise = env { occ_join_points = extendVarEnv (occ_join_points env) bndr zeroed_form } where zeroed_form = mkZeroedForm rhs_uds -mkZeroedForm :: UsageDetails -> UsageDetails +mkZeroedForm :: UsageDetails -> OccInfoEnv -- See Note [Occurrence analysis for join points] for "zeroed form" +--mkZeroedForm EmptyUDs +-- = emptyVarEnv mkZeroedForm (UD { ud_env = rhs_occs }) - = emptyDetails { ud_env = mapMaybeUFM do_one rhs_occs } + = mapMaybeUFM do_one rhs_occs where do_one :: LocalOcc -> Maybe LocalOcc do_one (ManyOccL {}) = Nothing @@ -3428,12 +3434,15 @@ data UsageDetails , ud_z_tail :: !ZappedSet } -- INVARIANT: All three zapped sets are subsets of ud_env +-- | EmptyUDs instance Outputable UsageDetails where - ppr ud = text "UD" <+> (braces $ fsep $ punctuate comma $ - [ ppr uq <+> text ":->" <+> ppr (mkOccInfoByUnique ud uq local_occ) - | (uq, local_occ) <- nonDetStrictFoldVarEnv_Directly do_one [] (ud_env ud) ]) - $$ nest 2 (text "ud_z_tail" <+> ppr (ud_z_tail ud)) +-- ppr EmptyUDs = text "EmptyUDs" + ppr ud@(UD { ud_env = env, ud_z_tail = z_tail }) + = text "UD" <+> (braces $ fsep $ punctuate comma $ + [ ppr uq <+> text ":->" <+> ppr (mkOccInfoByUnique ud uq) + | (uq, _) <- nonDetStrictFoldVarEnv_Directly do_one [] env ]) + $$ nest 2 (text "ud_z_tail" <+> ppr z_tail) where do_one :: Unique -> LocalOcc -> [(Unique,LocalOcc)] -> [(Unique,LocalOcc)] do_one uniq occ occs = (uniq, occ) : occs @@ -3470,26 +3479,20 @@ mkOneOcc !env id int_cxt arity | Just join_uds <- lookupVarEnv (occ_join_points env) id = -- pprTrace "mkOneOcc" (ppr id $$ ppr uds) $ - assertPpr (not (isEmptyDetails join_uds)) (ppr id) $ - one_occ_uds `andUDs` join_uds + assertPpr (not (isEmptyVarEnv join_uds)) (ppr id) $ + mkSimpleDetails (extendVarEnv join_uds id occ) | otherwise - = one_occ_uds + = mkSimpleDetails (unitVarEnv id occ) where occ = OneOccL { lo_n_br = 1, lo_int_cxt = int_cxt , lo_tail = AlwaysTailCalled arity } - one_occ_uds = emptyDetails { ud_env = unitVarEnv id occ } - -addManyOccId :: UsageDetails -> Id -> UsageDetails --- Add the non-committal (id :-> noOccInfo) to the usage details -addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id - (ManyOccL NoTailCallInfo) } -- Add several occurrences, assumed not to be tail calls -addManyOcc :: Var -> UsageDetails -> UsageDetails -addManyOcc v u | isId v = addManyOccId u v - | otherwise = u +add_many_occ :: Var -> OccInfoEnv -> OccInfoEnv +add_many_occ v env | isId v = extendVarEnv env v (ManyOccL NoTailCallInfo) + | otherwise = env -- Give a non-committal binder info (i.e noOccInfo) because -- a) Many copies of the specialised thing can appear -- b) We don't want to substitute a BIG expression inside a RULE @@ -3497,8 +3500,14 @@ addManyOcc v u | isId v = addManyOccId u v -- (Same goes for INLINE.) addManyOccs :: UsageDetails -> VarSet -> UsageDetails -addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set - -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes +addManyOccs uds var_set + | isEmptyVarSet var_set = uds + | otherwise = case uds of +-- EmptyUDs -> mkSimpleDetails (add_to emptyVarEnv) + UD { ud_env = env } -> uds { ud_env = add_to env } + where + add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set + -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes coVarOccs :: [Var] -> VarSet -- Add any CoVars free in the types of a telescope of lambda-binders @@ -3510,16 +3519,33 @@ coVarOccs bndrs coVarsOfType (varType bndr) emptyDetails :: UsageDetails +--emptyDetails = EmptyUDs +emptyDetails = mkSimpleDetails emptyVarEnv + +mkSimpleDetails :: OccInfoEnv -> UsageDetails +mkSimpleDetails env = UD { ud_env = env + , ud_z_many = emptyVarEnv + , ud_z_in_lam = emptyVarEnv + , ud_z_tail = emptyVarEnv } + +modifyUDEnv :: (OccInfoEnv -> OccInfoEnv) -> UsageDetails -> UsageDetails +-- modifyUDEnv f EmptyUDs = mkSimpleDetails (f emptyVarEnv) +modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env } + +{- emptyDetails = UD { ud_env = emptyVarEnv , ud_z_many = emptyVarEnv , ud_z_in_lam = emptyVarEnv , ud_z_tail = emptyVarEnv } +-} isEmptyDetails :: UsageDetails -> Bool -isEmptyDetails = isEmptyVarEnv . ud_env +--isEmptyDetails EmptyUDs = True +isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env delDetails :: UsageDetails -> [Id] -> UsageDetails -- Delete these binders from the UsageDetails +-- delDetails EmptyUDs _ = EmptyUDs delDetails (UD { ud_env = env , ud_z_many = z_many , ud_z_in_lam = z_in_lam @@ -3531,10 +3557,16 @@ delDetails (UD { ud_env = env markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails +--markAllMany EmptyUDs = EmptyUDs markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env } + +--markAllInsideLam EmptyUDs = EmptyUDs markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env } + +--markAllNonTail EmptyUDs = EmptyUDs markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env } -markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo + +markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3545,28 +3577,32 @@ markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud lookupLocalDetails :: UsageDetails -> Id -> Maybe LocalOcc -lookupLocalDetails uds id = lookupVarEnv (ud_env uds) id +--lookupLocalDetails EmptyUDs _ = Nothing +lookupLocalDetails (UD { ud_env = env }) id = lookupVarEnv env id lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo lookupTailCallInfo uds id - | not (id `elemVarEnv` ud_z_tail uds) - , Just occ <- lookupLocalDetails uds id + | UD { ud_z_tail = z_tail, ud_env = env } <- uds + , not (id `elemVarEnv` z_tail) + , Just occ <- lookupVarEnv env id = localTailCallInfo occ | otherwise = NoTailCallInfo lookupDetails :: UsageDetails -> Id -> OccInfo -lookupDetails ud id - = case lookupLocalDetails ud id of - Just occ -> mkOccInfo ud id occ - Nothing -> IAmDead +lookupDetails ud id = mkOccInfoByUnique ud (idUnique id) usedIn :: Id -> UsageDetails -> Bool -v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud +v `usedIn` uds + | isExportedId v = True + | otherwise = case uds of +-- EmptyUDs -> False + UD { ud_env = env } -> v `elemVarEnv` env udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds -udFreeVars bndrs ud = restrictFreeVars bndrs (ud_env ud) +-- udFreeVars _ EmptyUDs = emptyVarSet +udFreeVars bndrs (UD { ud_env = env }) = restrictFreeVars bndrs env restrictFreeVars :: VarSet -> OccInfoEnv -> VarSet restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs @@ -3576,26 +3612,32 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails -combineUsageDetailsWith plus_occ_info ud1 ud2 - | isEmptyDetails ud1 = ud2 - | isEmptyDetails ud2 = ud1 +{-# INLINE combineUsageDetailsWith #-} +--combineUsageDetailsWith _ EmptyUDs ud2 = ud2 +-- combineUsageDetailsWith _ ud1 EmptyUDs = ud1 +combineUsageDetailsWith plus_occ_info + uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) + uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) + | isEmptyVarEnv env1 = uds2 + | isEmptyVarEnv env2 = uds1 | otherwise - = UD { ud_env = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2) - , ud_z_many = plusVarEnv (ud_z_many ud1) (ud_z_many ud2) - , ud_z_in_lam = plusVarEnv (ud_z_in_lam ud1) (ud_z_in_lam ud2) - , ud_z_tail = plusVarEnv (ud_z_tail ud1) (ud_z_tail ud2) } - -mkOccInfo :: UsageDetails -> Var -> LocalOcc -> OccInfo -mkOccInfo ud var occ = mkOccInfoByUnique ud (varUnique var) occ - -mkOccInfoByUnique :: UsageDetails -> Unique -> LocalOcc -> OccInfo -mkOccInfoByUnique (UD { ud_z_many = z_many + = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = plusVarEnv z_many1 z_many2 + , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 + , ud_z_tail = plusVarEnv z_tail1 z_tail2 } + +mkOccInfoByUnique :: UsageDetails -> Unique -> OccInfo +--mkOccInfoByUnique EmptyUDs _ +-- = IAmDead +mkOccInfoByUnique (UD { ud_env = env + , ud_z_many = z_many , ud_z_in_lam = z_in_lam , ud_z_tail = z_tail }) - uniq occ - = case occ of - OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt - , lo_tail = tail_info } + uniq + = case lookupVarEnv_Directly env uniq of + Nothing -> IAmDead + Just (OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt + , lo_tail = tail_info }) | uniq `elemVarEnvByKey`z_many -> ManyOccs { occ_tail = mk_tail_info tail_info } | otherwise @@ -3607,7 +3649,7 @@ mkOccInfoByUnique (UD { ud_z_many = z_many in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam | otherwise = NotInsideLam - ManyOccL tail_info -> ManyOccs { occ_tail = mk_tail_info tail_info } + Just (ManyOccL tail_info) -> ManyOccs { occ_tail = mk_tail_info tail_info } where mk_tail_info ti | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f15c4107927bd578af992c35fd9a8086482dd290 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f15c4107927bd578af992c35fd9a8086482dd290 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 20:07:55 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 14 Jul 2023 16:07:55 -0400 Subject: [Git][ghc/ghc][wip/supersven/imulMayOflo_x86] Add test for %mulmayoflo primop Message-ID: <64b1ab1bac22e_3edd85b3eac1171df@gitlab.mail> Sven Tennie pushed to branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC Commits: a68af544 by Sven Tennie at 2023-07-14T22:06:45+02:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 4 changed files: - compiler/GHC/Cmm/MachOp.hs - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -56,6 +56,25 @@ Note that there are variety of places in the native code generator where we assume that the code produced for a MachOp does not introduce new blocks. -} +-- Note [MO_S_MulMayOflo significant width] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- There are two interpretations in the code about what a multiplication +-- overflow exactly means: +-- +-- 1. The result does not fit into the specified width (of type Width.) +-- 2. The result does not fit into a register. +-- +-- (2) has some flaws: A following MO_Mul has a width, too. So MO_S_MulMayOflo +-- may signal no overflow, while MO_Mul truncates the result. There are +-- architectures with several register widths and it might be hard to decide +-- what's an overflow and what not. Both attributes can easily lead to subtle +-- bugs. +-- +-- (1) has the benefit that its interpretation is completely independent of the +-- architecture. So, the mid-term plan is to migrate to this +-- interpretation/sematics. + data MachOp -- Integer operations (insensitive to signed/unsigned) = MO_Add Width @@ -65,7 +84,8 @@ data MachOp | MO_Mul Width -- low word of multiply -- Signed multiply/divide - | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows + | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows. See + -- Note [MO_S_MulMayOflo significant width] | MO_S_Quot Width -- signed / (same semantics as IntQuotOp) | MO_S_Rem Width -- signed % (same semantics as IntRemOp) | MO_S_Neg Width -- unary - ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +{- + N.B. the contract of '%mulmayoflo' is a bit weak: "Return non-zero if there is + any possibility that the signed multiply of a and b might overflow. Return zero + only if you are absolutely sure that it won't overflow. If in doubt, return + non-zero." (Stg.h) + +This test verifies the a stronger contract: It's expected that there are no +false positives. This requirement is e.g. met by code generation backends which +execute the multiplication to check for overflow. +-} + +module Main where + +import GHC.Exts + +-- The argument and return types are unimportant: They're only used to force +-- evaluation, but carry no information. +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm ===================================== @@ -0,0 +1,98 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,16 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) + +# TODO: Enable more architectures here. N.B. some code generation backends are +# not implemeted correctly (according to +# Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. +test('MulMayOflo_full', + [ extra_files(['MulMayOflo.hs']), + when(unregisterised(), skip), + unless(arch('x86_64') or arch('i386') + or arch('powerpc') or arch('powerpc64'), + skip), + ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a68af544d9e57c23ea6e374144404a6ee6d08479 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a68af544d9e57c23ea6e374144404a6ee6d08479 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 20:13:34 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 14 Jul 2023 16:13:34 -0400 Subject: [Git][ghc/ghc][wip/supersven/imulMayOflo_x86] 118 commits: Propagate breakpoint information when inlining across modules Message-ID: <64b1ac6e98f80_3edd85b3f4c119913@gitlab.mail> Sven Tennie pushed to branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - 49264402 by Sven Tennie at 2023-07-14T22:12:00+02:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 053b902a by Sven Tennie at 2023-07-14T22:12:00+02:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - 5d652bc3 by Sven Tennie at 2023-07-14T22:12:00+02:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a2e82c06 by Sven Tennie at 2023-07-14T22:13:14+02:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a68af544d9e57c23ea6e374144404a6ee6d08479...a2e82c068809b1e67c99d8315edda6c69c2ff05b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a68af544d9e57c23ea6e374144404a6ee6d08479...a2e82c068809b1e67c99d8315edda6c69c2ff05b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 20:29:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 14 Jul 2023 16:29:18 -0400 Subject: [Git][ghc/ghc][master] base: fix haddock syntax in GHC.Profiling Message-ID: <64b1b01e6853d_3edd85b3fb01253a9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 1 changed file: - libraries/base/GHC/Profiling.hs Changes: ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -27,6 +27,7 @@ foreign import ccall startProfTimer :: IO () -- | Request a heap census on the next context switch. The census can be -- requested whether or not the heap profiling timer is running. +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- @@ -34,7 +35,8 @@ foreign import ccall startProfTimer :: IO () foreign import ccall requestHeapCensus :: IO () -- | Start heap profiling. This is called normally by the RTS on start-up, --- but can be disabled using the rts flag `--no-automatic-heap-samples` +-- but can be disabled using the rts flag @--no-automatic-heap-samples at . +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- @@ -42,6 +44,7 @@ foreign import ccall requestHeapCensus :: IO () foreign import ccall startHeapProfTimer :: IO () -- | Stop heap profiling. +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e10556b6dc5a04b36cd1f28bbcc16a346895ebac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e10556b6dc5a04b36cd1f28bbcc16a346895ebac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 20:29:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 14 Jul 2023 16:29:46 -0400 Subject: [Git][ghc/ghc][master] Revert "CI: add JS release and debug builds, regen CI jobs" Message-ID: <64b1b03ac4517_3edd85b3fb0128531@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 4 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - testsuite/config/ghc - testsuite/driver/testlib.py Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -228,16 +228,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -jsDebug :: BuildConfig -> BuildConfig -jsDebug c = c { bignumBackend = Native - -- make the job a debug job - , buildFlavour = SlowValidate - , withAssertions = True - } - -jsPerf :: BuildConfig -> BuildConfig -jsPerf c = c { bignumBackend = Native } - zstdIpe :: BuildConfig zstdIpe = vanilla { withZstd = True } @@ -935,8 +925,10 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) - , standardBuildsWithConfig Amd64 (Linux Debian11) (jsPerf $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) - , validateBuilds Amd64 (Linux Debian11) (jsDebug $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") + ) + { bignumBackend = Native + } , make_wasm_jobs wasm_build_config , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {bignumBackend = Native} @@ -1011,7 +1003,7 @@ platform_mapping = Map.map go $ hasReleaseBuild (StandardTriple{}) = True hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { _bindistName :: String } +data BindistInfo = BindistInfo { bindistName :: String } instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] @@ -1026,7 +1018,6 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" -write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -1585,71 +1585,6 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "8 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "XZ_OPT": "-9" - } - }, "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3060,73 +2995,6 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "HADRIAN_ARGS": "--hash-unit-ids", - "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "XZ_OPT": "-9" - } - }, "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4777,70 +4645,6 @@ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, - "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "2 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" - } - }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== testsuite/config/ghc ===================================== @@ -80,7 +80,6 @@ if not config.arch == "javascript": config.compile_ways.append('hpc') config.run_ways.append('hpc') -# WASM if config.arch == "wasm32": config.have_process = False config.supports_dynamic_libs = False @@ -270,12 +269,7 @@ def get_compiler_info(): config.have_vanilla = compiler_supports_way([]) config.have_dynamic = compiler_supports_way(['-dynamic']) - - # JavaScript doesn't support profiling yet. See #22261 - if config.arch == "javascript": - config.have_profiling = False - else: - config.have_profiling = compiler_supports_way(['-prof']) + config.have_profiling = compiler_supports_way(['-prof']) if config.have_profiling: config.compile_ways.append('profasm') ===================================== testsuite/driver/testlib.py ===================================== @@ -236,11 +236,6 @@ def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: opts.expect = 'fail' - # many profiling tests must be skipped for the JS backend. That is - # because they unexpectedly pass even though the JS backend does not - # support profiling yet. See #22251 - if js_arch(): - js_skip(name, opts) # JS backend doesn't support profiling yet if arch("js"): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f3fda8179883048a2299c9c448bcfbc94fbb7ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f3fda8179883048a2299c9c448bcfbc94fbb7ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 21:01:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 14 Jul 2023 17:01:11 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: base: fix haddock syntax in GHC.Profiling Message-ID: <64b1b7975301b_3edd85b3f381364cc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - bee48d7f by Alan Zimmerman at 2023-07-14T17:00:50-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 8c6f1f9a by sheaf at 2023-07-14T17:00:57-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - 7 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Parser.y - libraries/base/GHC/Profiling.hs - m4/find_python.m4 - testsuite/config/ghc - testsuite/driver/testlib.py Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -228,16 +228,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -jsDebug :: BuildConfig -> BuildConfig -jsDebug c = c { bignumBackend = Native - -- make the job a debug job - , buildFlavour = SlowValidate - , withAssertions = True - } - -jsPerf :: BuildConfig -> BuildConfig -jsPerf c = c { bignumBackend = Native } - zstdIpe :: BuildConfig zstdIpe = vanilla { withZstd = True } @@ -935,8 +925,10 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla)) , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))) , validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing) - , standardBuildsWithConfig Amd64 (Linux Debian11) (jsPerf $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) - , validateBuilds Amd64 (Linux Debian11) (jsDebug $ crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")) + , validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure") + ) + { bignumBackend = Native + } , make_wasm_jobs wasm_build_config , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {bignumBackend = Native} @@ -1011,7 +1003,7 @@ platform_mapping = Map.map go $ hasReleaseBuild (StandardTriple{}) = True hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { _bindistName :: String } +data BindistInfo = BindistInfo { bindistName :: String } instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] @@ -1026,7 +1018,6 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" -write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -1585,71 +1585,6 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "8 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "XZ_OPT": "-9" - } - }, "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -3060,73 +2995,6 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "HADRIAN_ARGS": "--hash-unit-ids", - "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-release", - "XZ_OPT": "-9" - } - }, "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4777,70 +4645,6 @@ "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, - "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh save_test_output", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "2 weeks", - "paths": [ - "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate.tar.xz", - "junit.xml", - "unexpected-test-output.tar.gz" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate", - "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "--with-intree-gmp", - "CONFIGURE_WRAPPER": "emconfigure", - "CROSS_EMULATOR": "js-emulator", - "CROSS_TARGET": "javascript-unknown-ghcjs", - "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-slow-validate" - } - }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== compiler/GHC/Parser.y ===================================== @@ -804,12 +804,12 @@ msubsts :: { OrdList (LHsModuleSubst PackageName) } | msubst { unitOL $1 } msubst :: { LHsModuleSubst PackageName } - : modid '=' moduleid { sLL (reLoc $1) $> $ (reLoc $1, $3) } - | modid VARSYM modid VARSYM { sLL (reLoc $1) $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } + : modid '=' moduleid { sLL $1 $> $ (reLoc $1, $3) } + | modid VARSYM modid VARSYM { sLL $1 $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } moduleid :: { LHsModuleId PackageName } : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar (reLoc $2) } - | unitid ':' modid { sLL $1 (reLoc $>) $ HsModuleId $1 (reLoc $3) } + | unitid ':' modid { sLL $1 $> $ HsModuleId $1 (reLoc $3) } pkgname :: { Located PackageName } : STRING { sL1 $1 $ PackageName (getSTRING $1) } @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL (reLoc $1) (reLoc $>) $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1168,7 +1168,7 @@ optqualified :: { Located (Maybe EpaLocation) } maybeas :: { (Maybe EpaLocation,Located (Maybe (LocatedA ModuleName))) } : 'as' modid { (Just (glAA $1) - ,sLL $1 (reLoc $>) (Just $2)) } + ,sLL $1 $> (Just $2)) } | {- empty -} { (Nothing,noLoc Nothing) } maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])) } @@ -1209,9 +1209,9 @@ importlist1 :: { OrdList (LIE GhcPs) } | import { $1 } import :: { OrdList (LIE GhcPs) } - : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL (reLoc $1) $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } - | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 (reLocN $>) $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } + | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1230,7 +1230,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } : ops ',' op {% case (unLoc $1) of SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) - return (sLL $1 (reLocN $>) (snocOL hs t' `appOL` unitOL $3)) } + return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } | op { sL1N $1 (unitOL $1) } ----------------------------------------------------------------------------- @@ -1357,7 +1357,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order {% case unLoc $1 of (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | oqtycon { sL1N $1 [$1] } inst_decl :: { LInstDecl GhcPs } @@ -1415,7 +1415,7 @@ deriv_strategy_no_via :: { LDerivStrategy GhcPs } | 'newtype' {% acsA (\cs -> sL1 $1 (NewtypeStrategy (EpAnn (glR $1) [mj AnnNewtype $1] cs))) } deriv_strategy_via :: { LDerivStrategy GhcPs } - : 'via' sigktype {% acsA (\cs -> sLLlA $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) + : 'via' sigktype {% acsA (\cs -> sLL $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) $2))) } deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } @@ -1429,15 +1429,15 @@ deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) } : {- empty -} { noLoc ([], Nothing) } - | '|' injectivity_cond { sLL $1 (reLoc $>) ([mj AnnVbar $1] + | '|' injectivity_cond { sLL $1 $> ([mj AnnVbar $1] , Just ($2)) } injectivity_cond :: { LInjectivityAnn GhcPs } : tyvarid '->' inj_varids - {% acsA (\cs -> sLL (reLocN $1) $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } + {% acsA (\cs -> sLL $1 $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } inj_varids :: { Located [LocatedN RdrName] } - : inj_varids tyvarid { sLL $1 (reLocN $>) ($2 : unLoc $1) } + : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } | tyvarid { sL1N $1 [$1] } -- Closed type families @@ -1462,16 +1462,16 @@ ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] } : ty_fam_inst_eqns ';' ty_fam_inst_eqn {% let (L loc eqn) = $3 in case unLoc $1 of - [] -> return (sLLlA $1 $> (L loc eqn : unLoc $1)) + [] -> return (sLL $1 $> (L loc eqn : unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLLlA $1 $> ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | ty_fam_inst_eqns ';' {% case unLoc $1 of [] -> return (sLL $1 $> (unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | ty_fam_inst_eqn { sLLAA $1 $> [$1] } + | ty_fam_inst_eqn { sLL $1 $> [$1] } | {- empty -} { noLoc [] } ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } @@ -1572,26 +1572,26 @@ data_or_newtype :: { Located (AddEpAnn, NewOrData) } opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } : { noLoc ([] , Nothing) } - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], Just $2) } + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } - | '::' kind { sLL $1 (reLoc $>) ( [mu AnnDcolon $1] + | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1, mj AnnVbar $3] + ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, @@ -1602,14 +1602,14 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- T Int [a] -- for associated types -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } - : context '=>' type {% acs (\cs -> (sLLAA $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } + : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } | type { sL1A $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 >> fromSpecTyVarBndrs $2 >>= \tvbs -> - (acs (\cs -> (sLL $1 (reLoc $>) + (acs (\cs -> (sLL $1 $> (Just ( addTrailingDarrowC $4 $5 cs) , mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6)))) } @@ -1619,7 +1619,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; cs <- getCommentsFor loc ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } - | context '=>' type {% acs (\cs -> (sLLAA $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } + | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } @@ -1643,7 +1643,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type {% do { let { err = text "in the stand-alone deriving instance" <> colon <+> quotes (ppr $5) } - ; acsA (\cs -> sLL $1 (reLoc $>) + ; acsA (\cs -> sLL $1 $> (DerivDecl (EpAnn (glR $1) [mj AnnDeriving $1, mj AnnInstance $3] cs) (mkHsWildCardBndrs $5) $2 $4)) }} ----------------------------------------------------------------------------- @@ -1674,19 +1674,19 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl GhcPs } : 'pattern' pattern_synonym_lhs '=' pat {% let (name, args, as ) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 ImplicitBidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1, mj AnnEqual $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat {% let (name, args, as) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 Unidirectional + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat where_decls {% do { let (name, args, as) = $2 ; mg <- mkPatSynMatchGroup name $5 - ; acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ + ; acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 (ExplicitBidirectional mg) (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) }} @@ -1713,7 +1713,7 @@ where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype - {% acsA (\cs -> sLL $1 (reLoc $>) + {% acsA (\cs -> sLL $1 $> $ PatSynSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnPattern $1]) cs) (toList $ unLoc $2) $4) } @@ -1736,16 +1736,16 @@ decl_cls : at_decl_cls { $1 } do { v <- checkValSigLhs $2 ; let err = text "in default signature" <> colon <+> quotes (ppr $2) - ; acsA (\cs -> sLL $1 (reLoc $>) $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do t' <- addTrailingSemiA t (gl $2) - return (sLLlA $1 $> (fst $ unLoc $1 + return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t' `appOL` unitOL $3)) } | decls_cls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> ( (fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -1824,7 +1824,7 @@ where_inst :: { Located ([AddEpAnn] -- decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } : decls ';' decl {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1833,7 +1833,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } rest = snocOL hs t'; these = rest `appOL` this } return (rest `seq` this `seq` these `seq` - (sLLlA $1 $> (fst $ unLoc $1, these))) } + (sLL $1 $> (fst $ unLoc $1, these))) } | decls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2) ,snd $ unLoc $1))) @@ -1896,7 +1896,7 @@ rule :: { LRuleDecl GhcPs } : STRING rule_activation rule_foralls infixexp '=' exp {%runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acsA (\cs -> (sLLlA $1 $> $ HsRule + acsA (\cs -> (sLL $1 $> $ HsRule { rd_ext = (EpAnn (glR $1) ((fstOf3 $3) (mj AnnEqual $5 : (fst $2))) cs, getSTRINGs $1) , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRING $1) , rd_act = (snd $2) `orElse` AlwaysActive @@ -2103,10 +2103,10 @@ safety :: { Located Safety } fspec :: { Located ([AddEpAnn] ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)) } - : STRING var '::' sigtype { sLL $1 (reLoc $>) ([mu AnnDcolon $3] + : STRING var '::' sigtype { sLL $1 $> ([mu AnnDcolon $3] ,(L (getLoc $1) (getStringLiteral $1), $2, $4)) } - | var '::' sigtype { sLL (reLocN $1) (reLoc $>) ([mu AnnDcolon $2] + | var '::' sigtype { sLL $1 $> ([mu AnnDcolon $2] ,(noLoc (StringLiteral NoSourceText nilFS Nothing), $1, $3)) } -- if the entity string is missing, it defaults to the empty string; -- the meaning of an empty entity string depends on the calling @@ -2127,8 +2127,8 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } -- See Note [forall-or-nothing rule] in GHC.Hs.Type. sigktype :: { LHsSigType GhcPs } : sigtype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ + sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2139,10 +2139,10 @@ sigtype :: { LHsSigType GhcPs } sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order : sig_vars ',' var {% case unLoc $1 of - [] -> return (sLL $1 (reLocN $>) ($3 : unLoc $1)) + [] -> return (sLL $1 $> ($3 : unLoc $1)) (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | var { sL1N $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } @@ -2168,7 +2168,7 @@ forall_telescope :: { Located (HsForAllTelescope GhcPs) } -- A ktype is a ctype, possibly with a kind annotation ktype :: { LHsType GhcPs } : ctype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- A ctype is a for-all type ctype :: { LHsType GhcPs } @@ -2176,12 +2176,12 @@ ctype :: { LHsType GhcPs } HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } - | context '=>' ctype {% acsA (\cs -> (sLL (reLoc $1) (reLoc $>) $ + | context '=>' ctype {% acsA (\cs -> (sLL $1 $> $ HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs , hst_xqual = NoExtField , hst_body = $3 })) } - | ipvar '::' ctype {% acsA (\cs -> sLL $1 (reLoc $>) (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } + | ipvar '::' ctype {% acsA (\cs -> sLL $1 $> (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } | type { $1 } ---------------------- @@ -2213,21 +2213,21 @@ is connected to the first type too. type :: { LHsType GhcPs } -- See Note [%shift: type -> btype] : btype %shift { $1 } - | btype '->' ctype {% acsA (\cs -> sLL (reLoc $1) (reLoc $>) + | btype '->' ctype {% acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsUnrestrictedArrow (hsUniTok $2)) $1 $3) } | btype mult '->' ctype {% hintLinear (getLoc $2) >> let arr = (unLoc $2) (hsUniTok $3) - in acsA (\cs -> sLL (reLoc $1) (reLoc $>) + in acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) arr $1 $4) } | btype '->.' ctype {% hintLinear (getLoc $2) >> - acsA (\cs -> sLL (reLoc $1) (reLoc $>) + acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsLinearArrow (HsLolly (hsTok $2))) $1 $3) } -- [mu AnnLollyU $2] } mult :: { Located (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs) } - : PREFIX_PERCENT atype { sLL $1 (reLoc $>) (mkMultTy (hsTok $1) $2) } + : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy (hsTok $1) $2) } btype :: { LHsType GhcPs } : infixtype {% runPV $1 } @@ -2258,10 +2258,10 @@ tyarg :: { LHsType GhcPs } tyop :: { (LocatedN RdrName, PromotionFlag) } : qtyconop { ($1, NotPromoted) } | tyvarop { ($1, NotPromoted) } - | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } - | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } @@ -2273,8 +2273,8 @@ atype :: { LHsType GhcPs } ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer - | PREFIX_TILDE atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } - | PREFIX_BANG atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } + | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } + | PREFIX_BANG atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } | '{' fielddecls '}' {% do { decls <- acsA (\cs -> (sLL $1 $> $ HsRecTy (EpAnn (glR $1) (AnnList (Just $ listAsAnchor $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) $2)) ; checkRecordSyntax decls }} @@ -2292,12 +2292,12 @@ atype :: { LHsType GhcPs } | quasiquote { mapLocA (HsSpliceTy noExtField) $1 } | splice_untyped { mapLocA (HsSpliceTy noExtField) $1 } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } | SIMPLEQUOTE '(' ktype ',' comma_types1 ')' {% do { h <- addTrailingCommaA $3 (gl $4) ; acsA (\cs -> sLL $1 $> $ HsExplicitTupleTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mop $2,mcp $6] cs) (h : $5)) }} | SIMPLEQUOTE '[' comma_types0 ']' {% acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mos $2,mcs $4] cs) IsPromoted $3) } - | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } -- Two or more [ty, ty, ty] must be a promoted list type, just as -- if you had written '[ty, ty, ty] @@ -2366,7 +2366,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } : fds1 ',' fd {% do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | fd { sL1A $1 [$1] } fd :: { LHsFunDep GhcPs } @@ -2377,7 +2377,7 @@ fd :: { LHsFunDep GhcPs } varids0 :: { Located [LocatedN RdrName] } : {- empty -} { noLoc [] } - | varids0 tyvar { sLL $1 (reLocN $>) ($2 : (unLoc $1)) } + | varids0 tyvar { sLL $1 $> ($2 : (unLoc $1)) } ----------------------------------------------------------------------------- -- Kinds @@ -2464,7 +2464,7 @@ constrs1 :: { Located [LConDecl GhcPs] } : constrs1 '|' constr {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | constr { sL1A $1 [$1] } constr :: { LConDecl GhcPs } @@ -2518,7 +2518,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } - : derivings deriving { sLL $1 (reLoc $>) ($2 : unLoc $1) } -- AZ: order? + : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? | deriving { sL1 (reLoc $>) [$1] } -- The outer Located is just to allow the caller to @@ -2603,7 +2603,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } (GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }} gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } - : gdrhs gdrh { sLL $1 (reLoc $>) ($2 : unLoc $1) } + : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } | gdrh { sL1 (reLoc $1) [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } @@ -2616,14 +2616,14 @@ sigdecl :: { LHsDecl GhcPs } infixexp '::' sigtype {% do { $1 <- runPV (unECP $1) ; v <- checkValSigLhs $1 - ; acsA (\cs -> (sLLAl $1 (reLoc $>) $ SigD noExtField $ + ; acsA (\cs -> (sLL $1 $> $ SigD noExtField $ TypeSig (EpAnn (glAR $1) (AnnSig (mu AnnDcolon $2) []) cs) [v] (mkHsWildCardBndrs $3)))} } | var ',' sig_vars '::' sigtype {% do { v <- addTrailingCommaN $1 (gl $2) ; let sig cs = TypeSig (EpAnn (glNR $1) (AnnSig (mu AnnDcolon $4) []) cs) (v : reverse (unLoc $3)) (mkHsWildCardBndrs $5) - ; acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ SigD noExtField (sig cs) ) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField (sig cs) ) }} | infix prec ops {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $3 @@ -2717,22 +2717,22 @@ exp :: { ECP } | infixexp '-<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 HsFirstOrderApp True) } | infixexp '>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 HsFirstOrderApp False) } | infixexp '-<<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 HsHigherOrderApp True) } | infixexp '>>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 HsHigherOrderApp False) } -- See Note [%shift: exp -> infixexp] | infixexp %shift { $1 } @@ -2758,7 +2758,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLLlA $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2845,7 +2845,7 @@ fexp :: { ECP } | 'static' aexp {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 (reLoc $>) $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } + acsA (\cs -> sLL $1 $> $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } | aexp { $1 } @@ -2872,8 +2872,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLLlA $1 $> - [reLocA $ sLLlA $1 $> + (reLocA $ sLL $1 $> + [reLocA $ sLL $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2929,7 +2929,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLLlA $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -3000,10 +3000,10 @@ aexp2 :: { ECP } | splice_untyped { ECP $ pvA $ mkHsSplicePV $1 } | splice_typed { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLocA $1) } - | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } - | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } -- See Note [%shift: aexp2 -> TH_TY_QUOTE] | TH_TY_QUOTE %shift {% reportEmptyDoubleQuotes (getLoc $1) } | '[|' exp '|]' {% runPV (unECP $2) >>= \ $2 -> @@ -3032,8 +3032,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3042,13 +3042,13 @@ splice_exp :: { LHsExpr GhcPs } splice_untyped :: { Located (HsUntypedSplice GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } + acs (\cs -> sLL $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } splice_typed :: { Located ((EpAnnCO, EpAnn [AddEpAnn]), LHsExpr GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } + acs (\cs -> sLL $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } cmdargs :: { [LHsCmdTop GhcPs] } : cmdargs acmd { $2 : $1 } @@ -3093,7 +3093,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL (reLoc $1) (reLocN $>) $ SectionL noAnn $1 (n2l $2) } + reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3233,7 +3233,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3249,20 +3249,20 @@ transformqual :: { Located (RealSrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> Stmt -- Function is applied to a list of stmts *in order* : 'then' exp {% runPV (unECP $2) >>= \ $2 -> acs (\cs-> - sLLlA $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } + sLL $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } | 'then' exp 'by' exp {% runPV (unECP $2) >>= \ $2 -> runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkTransformByStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnBy $3] cs) ss $2 $4))) } | 'then' 'group' 'using' exp {% runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] cs) ss $4))) } | 'then' 'group' 'by' exp 'using' exp {% runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupByUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] cs) ss $4 $6))) } -- Note that 'group' is a special_id, which means that you can enable @@ -3281,7 +3281,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3309,11 +3309,11 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs : alts1(PATS) ';' alt(PATS) { $1 >>= \ $1 -> $3 >>= \ $3 -> case snd $ unLoc $1 of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) ++ (mz AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) ,[$3])) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLL $1 (reLoc $>) (fst $ unLoc $1,$3 : h' : t)) } + return (sLL $1 $> (fst $ unLoc $1,$3 : h' : t)) } | alts1(PATS) ';' { $1 >>= \ $1 -> case snd $ unLoc $1 of [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -3338,7 +3338,7 @@ alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) } ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : '->' exp { unECP $2 >>= \ $2 -> - acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } + acs (\cs -> sLL $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } | gdpats { $1 >>= \gdpats -> return $ sL1 gdpats (reverse (unLoc gdpats)) } @@ -3405,11 +3405,11 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( : stmts ';' stmt { $1 >>= \ $1 -> $3 >>= \ ($3 :: LStmt GhcPs (LocatedA b)) -> case (snd $ unLoc $1) of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) ,$3 : (snd $ unLoc $1))) (h:t) -> do { h' <- addTrailingSemiA h (gl $2) - ; return $ sLL $1 (reLoc $>) (fst $ unLoc $1,$3 :(h':t)) }} + ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(h':t)) }} | stmts ';' { $1 >>= \ $1 -> case (snd $ unLoc $1) of @@ -3435,13 +3435,13 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : qual { $1 } | 'rec' stmtlist { $2 >>= \ $2 -> - acsA (\cs -> (sLL $1 (reLoc $>) $ mkRecStmt + acsA (\cs -> (sLL $1 $> $ mkRecStmt (EpAnn (glR $1) (hsDoAnn $1 $2 AnnRec) cs) $2)) } qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : bindpat '<-' exp { unECP $3 >>= \ $3 -> - acsA (\cs -> sLLlA (reLoc $1) $> + acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> return $ sL1 $1 $ mkBodyStmt $1 } @@ -3467,7 +3467,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... @@ -3512,7 +3512,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3525,7 +3525,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (let { this = $3; rest = h':t } - in rest `seq` this `seq` sLL $1 (reLoc $>) (this : rest)) } + in rest `seq` this `seq` sLL $1 $> (this : rest)) } | dbinds ';' {% case unLoc $1 of (h:t) -> do h' <- addTrailingSemiA h (gl $2) @@ -3535,7 +3535,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed dbind :: { LIPBind GhcPs } dbind : ipvar '=' exp {% runPV (unECP $3) >>= \ $3 -> - acsA (\cs -> sLLlA $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } + acsA (\cs -> sLL $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } ipvar :: { Located HsIPName } : IPDUPVARID { sL1 $1 (HsIPName (getIPDUPVARID $1)) } @@ -3557,11 +3557,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLLAA $1 $> (Or [h,$3])) } } + ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLLAA (head $1) (last $1) (And ($1)) } + { reLocA $ sLL (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -3577,7 +3577,7 @@ name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } namelist :: { Located [LocatedN RdrName] } namelist : name_var { sL1N $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} name_var :: { LocatedN RdrName } name_var : var { $1 } @@ -3609,12 +3609,12 @@ con :: { LocatedN RdrName } con_list :: { Located (NonEmpty (LocatedN RdrName)) } con_list : con { sL1N $1 (pure $1) } - | con ',' con_list {% sLL (reLocN $1) $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } + | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } qcon_list : qcon { sL1N $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} -- See Note [ExplicitTuple] in GHC.Hs.Expr sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors @@ -4141,30 +4141,17 @@ sL1n :: Located a -> b -> LocatedN b sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} -sLL :: Located a -> Located b -> c -> Located c +sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} sLLa :: Located a -> Located b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) -{-# INLINE sLLlA #-} -sLLlA :: Located a -> LocatedAn t b -> c -> Located c -sLLlA x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) - -{-# INLINE sLLAl #-} -sLLAl :: LocatedAn t a -> Located b -> c -> Located c -sLLAl x y = sL (comb2 y x) -- #define LL sL (comb2 $1 $>) - {-# INLINE sLLAsl #-} -sLLAsl :: [LocatedAn t a] -> Located b -> c -> Located c +sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c sLLAsl [] = sL1 -sLLAsl (x:_) = sLLAl x - -{-# INLINE sLLAA #-} -sLLAA :: LocatedAn t a -> LocatedAn u b -> c -> Located c -sLLAA x y = sL (comb2 (reLoc y) (reLoc x)) -- #define LL sL (comb2 $1 $>) - +sLLAsl (x:_) = sLL x {- Note [Adding location info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/GHC/Profiling.hs ===================================== @@ -27,6 +27,7 @@ foreign import ccall startProfTimer :: IO () -- | Request a heap census on the next context switch. The census can be -- requested whether or not the heap profiling timer is running. +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- @@ -34,7 +35,8 @@ foreign import ccall startProfTimer :: IO () foreign import ccall requestHeapCensus :: IO () -- | Start heap profiling. This is called normally by the RTS on start-up, --- but can be disabled using the rts flag `--no-automatic-heap-samples` +-- but can be disabled using the rts flag @--no-automatic-heap-samples at . +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- @@ -42,6 +44,7 @@ foreign import ccall requestHeapCensus :: IO () foreign import ccall startHeapProfTimer :: IO () -- | Stop heap profiling. +-- -- Note: This won't do anything unless you also specify a profiling mode on the -- command line using the normal RTS options. -- ===================================== m4/find_python.m4 ===================================== @@ -5,6 +5,11 @@ AC_DEFUN([FIND_PYTHON],[ dnl Prefer the mingw64 distribution on Windows due to #17483. AC_PATH_PROG([PYTHON], [python3], [], [/mingw64/bin $PATH]) - PythonCmd="$PYTHON" + if test "$HostOS" = "mingw32" + then + PythonCmd=$(cygpath -m "$PYTHON") + else + PythonCmd="$PYTHON" + fi AC_SUBST([PythonCmd]) ]) ===================================== testsuite/config/ghc ===================================== @@ -80,7 +80,6 @@ if not config.arch == "javascript": config.compile_ways.append('hpc') config.run_ways.append('hpc') -# WASM if config.arch == "wasm32": config.have_process = False config.supports_dynamic_libs = False @@ -270,12 +269,7 @@ def get_compiler_info(): config.have_vanilla = compiler_supports_way([]) config.have_dynamic = compiler_supports_way(['-dynamic']) - - # JavaScript doesn't support profiling yet. See #22261 - if config.arch == "javascript": - config.have_profiling = False - else: - config.have_profiling = compiler_supports_way(['-prof']) + config.have_profiling = compiler_supports_way(['-prof']) if config.have_profiling: config.compile_ways.append('profasm') ===================================== testsuite/driver/testlib.py ===================================== @@ -236,11 +236,6 @@ def req_profiling( name, opts ): '''Require the profiling libraries (add 'GhcLibWays += p' to mk/build.mk)''' if not config.have_profiling: opts.expect = 'fail' - # many profiling tests must be skipped for the JS backend. That is - # because they unexpectedly pass even though the JS backend does not - # support profiling yet. See #22251 - if js_arch(): - js_skip(name, opts) # JS backend doesn't support profiling yet if arch("js"): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c54a0f0e3d10a73597c037890f4e946052d44a9b...8c6f1f9a4f0873de5c91504175ec19fb76f74668 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c54a0f0e3d10a73597c037890f4e946052d44a9b...8c6f1f9a4f0873de5c91504175ec19fb76f74668 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 21:27:11 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 14 Jul 2023 17:27:11 -0400 Subject: [Git][ghc/ghc][wip/supersven/imulMayOflo_x86] Add test for %mulmayoflo primop Message-ID: <64b1bdaece91a_3edd8543bcfa01443d8@gitlab.mail> Sven Tennie pushed to branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC Commits: cce025da by Sven Tennie at 2023-07-14T23:26:47+02:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 4 changed files: - compiler/GHC/Cmm/MachOp.hs - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -56,6 +56,25 @@ Note that there are variety of places in the native code generator where we assume that the code produced for a MachOp does not introduce new blocks. -} +-- Note [MO_S_MulMayOflo significant width] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- There are two interpretations in the code about what a multiplication +-- overflow exactly means: +-- +-- 1. The result does not fit into the specified width (of type Width.) +-- 2. The result does not fit into a register. +-- +-- (2) has some flaws: A following MO_Mul has a width, too. So MO_S_MulMayOflo +-- may signal no overflow, while MO_Mul truncates the result. There are +-- architectures with several register widths and it might be hard to decide +-- what's an overflow and what not. Both attributes can easily lead to subtle +-- bugs. +-- +-- (1) has the benefit that its interpretation is completely independent of the +-- architecture. So, the mid-term plan is to migrate to this +-- interpretation/sematics. + data MachOp -- Integer operations (insensitive to signed/unsigned) = MO_Add Width @@ -65,7 +84,8 @@ data MachOp | MO_Mul Width -- low word of multiply -- Signed multiply/divide - | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows + | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows. See + -- Note [MO_S_MulMayOflo significant width] | MO_S_Quot Width -- signed / (same semantics as IntQuotOp) | MO_S_Rem Width -- signed % (same semantics as IntRemOp) | MO_S_Neg Width -- unary - ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +{- + N.B. the contract of '%mulmayoflo' is a bit weak: "Return non-zero if there is + any possibility that the signed multiply of a and b might overflow. Return zero + only if you are absolutely sure that it won't overflow. If in doubt, return + non-zero." (Stg.h) + +This test verifies the a stronger contract: It's expected that there are no +false positives. This requirement is e.g. met by code generation backends which +execute the multiplication to check for overflow. +-} + +module Main where + +import GHC.Exts + +-- The argument and return types are unimportant: They're only used to force +-- evaluation, but carry no information. +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm ===================================== @@ -0,0 +1,98 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -226,3 +226,14 @@ test('T22296',[only_ways(llvm_ways) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) + +# TODO: Enable more architectures here. N.B. some code generation backends are +# not implemeted correctly (according to +# Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. +test('MulMayOflo_full', + [ extra_files(['MulMayOflo.hs']), + when(unregisterised(), skip), + unless(arch('x86_64') or arch('i386'), skip), + ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cce025daaf380745eac74476dc2e4c1c9891ae90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cce025daaf380745eac74476dc2e4c1c9891ae90 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 22:16:48 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 14 Jul 2023 18:16:48 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] 2 commits: Annotate more instructions Message-ID: <64b1c9508a1d1_3edd85b3f4c148913@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: adf440b1 by Sven Tennie at 2023-07-15T00:15:05+02:00 Annotate more instructions - - - - - 06eec420 by Sven Tennie at 2023-07-15T00:15:33+02:00 Truncate after left shift Shifted values may exceed the target Width. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -668,7 +668,7 @@ getRegister' config plat expr = code `appOL` toOL [ ann - (text "narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to) + (text "MO_SS_Conv: narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to) (LSL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))), -- signed right shift ASR (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift)) @@ -716,10 +716,18 @@ getRegister' config plat expr = -- 2. Shifts. x << n, x >> n. CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) `appOL` + truncateReg w w dst + ) CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + return $ Any (intFormat w) (\dst -> + code_x `snocOL` + annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n))) `appOL` + truncateReg w w dst + ) CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | fitsIn12bitImm n -> do (reg_x, format_x, code_x) <- getSomeReg x @@ -873,64 +881,64 @@ getRegister' config plat expr = -- N.B. We needn't sign-extend sub-word size (in)equality comparisons -- since we don't care about ordering. - MO_Eq w -> bitOp w (\d x y -> toOL [ CSET d x y EQ ]) - MO_Ne w -> bitOp w (\d x y -> toOL [ CSET d x y NE ]) + MO_Eq w -> bitOp w (\d x y -> unitOL $ annExpr expr (CSET d x y EQ)) + MO_Ne w -> bitOp w (\d x y -> unitOL $ annExpr expr (CSET d x y NE)) -- Signed multiply/divide - MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) + MO_Mul w -> intOp True w (\d x y -> unitOL $ annExpr expr (MUL d x y)) MO_S_MulMayOflo w -> do_mul_may_oflo w x y - MO_S_Quot w -> intOp True w (\d x y -> unitOL $ DIV d x y) + MO_S_Quot w -> intOp True w (\d x y -> unitOL $ annExpr expr (DIV d x y)) -- Note the swap in Rx and Ry. - MO_S_Rem w -> intOp True w (\d x y -> unitOL $ REM d x y) + MO_S_Rem w -> intOp True w (\d x y -> unitOL $ annExpr expr (REM d x y)) -- Unsigned multiply/divide - MO_U_Quot w -> intOp False w (\d x y -> unitOL $ DIVU d x y) - MO_U_Rem w -> intOp False w (\d x y -> unitOL $ REM d x y) + MO_U_Quot w -> intOp False w (\d x y -> unitOL $ annExpr expr (DIVU d x y)) + MO_U_Rem w -> intOp False w (\d x y -> unitOL $ annExpr expr (REM d x y)) - -- Signed comparisons -- see Note [CSET] - MO_S_Ge w -> intOp True w (\d x y -> toOL [ CSET d x y SGE ]) - MO_S_Le w -> intOp True w (\d x y -> toOL [ CSET d x y SLE ]) - MO_S_Gt w -> intOp True w (\d x y -> toOL [ CSET d x y SGT ]) - MO_S_Lt w -> intOp True w (\d x y -> toOL [ CSET d x y SLT ]) + -- Signed comparisons -- see Note [CSET) + MO_S_Ge w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SGE)) + MO_S_Le w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SLE)) + MO_S_Gt w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SGT)) + MO_S_Lt w -> intOp True w (\d x y -> unitOL $ annExpr expr (CSET d x y SLT)) -- Unsigned comparisons - MO_U_Ge w -> intOp False w (\d x y -> toOL [ CSET d x y UGE ]) - MO_U_Le w -> intOp False w (\d x y -> toOL [ CSET d x y ULE ]) - MO_U_Gt w -> intOp False w (\d x y -> toOL [ CSET d x y UGT ]) - MO_U_Lt w -> intOp False w (\d x y -> toOL [ CSET d x y ULT ]) + MO_U_Ge w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y UGE)) + MO_U_Le w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y ULE)) + MO_U_Gt w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y UGT)) + MO_U_Lt w -> intOp False w (\d x y -> unitOL $ annExpr expr (CSET d x y ULT)) -- Floating point arithmetic - MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) - MO_F_Sub w -> floatOp w (\d x y -> unitOL $ SUB d x y) - MO_F_Mul w -> floatOp w (\d x y -> unitOL $ MUL d x y) - MO_F_Quot w -> floatOp w (\d x y -> unitOL $ DIV d x y) + MO_F_Add w -> floatOp w (\d x y -> unitOL $ annExpr expr (ADD d x y)) + MO_F_Sub w -> floatOp w (\d x y -> unitOL $ annExpr expr (SUB d x y)) + MO_F_Mul w -> floatOp w (\d x y -> unitOL $ annExpr expr (MUL d x y)) + MO_F_Quot w -> floatOp w (\d x y -> unitOL $ annExpr expr (DIV d x y)) -- Floating point comparison - MO_F_Eq w -> floatCond w (\d x y -> toOL [ CSET d x y EQ ]) - MO_F_Ne w -> floatCond w (\d x y -> toOL [ CSET d x y NE ]) + MO_F_Eq w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y EQ)) + MO_F_Ne w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y NE)) -- careful with the floating point operations. -- SLE is effectively LE or unordered (NaN) -- SLT is the same. ULE, and ULT will not return true for NaN. -- This is a bit counter-intuitive. Don't let yourself be fooled by -- the S/U prefix for floats, it's only meaningful for integers. - MO_F_Ge w -> floatCond w (\d x y -> toOL [ CSET d x y OGE ]) - MO_F_Le w -> floatCond w (\d x y -> toOL [ CSET d x y OLE ]) -- x <= y <=> y > x - MO_F_Gt w -> floatCond w (\d x y -> toOL [ CSET d x y OGT ]) - MO_F_Lt w -> floatCond w (\d x y -> toOL [ CSET d x y OLT ]) -- x < y <=> y >= x + MO_F_Ge w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OGE)) + MO_F_Le w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OLE)) -- x <= y <=> y > x + MO_F_Gt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OGT)) + MO_F_Lt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y OLT)) -- x < y <=> y >= x -- Bitwise operations - MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ OR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ XOR d x y) - MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) - MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) - MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) + MO_And w -> bitOp w (\d x y -> unitOL $ annExpr expr (AND d x y)) + MO_Or w -> bitOp w (\d x y -> unitOL $ annExpr expr (OR d x y)) + MO_Xor w -> bitOp w (\d x y -> unitOL $ annExpr expr (XOR d x y)) + MO_Shl w -> intOp False w (\d x y -> unitOL $ annExpr expr (LSL d x y)) + MO_U_Shr w -> intOp False w (\d x y -> unitOL $ annExpr expr (LSR d x y)) + MO_S_Shr w -> intOp True w (\d x y -> unitOL $ annExpr expr (ASR d x y)) -- TODO - op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ (pprMachOp op) <+> text "in" <+> (pdoc plat expr) + op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ pprMachOp op <+> text "in" <+> (pdoc plat expr) CmmMachOp _op _xs -> pprPanic "getRegister' (variadic CmmMachOp): " (pdoc plat expr) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b21e0985ea6c354ee6e147d2239dccdf7102241a...06eec420862b1b1399f81f356bfd59e0d173c7db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b21e0985ea6c354ee6e147d2239dccdf7102241a...06eec420862b1b1399f81f356bfd59e0d173c7db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 14 22:46:52 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 14 Jul 2023 18:46:52 -0400 Subject: [Git][ghc/ghc][wip/T22404] Further wibbles Message-ID: <64b1d05cc7fa2_3edd85b3e5c149571@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 5a7c81a5 by Simon Peyton Jones at 2023-07-14T23:46:38+01:00 Further wibbles - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -964,7 +964,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine else let unf = idUnfolding bndr rhs_env = addOneShotsFromDmd bndr $ - setNonTailCtxt OccRhs env + setNonTailCtxt (mkNonRecRhsCtxt tagged_bndr unf) env !rhs_wuds@(WTUD _ rhs') = occAnalLamTail rhs_env rhs !(WTUD (TUD _ unf_uds) _) = occAnalUnfolding rhs_env unf rhs_uds = adjustTailUsage Nothing rhs_wuds @@ -1034,8 +1034,7 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs --------- Right hand side --------- env1 | is_join_point = setTailCtxt env | otherwise = setNonTailCtxt rhs_ctxt env - rhs_ctxt | certainly_inline = OccVanilla -- See Note [Cascading inlines] - | otherwise = OccRhs + rhs_ctxt = mkNonRecRhsCtxt bndr unf -- See Note [Sources of one-shot information] rhs_env = addOneShotsFromDmd bndr env1 @@ -1075,7 +1074,13 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs add_rule_uds (_, l, r) uds_s = (l `andUDs` adjustTailArity mb_join r) : uds_s + ---------- +mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl +mkNonRecRhsCtxt bndr unf + | certainly_inline = OccVanilla -- See Note [Cascading inlines] + | otherwise = OccRhs + where certainly_inline -- See Note [Cascading inlines] = -- certainly_inline is only used for non-join points,so idOccInfo is valid case idOccInfo bndr of @@ -2560,10 +2565,10 @@ occAnalArgs !env fun args !one_shots !(WUD arg_uds arg') = occAnal arg_env arg !(arg_env, one_shots') | isTypeArg arg - = (env, one_shots) + = (env_args, one_shots) | otherwise = case one_shots of - [] -> (env, []) -- Fast path; one_shots is often empty + [] -> (env_args, []) -- Fast path; one_shots is often empty (os : one_shots') -> (addOneShots os env_args, one_shots') {- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a7c81a55e84fcdfaecc6a027c434a43677bc6a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5a7c81a55e84fcdfaecc6a027c434a43677bc6a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 00:45:33 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 14 Jul 2023 20:45:33 -0400 Subject: [Git][ghc/ghc][wip/T23496-take-three] 2 commits: Split GHC.Generics into two modules Message-ID: <64b1ec2d522fc_3edd85b3e5c169795@gitlab.mail> Ryan Scott pushed to branch wip/T23496-take-three at Glasgow Haskell Compiler / GHC Commits: 6c2d8476 by Ryan Scott at 2023-07-14T20:44:11-04:00 Split GHC.Generics into two modules Most of `GHC.Generics` has now been moved to `GHC.Generics.Internal`, which `GHC.Generics` re-exports. The only things now defined in `GHC.Generics` are the derived `Generic(1)` instances. These need to be put in a different module because of GHC's new approach to dependency analysis used in a fix for #23496 (to be done in a subsequent commit), which is perfectly within its rights to typecheck a generated `Rep` instance before it typechecks any of the definitions that are referenced in the right-hand side of the instance. Putting the definitions in a separate module from the derived `Generic` instances (and therefore the generated `Rep` instances) is a sure-fire way to ensure that this doesn't happen. This causes a fair bit of churn in the expected output of test cases in the test suite, but all of the changes are simply from switching to displaying "`GHC.Generics.Internal`" instead of "`GHC.Generics`". - - - - - 6e18f0d0 by Ryan Scott at 2023-07-14T20:44:20-04:00 deriving: Typecheck associated family instances before instance bindings This is a significant overhaul of the way that `deriving` clauses and standalone `deriving` declarations are typechecked. The highlights: * Standalone `deriving` declarations are located in the new `DerivInstD` constructor of `ClsInstDecl`, rather than as part of the `DerivD` constructor of `HsGroup`. This move now means that standalone `deriving` instance declarations are located alongside other forms of instance declarations, which makes it easier to perform SCC analysis on them, as they are now part of a `TyClGroup`. * Now that everything `deriving`-related lives in `TyClGroup`s, we now typecheck all of the associated type family instances that are generated from `deriving` clauses/declarations first (in `tcTyClGroup`) _before_ typechecking any of the generated instance bindings, which happen after all of the `TyClGroup`s have been processed. Doing so is essential to ensuring that these associated type instances are in scope when needed to typecheck other code in later `TyClGroup`s, such as the failing examples seen in #23496. I have written an extensive `Note [Staging of deriving]` (previously `Note [Staging of tcDeriving]`) to describe how everything works. The second bullet point above involves quite a bit of churn in the expected output of several test cases. This is for two reasons: 1. The order in which things are printed with `-ddump-deriv` is now different, since `deriving`-related family instances are now generated earlier in the typechecker. 2. If a test case errors out when typechecking a `deriving`-related family instance, then GHC will stop there before printing any errors involving the generated instance bindings. (Previously, both sorts of errors were printed simultaneously.) As such, some expected-to-fail test cases do not print out as many errors as before. Fixes #23496. - - - - - 22 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Hs/Decls.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/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/Instance.hs-boot - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - libraries/base/GHC/Generics.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c955449e244a027fc12f86c387dac6be773aa27f...6e18f0d0e43238cc41bd3146c3d55b5b6c32033f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c955449e244a027fc12f86c387dac6be773aa27f...6e18f0d0e43238cc41bd3146c3d55b5b6c32033f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 01:31:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 14 Jul 2023 21:31:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: EPA: Simplify GHC/Parser.y sLL Message-ID: <64b1f6f994624_3edd85b3eac17721b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 275b293f by Alan Zimmerman at 2023-07-14T21:31:24-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 1a7794a4 by sheaf at 2023-07-14T21:31:26-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - 2f50b177 by Rodrigo Mesquita at 2023-07-14T21:31:27-04:00 Improve Note [Binder-swap during float-out] - - - - - 3 changed files: - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Parser.y - m4/find_python.m4 Changes: ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -44,13 +44,33 @@ case x of wild { p -> ...wild... } we substitute x for wild in the RHS of the case alternatives: case x of wild { p -> ...x... } - This means that a sub-expression involving x is not "trapped" inside the RHS. + This means that a sub-expression involving x is not "trapped" inside the RHS + (i.e. it can now be floated out, whereas if it mentioned wild it could not). And it's not inconvenient because we already have a substitution. - Note that this is EXACTLY BACKWARDS from the what the simplifier does. - The simplifier tries to get rid of occurrences of x, in favour of wild, - in the hope that there will only be one remaining occurrence of x, namely - the scrutinee of the case, and we can inline it. + For example, consider: + + f x = letrec go y = case x of z { (a,b) -> ...(expensive z)... } + in ... + + If we do the reverse binder-swap we get + + f x = letrec go y = case x of z { (a,b) -> ...(expensive x)... } + in ... + + and now we can float out: + + f x = let t = expensive x + in letrec go y = case x of z { (a,b) -> ...(t)... } + in ... + + Now (expensive x) is computed once, rather than once each time around the 'go' loop. + + Note that this is EXACTLY BACKWARDS from the what the simplifier does. + The simplifier tries to get rid of occurrences of x, in favour of wild, + in the hope that there will only be one remaining occurrence of x, namely + the scrutinee of the case, and we can inline it. + -} module GHC.Core.Opt.SetLevels ( ===================================== compiler/GHC/Parser.y ===================================== @@ -804,12 +804,12 @@ msubsts :: { OrdList (LHsModuleSubst PackageName) } | msubst { unitOL $1 } msubst :: { LHsModuleSubst PackageName } - : modid '=' moduleid { sLL (reLoc $1) $> $ (reLoc $1, $3) } - | modid VARSYM modid VARSYM { sLL (reLoc $1) $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } + : modid '=' moduleid { sLL $1 $> $ (reLoc $1, $3) } + | modid VARSYM modid VARSYM { sLL $1 $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } moduleid :: { LHsModuleId PackageName } : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar (reLoc $2) } - | unitid ':' modid { sLL $1 (reLoc $>) $ HsModuleId $1 (reLoc $3) } + | unitid ':' modid { sLL $1 $> $ HsModuleId $1 (reLoc $3) } pkgname :: { Located PackageName } : STRING { sL1 $1 $ PackageName (getSTRING $1) } @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL (reLoc $1) (reLoc $>) $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1168,7 +1168,7 @@ optqualified :: { Located (Maybe EpaLocation) } maybeas :: { (Maybe EpaLocation,Located (Maybe (LocatedA ModuleName))) } : 'as' modid { (Just (glAA $1) - ,sLL $1 (reLoc $>) (Just $2)) } + ,sLL $1 $> (Just $2)) } | {- empty -} { (Nothing,noLoc Nothing) } maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])) } @@ -1209,9 +1209,9 @@ importlist1 :: { OrdList (LIE GhcPs) } | import { $1 } import :: { OrdList (LIE GhcPs) } - : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL (reLoc $1) $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } - | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 (reLocN $>) $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } + | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1230,7 +1230,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } : ops ',' op {% case (unLoc $1) of SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) - return (sLL $1 (reLocN $>) (snocOL hs t' `appOL` unitOL $3)) } + return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } | op { sL1N $1 (unitOL $1) } ----------------------------------------------------------------------------- @@ -1357,7 +1357,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order {% case unLoc $1 of (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | oqtycon { sL1N $1 [$1] } inst_decl :: { LInstDecl GhcPs } @@ -1415,7 +1415,7 @@ deriv_strategy_no_via :: { LDerivStrategy GhcPs } | 'newtype' {% acsA (\cs -> sL1 $1 (NewtypeStrategy (EpAnn (glR $1) [mj AnnNewtype $1] cs))) } deriv_strategy_via :: { LDerivStrategy GhcPs } - : 'via' sigktype {% acsA (\cs -> sLLlA $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) + : 'via' sigktype {% acsA (\cs -> sLL $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) $2))) } deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } @@ -1429,15 +1429,15 @@ deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) } : {- empty -} { noLoc ([], Nothing) } - | '|' injectivity_cond { sLL $1 (reLoc $>) ([mj AnnVbar $1] + | '|' injectivity_cond { sLL $1 $> ([mj AnnVbar $1] , Just ($2)) } injectivity_cond :: { LInjectivityAnn GhcPs } : tyvarid '->' inj_varids - {% acsA (\cs -> sLL (reLocN $1) $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } + {% acsA (\cs -> sLL $1 $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } inj_varids :: { Located [LocatedN RdrName] } - : inj_varids tyvarid { sLL $1 (reLocN $>) ($2 : unLoc $1) } + : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } | tyvarid { sL1N $1 [$1] } -- Closed type families @@ -1462,16 +1462,16 @@ ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] } : ty_fam_inst_eqns ';' ty_fam_inst_eqn {% let (L loc eqn) = $3 in case unLoc $1 of - [] -> return (sLLlA $1 $> (L loc eqn : unLoc $1)) + [] -> return (sLL $1 $> (L loc eqn : unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLLlA $1 $> ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | ty_fam_inst_eqns ';' {% case unLoc $1 of [] -> return (sLL $1 $> (unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | ty_fam_inst_eqn { sLLAA $1 $> [$1] } + | ty_fam_inst_eqn { sLL $1 $> [$1] } | {- empty -} { noLoc [] } ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } @@ -1572,26 +1572,26 @@ data_or_newtype :: { Located (AddEpAnn, NewOrData) } opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } : { noLoc ([] , Nothing) } - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], Just $2) } + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } - | '::' kind { sLL $1 (reLoc $>) ( [mu AnnDcolon $1] + | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1, mj AnnVbar $3] + ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, @@ -1602,14 +1602,14 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- T Int [a] -- for associated types -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } - : context '=>' type {% acs (\cs -> (sLLAA $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } + : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } | type { sL1A $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 >> fromSpecTyVarBndrs $2 >>= \tvbs -> - (acs (\cs -> (sLL $1 (reLoc $>) + (acs (\cs -> (sLL $1 $> (Just ( addTrailingDarrowC $4 $5 cs) , mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6)))) } @@ -1619,7 +1619,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; cs <- getCommentsFor loc ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } - | context '=>' type {% acs (\cs -> (sLLAA $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } + | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } @@ -1643,7 +1643,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type {% do { let { err = text "in the stand-alone deriving instance" <> colon <+> quotes (ppr $5) } - ; acsA (\cs -> sLL $1 (reLoc $>) + ; acsA (\cs -> sLL $1 $> (DerivDecl (EpAnn (glR $1) [mj AnnDeriving $1, mj AnnInstance $3] cs) (mkHsWildCardBndrs $5) $2 $4)) }} ----------------------------------------------------------------------------- @@ -1674,19 +1674,19 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl GhcPs } : 'pattern' pattern_synonym_lhs '=' pat {% let (name, args, as ) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 ImplicitBidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1, mj AnnEqual $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat {% let (name, args, as) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 Unidirectional + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat where_decls {% do { let (name, args, as) = $2 ; mg <- mkPatSynMatchGroup name $5 - ; acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ + ; acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 (ExplicitBidirectional mg) (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) }} @@ -1713,7 +1713,7 @@ where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype - {% acsA (\cs -> sLL $1 (reLoc $>) + {% acsA (\cs -> sLL $1 $> $ PatSynSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnPattern $1]) cs) (toList $ unLoc $2) $4) } @@ -1736,16 +1736,16 @@ decl_cls : at_decl_cls { $1 } do { v <- checkValSigLhs $2 ; let err = text "in default signature" <> colon <+> quotes (ppr $2) - ; acsA (\cs -> sLL $1 (reLoc $>) $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do t' <- addTrailingSemiA t (gl $2) - return (sLLlA $1 $> (fst $ unLoc $1 + return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t' `appOL` unitOL $3)) } | decls_cls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> ( (fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -1824,7 +1824,7 @@ where_inst :: { Located ([AddEpAnn] -- decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } : decls ';' decl {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1833,7 +1833,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } rest = snocOL hs t'; these = rest `appOL` this } return (rest `seq` this `seq` these `seq` - (sLLlA $1 $> (fst $ unLoc $1, these))) } + (sLL $1 $> (fst $ unLoc $1, these))) } | decls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2) ,snd $ unLoc $1))) @@ -1896,7 +1896,7 @@ rule :: { LRuleDecl GhcPs } : STRING rule_activation rule_foralls infixexp '=' exp {%runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acsA (\cs -> (sLLlA $1 $> $ HsRule + acsA (\cs -> (sLL $1 $> $ HsRule { rd_ext = (EpAnn (glR $1) ((fstOf3 $3) (mj AnnEqual $5 : (fst $2))) cs, getSTRINGs $1) , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRING $1) , rd_act = (snd $2) `orElse` AlwaysActive @@ -2103,10 +2103,10 @@ safety :: { Located Safety } fspec :: { Located ([AddEpAnn] ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)) } - : STRING var '::' sigtype { sLL $1 (reLoc $>) ([mu AnnDcolon $3] + : STRING var '::' sigtype { sLL $1 $> ([mu AnnDcolon $3] ,(L (getLoc $1) (getStringLiteral $1), $2, $4)) } - | var '::' sigtype { sLL (reLocN $1) (reLoc $>) ([mu AnnDcolon $2] + | var '::' sigtype { sLL $1 $> ([mu AnnDcolon $2] ,(noLoc (StringLiteral NoSourceText nilFS Nothing), $1, $3)) } -- if the entity string is missing, it defaults to the empty string; -- the meaning of an empty entity string depends on the calling @@ -2127,8 +2127,8 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } -- See Note [forall-or-nothing rule] in GHC.Hs.Type. sigktype :: { LHsSigType GhcPs } : sigtype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ + sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2139,10 +2139,10 @@ sigtype :: { LHsSigType GhcPs } sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order : sig_vars ',' var {% case unLoc $1 of - [] -> return (sLL $1 (reLocN $>) ($3 : unLoc $1)) + [] -> return (sLL $1 $> ($3 : unLoc $1)) (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | var { sL1N $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } @@ -2168,7 +2168,7 @@ forall_telescope :: { Located (HsForAllTelescope GhcPs) } -- A ktype is a ctype, possibly with a kind annotation ktype :: { LHsType GhcPs } : ctype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- A ctype is a for-all type ctype :: { LHsType GhcPs } @@ -2176,12 +2176,12 @@ ctype :: { LHsType GhcPs } HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } - | context '=>' ctype {% acsA (\cs -> (sLL (reLoc $1) (reLoc $>) $ + | context '=>' ctype {% acsA (\cs -> (sLL $1 $> $ HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs , hst_xqual = NoExtField , hst_body = $3 })) } - | ipvar '::' ctype {% acsA (\cs -> sLL $1 (reLoc $>) (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } + | ipvar '::' ctype {% acsA (\cs -> sLL $1 $> (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } | type { $1 } ---------------------- @@ -2213,21 +2213,21 @@ is connected to the first type too. type :: { LHsType GhcPs } -- See Note [%shift: type -> btype] : btype %shift { $1 } - | btype '->' ctype {% acsA (\cs -> sLL (reLoc $1) (reLoc $>) + | btype '->' ctype {% acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsUnrestrictedArrow (hsUniTok $2)) $1 $3) } | btype mult '->' ctype {% hintLinear (getLoc $2) >> let arr = (unLoc $2) (hsUniTok $3) - in acsA (\cs -> sLL (reLoc $1) (reLoc $>) + in acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) arr $1 $4) } | btype '->.' ctype {% hintLinear (getLoc $2) >> - acsA (\cs -> sLL (reLoc $1) (reLoc $>) + acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsLinearArrow (HsLolly (hsTok $2))) $1 $3) } -- [mu AnnLollyU $2] } mult :: { Located (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs) } - : PREFIX_PERCENT atype { sLL $1 (reLoc $>) (mkMultTy (hsTok $1) $2) } + : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy (hsTok $1) $2) } btype :: { LHsType GhcPs } : infixtype {% runPV $1 } @@ -2258,10 +2258,10 @@ tyarg :: { LHsType GhcPs } tyop :: { (LocatedN RdrName, PromotionFlag) } : qtyconop { ($1, NotPromoted) } | tyvarop { ($1, NotPromoted) } - | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } - | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } @@ -2273,8 +2273,8 @@ atype :: { LHsType GhcPs } ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer - | PREFIX_TILDE atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } - | PREFIX_BANG atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } + | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } + | PREFIX_BANG atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } | '{' fielddecls '}' {% do { decls <- acsA (\cs -> (sLL $1 $> $ HsRecTy (EpAnn (glR $1) (AnnList (Just $ listAsAnchor $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) $2)) ; checkRecordSyntax decls }} @@ -2292,12 +2292,12 @@ atype :: { LHsType GhcPs } | quasiquote { mapLocA (HsSpliceTy noExtField) $1 } | splice_untyped { mapLocA (HsSpliceTy noExtField) $1 } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } | SIMPLEQUOTE '(' ktype ',' comma_types1 ')' {% do { h <- addTrailingCommaA $3 (gl $4) ; acsA (\cs -> sLL $1 $> $ HsExplicitTupleTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mop $2,mcp $6] cs) (h : $5)) }} | SIMPLEQUOTE '[' comma_types0 ']' {% acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mos $2,mcs $4] cs) IsPromoted $3) } - | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } -- Two or more [ty, ty, ty] must be a promoted list type, just as -- if you had written '[ty, ty, ty] @@ -2366,7 +2366,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } : fds1 ',' fd {% do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | fd { sL1A $1 [$1] } fd :: { LHsFunDep GhcPs } @@ -2377,7 +2377,7 @@ fd :: { LHsFunDep GhcPs } varids0 :: { Located [LocatedN RdrName] } : {- empty -} { noLoc [] } - | varids0 tyvar { sLL $1 (reLocN $>) ($2 : (unLoc $1)) } + | varids0 tyvar { sLL $1 $> ($2 : (unLoc $1)) } ----------------------------------------------------------------------------- -- Kinds @@ -2464,7 +2464,7 @@ constrs1 :: { Located [LConDecl GhcPs] } : constrs1 '|' constr {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | constr { sL1A $1 [$1] } constr :: { LConDecl GhcPs } @@ -2518,7 +2518,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } - : derivings deriving { sLL $1 (reLoc $>) ($2 : unLoc $1) } -- AZ: order? + : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? | deriving { sL1 (reLoc $>) [$1] } -- The outer Located is just to allow the caller to @@ -2603,7 +2603,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } (GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }} gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } - : gdrhs gdrh { sLL $1 (reLoc $>) ($2 : unLoc $1) } + : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } | gdrh { sL1 (reLoc $1) [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } @@ -2616,14 +2616,14 @@ sigdecl :: { LHsDecl GhcPs } infixexp '::' sigtype {% do { $1 <- runPV (unECP $1) ; v <- checkValSigLhs $1 - ; acsA (\cs -> (sLLAl $1 (reLoc $>) $ SigD noExtField $ + ; acsA (\cs -> (sLL $1 $> $ SigD noExtField $ TypeSig (EpAnn (glAR $1) (AnnSig (mu AnnDcolon $2) []) cs) [v] (mkHsWildCardBndrs $3)))} } | var ',' sig_vars '::' sigtype {% do { v <- addTrailingCommaN $1 (gl $2) ; let sig cs = TypeSig (EpAnn (glNR $1) (AnnSig (mu AnnDcolon $4) []) cs) (v : reverse (unLoc $3)) (mkHsWildCardBndrs $5) - ; acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ SigD noExtField (sig cs) ) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField (sig cs) ) }} | infix prec ops {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $3 @@ -2717,22 +2717,22 @@ exp :: { ECP } | infixexp '-<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 HsFirstOrderApp True) } | infixexp '>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 HsFirstOrderApp False) } | infixexp '-<<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 HsHigherOrderApp True) } | infixexp '>>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 HsHigherOrderApp False) } -- See Note [%shift: exp -> infixexp] | infixexp %shift { $1 } @@ -2758,7 +2758,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLLlA $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2845,7 +2845,7 @@ fexp :: { ECP } | 'static' aexp {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 (reLoc $>) $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } + acsA (\cs -> sLL $1 $> $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } | aexp { $1 } @@ -2872,8 +2872,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLLlA $1 $> - [reLocA $ sLLlA $1 $> + (reLocA $ sLL $1 $> + [reLocA $ sLL $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2929,7 +2929,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLLlA $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -3000,10 +3000,10 @@ aexp2 :: { ECP } | splice_untyped { ECP $ pvA $ mkHsSplicePV $1 } | splice_typed { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLocA $1) } - | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } - | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } -- See Note [%shift: aexp2 -> TH_TY_QUOTE] | TH_TY_QUOTE %shift {% reportEmptyDoubleQuotes (getLoc $1) } | '[|' exp '|]' {% runPV (unECP $2) >>= \ $2 -> @@ -3032,8 +3032,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3042,13 +3042,13 @@ splice_exp :: { LHsExpr GhcPs } splice_untyped :: { Located (HsUntypedSplice GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } + acs (\cs -> sLL $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } splice_typed :: { Located ((EpAnnCO, EpAnn [AddEpAnn]), LHsExpr GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } + acs (\cs -> sLL $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } cmdargs :: { [LHsCmdTop GhcPs] } : cmdargs acmd { $2 : $1 } @@ -3093,7 +3093,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL (reLoc $1) (reLocN $>) $ SectionL noAnn $1 (n2l $2) } + reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3233,7 +3233,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3249,20 +3249,20 @@ transformqual :: { Located (RealSrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> Stmt -- Function is applied to a list of stmts *in order* : 'then' exp {% runPV (unECP $2) >>= \ $2 -> acs (\cs-> - sLLlA $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } + sLL $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } | 'then' exp 'by' exp {% runPV (unECP $2) >>= \ $2 -> runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkTransformByStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnBy $3] cs) ss $2 $4))) } | 'then' 'group' 'using' exp {% runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] cs) ss $4))) } | 'then' 'group' 'by' exp 'using' exp {% runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupByUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] cs) ss $4 $6))) } -- Note that 'group' is a special_id, which means that you can enable @@ -3281,7 +3281,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3309,11 +3309,11 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs : alts1(PATS) ';' alt(PATS) { $1 >>= \ $1 -> $3 >>= \ $3 -> case snd $ unLoc $1 of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) ++ (mz AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) ,[$3])) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLL $1 (reLoc $>) (fst $ unLoc $1,$3 : h' : t)) } + return (sLL $1 $> (fst $ unLoc $1,$3 : h' : t)) } | alts1(PATS) ';' { $1 >>= \ $1 -> case snd $ unLoc $1 of [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -3338,7 +3338,7 @@ alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) } ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : '->' exp { unECP $2 >>= \ $2 -> - acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } + acs (\cs -> sLL $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } | gdpats { $1 >>= \gdpats -> return $ sL1 gdpats (reverse (unLoc gdpats)) } @@ -3405,11 +3405,11 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( : stmts ';' stmt { $1 >>= \ $1 -> $3 >>= \ ($3 :: LStmt GhcPs (LocatedA b)) -> case (snd $ unLoc $1) of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) ,$3 : (snd $ unLoc $1))) (h:t) -> do { h' <- addTrailingSemiA h (gl $2) - ; return $ sLL $1 (reLoc $>) (fst $ unLoc $1,$3 :(h':t)) }} + ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(h':t)) }} | stmts ';' { $1 >>= \ $1 -> case (snd $ unLoc $1) of @@ -3435,13 +3435,13 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : qual { $1 } | 'rec' stmtlist { $2 >>= \ $2 -> - acsA (\cs -> (sLL $1 (reLoc $>) $ mkRecStmt + acsA (\cs -> (sLL $1 $> $ mkRecStmt (EpAnn (glR $1) (hsDoAnn $1 $2 AnnRec) cs) $2)) } qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : bindpat '<-' exp { unECP $3 >>= \ $3 -> - acsA (\cs -> sLLlA (reLoc $1) $> + acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> return $ sL1 $1 $ mkBodyStmt $1 } @@ -3467,7 +3467,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... @@ -3512,7 +3512,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3525,7 +3525,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (let { this = $3; rest = h':t } - in rest `seq` this `seq` sLL $1 (reLoc $>) (this : rest)) } + in rest `seq` this `seq` sLL $1 $> (this : rest)) } | dbinds ';' {% case unLoc $1 of (h:t) -> do h' <- addTrailingSemiA h (gl $2) @@ -3535,7 +3535,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed dbind :: { LIPBind GhcPs } dbind : ipvar '=' exp {% runPV (unECP $3) >>= \ $3 -> - acsA (\cs -> sLLlA $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } + acsA (\cs -> sLL $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } ipvar :: { Located HsIPName } : IPDUPVARID { sL1 $1 (HsIPName (getIPDUPVARID $1)) } @@ -3557,11 +3557,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLLAA $1 $> (Or [h,$3])) } } + ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLLAA (head $1) (last $1) (And ($1)) } + { reLocA $ sLL (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -3577,7 +3577,7 @@ name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } namelist :: { Located [LocatedN RdrName] } namelist : name_var { sL1N $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} name_var :: { LocatedN RdrName } name_var : var { $1 } @@ -3609,12 +3609,12 @@ con :: { LocatedN RdrName } con_list :: { Located (NonEmpty (LocatedN RdrName)) } con_list : con { sL1N $1 (pure $1) } - | con ',' con_list {% sLL (reLocN $1) $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } + | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } qcon_list : qcon { sL1N $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} -- See Note [ExplicitTuple] in GHC.Hs.Expr sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors @@ -4141,30 +4141,17 @@ sL1n :: Located a -> b -> LocatedN b sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} -sLL :: Located a -> Located b -> c -> Located c +sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} sLLa :: Located a -> Located b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) -{-# INLINE sLLlA #-} -sLLlA :: Located a -> LocatedAn t b -> c -> Located c -sLLlA x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) - -{-# INLINE sLLAl #-} -sLLAl :: LocatedAn t a -> Located b -> c -> Located c -sLLAl x y = sL (comb2 y x) -- #define LL sL (comb2 $1 $>) - {-# INLINE sLLAsl #-} -sLLAsl :: [LocatedAn t a] -> Located b -> c -> Located c +sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c sLLAsl [] = sL1 -sLLAsl (x:_) = sLLAl x - -{-# INLINE sLLAA #-} -sLLAA :: LocatedAn t a -> LocatedAn u b -> c -> Located c -sLLAA x y = sL (comb2 (reLoc y) (reLoc x)) -- #define LL sL (comb2 $1 $>) - +sLLAsl (x:_) = sLL x {- Note [Adding location info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== m4/find_python.m4 ===================================== @@ -5,6 +5,11 @@ AC_DEFUN([FIND_PYTHON],[ dnl Prefer the mingw64 distribution on Windows due to #17483. AC_PATH_PROG([PYTHON], [python3], [], [/mingw64/bin $PATH]) - PythonCmd="$PYTHON" + if test "$HostOS" = "mingw32" + then + PythonCmd=$(cygpath -m "$PYTHON") + else + PythonCmd="$PYTHON" + fi AC_SUBST([PythonCmd]) ]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c6f1f9a4f0873de5c91504175ec19fb76f74668...2f50b177ddd86f20a5fd42b1ab001a33e0474954 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c6f1f9a4f0873de5c91504175ec19fb76f74668...2f50b177ddd86f20a5fd42b1ab001a33e0474954 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 05:03:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 15 Jul 2023 01:03:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: EPA: Simplify GHC/Parser.y sLL Message-ID: <64b228a3ca21b_3edd85127ee50c1972fc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3c5dfad3 by Alan Zimmerman at 2023-07-15T01:03:13-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 20a86fe9 by sheaf at 2023-07-15T01:03:19-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - 1027e6f7 by Rodrigo Mesquita at 2023-07-15T01:03:19-04:00 Improve Note [Binder-swap during float-out] - - - - - 3 changed files: - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Parser.y - m4/find_python.m4 Changes: ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -44,13 +44,33 @@ case x of wild { p -> ...wild... } we substitute x for wild in the RHS of the case alternatives: case x of wild { p -> ...x... } - This means that a sub-expression involving x is not "trapped" inside the RHS. + This means that a sub-expression involving x is not "trapped" inside the RHS + (i.e. it can now be floated out, whereas if it mentioned wild it could not). And it's not inconvenient because we already have a substitution. - Note that this is EXACTLY BACKWARDS from the what the simplifier does. - The simplifier tries to get rid of occurrences of x, in favour of wild, - in the hope that there will only be one remaining occurrence of x, namely - the scrutinee of the case, and we can inline it. + For example, consider: + + f x = letrec go y = case x of z { (a,b) -> ...(expensive z)... } + in ... + + If we do the reverse binder-swap we get + + f x = letrec go y = case x of z { (a,b) -> ...(expensive x)... } + in ... + + and now we can float out: + + f x = let t = expensive x + in letrec go y = case x of z { (a,b) -> ...(t)... } + in ... + + Now (expensive x) is computed once, rather than once each time around the 'go' loop. + + Note that this is EXACTLY BACKWARDS from the what the simplifier does. + The simplifier tries to get rid of occurrences of x, in favour of wild, + in the hope that there will only be one remaining occurrence of x, namely + the scrutinee of the case, and we can inline it. + -} module GHC.Core.Opt.SetLevels ( ===================================== compiler/GHC/Parser.y ===================================== @@ -804,12 +804,12 @@ msubsts :: { OrdList (LHsModuleSubst PackageName) } | msubst { unitOL $1 } msubst :: { LHsModuleSubst PackageName } - : modid '=' moduleid { sLL (reLoc $1) $> $ (reLoc $1, $3) } - | modid VARSYM modid VARSYM { sLL (reLoc $1) $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } + : modid '=' moduleid { sLL $1 $> $ (reLoc $1, $3) } + | modid VARSYM modid VARSYM { sLL $1 $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } moduleid :: { LHsModuleId PackageName } : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar (reLoc $2) } - | unitid ':' modid { sLL $1 (reLoc $>) $ HsModuleId $1 (reLoc $3) } + | unitid ':' modid { sLL $1 $> $ HsModuleId $1 (reLoc $3) } pkgname :: { Located PackageName } : STRING { sL1 $1 $ PackageName (getSTRING $1) } @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL (reLoc $1) (reLoc $>) $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1168,7 +1168,7 @@ optqualified :: { Located (Maybe EpaLocation) } maybeas :: { (Maybe EpaLocation,Located (Maybe (LocatedA ModuleName))) } : 'as' modid { (Just (glAA $1) - ,sLL $1 (reLoc $>) (Just $2)) } + ,sLL $1 $> (Just $2)) } | {- empty -} { (Nothing,noLoc Nothing) } maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])) } @@ -1209,9 +1209,9 @@ importlist1 :: { OrdList (LIE GhcPs) } | import { $1 } import :: { OrdList (LIE GhcPs) } - : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL (reLoc $1) $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } - | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 (reLocN $>) $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } + | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1230,7 +1230,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } : ops ',' op {% case (unLoc $1) of SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) - return (sLL $1 (reLocN $>) (snocOL hs t' `appOL` unitOL $3)) } + return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } | op { sL1N $1 (unitOL $1) } ----------------------------------------------------------------------------- @@ -1357,7 +1357,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order {% case unLoc $1 of (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | oqtycon { sL1N $1 [$1] } inst_decl :: { LInstDecl GhcPs } @@ -1415,7 +1415,7 @@ deriv_strategy_no_via :: { LDerivStrategy GhcPs } | 'newtype' {% acsA (\cs -> sL1 $1 (NewtypeStrategy (EpAnn (glR $1) [mj AnnNewtype $1] cs))) } deriv_strategy_via :: { LDerivStrategy GhcPs } - : 'via' sigktype {% acsA (\cs -> sLLlA $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) + : 'via' sigktype {% acsA (\cs -> sLL $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) $2))) } deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } @@ -1429,15 +1429,15 @@ deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) } : {- empty -} { noLoc ([], Nothing) } - | '|' injectivity_cond { sLL $1 (reLoc $>) ([mj AnnVbar $1] + | '|' injectivity_cond { sLL $1 $> ([mj AnnVbar $1] , Just ($2)) } injectivity_cond :: { LInjectivityAnn GhcPs } : tyvarid '->' inj_varids - {% acsA (\cs -> sLL (reLocN $1) $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } + {% acsA (\cs -> sLL $1 $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } inj_varids :: { Located [LocatedN RdrName] } - : inj_varids tyvarid { sLL $1 (reLocN $>) ($2 : unLoc $1) } + : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } | tyvarid { sL1N $1 [$1] } -- Closed type families @@ -1462,16 +1462,16 @@ ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] } : ty_fam_inst_eqns ';' ty_fam_inst_eqn {% let (L loc eqn) = $3 in case unLoc $1 of - [] -> return (sLLlA $1 $> (L loc eqn : unLoc $1)) + [] -> return (sLL $1 $> (L loc eqn : unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLLlA $1 $> ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | ty_fam_inst_eqns ';' {% case unLoc $1 of [] -> return (sLL $1 $> (unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | ty_fam_inst_eqn { sLLAA $1 $> [$1] } + | ty_fam_inst_eqn { sLL $1 $> [$1] } | {- empty -} { noLoc [] } ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } @@ -1572,26 +1572,26 @@ data_or_newtype :: { Located (AddEpAnn, NewOrData) } opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } : { noLoc ([] , Nothing) } - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], Just $2) } + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } - | '::' kind { sLL $1 (reLoc $>) ( [mu AnnDcolon $1] + | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1, mj AnnVbar $3] + ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, @@ -1602,14 +1602,14 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- T Int [a] -- for associated types -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } - : context '=>' type {% acs (\cs -> (sLLAA $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } + : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } | type { sL1A $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 >> fromSpecTyVarBndrs $2 >>= \tvbs -> - (acs (\cs -> (sLL $1 (reLoc $>) + (acs (\cs -> (sLL $1 $> (Just ( addTrailingDarrowC $4 $5 cs) , mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6)))) } @@ -1619,7 +1619,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; cs <- getCommentsFor loc ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } - | context '=>' type {% acs (\cs -> (sLLAA $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } + | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } @@ -1643,7 +1643,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type {% do { let { err = text "in the stand-alone deriving instance" <> colon <+> quotes (ppr $5) } - ; acsA (\cs -> sLL $1 (reLoc $>) + ; acsA (\cs -> sLL $1 $> (DerivDecl (EpAnn (glR $1) [mj AnnDeriving $1, mj AnnInstance $3] cs) (mkHsWildCardBndrs $5) $2 $4)) }} ----------------------------------------------------------------------------- @@ -1674,19 +1674,19 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl GhcPs } : 'pattern' pattern_synonym_lhs '=' pat {% let (name, args, as ) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 ImplicitBidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1, mj AnnEqual $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat {% let (name, args, as) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 Unidirectional + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat where_decls {% do { let (name, args, as) = $2 ; mg <- mkPatSynMatchGroup name $5 - ; acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ + ; acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 (ExplicitBidirectional mg) (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) }} @@ -1713,7 +1713,7 @@ where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype - {% acsA (\cs -> sLL $1 (reLoc $>) + {% acsA (\cs -> sLL $1 $> $ PatSynSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnPattern $1]) cs) (toList $ unLoc $2) $4) } @@ -1736,16 +1736,16 @@ decl_cls : at_decl_cls { $1 } do { v <- checkValSigLhs $2 ; let err = text "in default signature" <> colon <+> quotes (ppr $2) - ; acsA (\cs -> sLL $1 (reLoc $>) $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do t' <- addTrailingSemiA t (gl $2) - return (sLLlA $1 $> (fst $ unLoc $1 + return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t' `appOL` unitOL $3)) } | decls_cls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> ( (fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -1824,7 +1824,7 @@ where_inst :: { Located ([AddEpAnn] -- decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } : decls ';' decl {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1833,7 +1833,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } rest = snocOL hs t'; these = rest `appOL` this } return (rest `seq` this `seq` these `seq` - (sLLlA $1 $> (fst $ unLoc $1, these))) } + (sLL $1 $> (fst $ unLoc $1, these))) } | decls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2) ,snd $ unLoc $1))) @@ -1896,7 +1896,7 @@ rule :: { LRuleDecl GhcPs } : STRING rule_activation rule_foralls infixexp '=' exp {%runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acsA (\cs -> (sLLlA $1 $> $ HsRule + acsA (\cs -> (sLL $1 $> $ HsRule { rd_ext = (EpAnn (glR $1) ((fstOf3 $3) (mj AnnEqual $5 : (fst $2))) cs, getSTRINGs $1) , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRING $1) , rd_act = (snd $2) `orElse` AlwaysActive @@ -2103,10 +2103,10 @@ safety :: { Located Safety } fspec :: { Located ([AddEpAnn] ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)) } - : STRING var '::' sigtype { sLL $1 (reLoc $>) ([mu AnnDcolon $3] + : STRING var '::' sigtype { sLL $1 $> ([mu AnnDcolon $3] ,(L (getLoc $1) (getStringLiteral $1), $2, $4)) } - | var '::' sigtype { sLL (reLocN $1) (reLoc $>) ([mu AnnDcolon $2] + | var '::' sigtype { sLL $1 $> ([mu AnnDcolon $2] ,(noLoc (StringLiteral NoSourceText nilFS Nothing), $1, $3)) } -- if the entity string is missing, it defaults to the empty string; -- the meaning of an empty entity string depends on the calling @@ -2127,8 +2127,8 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } -- See Note [forall-or-nothing rule] in GHC.Hs.Type. sigktype :: { LHsSigType GhcPs } : sigtype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ + sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2139,10 +2139,10 @@ sigtype :: { LHsSigType GhcPs } sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order : sig_vars ',' var {% case unLoc $1 of - [] -> return (sLL $1 (reLocN $>) ($3 : unLoc $1)) + [] -> return (sLL $1 $> ($3 : unLoc $1)) (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | var { sL1N $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } @@ -2168,7 +2168,7 @@ forall_telescope :: { Located (HsForAllTelescope GhcPs) } -- A ktype is a ctype, possibly with a kind annotation ktype :: { LHsType GhcPs } : ctype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- A ctype is a for-all type ctype :: { LHsType GhcPs } @@ -2176,12 +2176,12 @@ ctype :: { LHsType GhcPs } HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } - | context '=>' ctype {% acsA (\cs -> (sLL (reLoc $1) (reLoc $>) $ + | context '=>' ctype {% acsA (\cs -> (sLL $1 $> $ HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs , hst_xqual = NoExtField , hst_body = $3 })) } - | ipvar '::' ctype {% acsA (\cs -> sLL $1 (reLoc $>) (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } + | ipvar '::' ctype {% acsA (\cs -> sLL $1 $> (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } | type { $1 } ---------------------- @@ -2213,21 +2213,21 @@ is connected to the first type too. type :: { LHsType GhcPs } -- See Note [%shift: type -> btype] : btype %shift { $1 } - | btype '->' ctype {% acsA (\cs -> sLL (reLoc $1) (reLoc $>) + | btype '->' ctype {% acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsUnrestrictedArrow (hsUniTok $2)) $1 $3) } | btype mult '->' ctype {% hintLinear (getLoc $2) >> let arr = (unLoc $2) (hsUniTok $3) - in acsA (\cs -> sLL (reLoc $1) (reLoc $>) + in acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) arr $1 $4) } | btype '->.' ctype {% hintLinear (getLoc $2) >> - acsA (\cs -> sLL (reLoc $1) (reLoc $>) + acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsLinearArrow (HsLolly (hsTok $2))) $1 $3) } -- [mu AnnLollyU $2] } mult :: { Located (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs) } - : PREFIX_PERCENT atype { sLL $1 (reLoc $>) (mkMultTy (hsTok $1) $2) } + : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy (hsTok $1) $2) } btype :: { LHsType GhcPs } : infixtype {% runPV $1 } @@ -2258,10 +2258,10 @@ tyarg :: { LHsType GhcPs } tyop :: { (LocatedN RdrName, PromotionFlag) } : qtyconop { ($1, NotPromoted) } | tyvarop { ($1, NotPromoted) } - | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } - | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } @@ -2273,8 +2273,8 @@ atype :: { LHsType GhcPs } ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer - | PREFIX_TILDE atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } - | PREFIX_BANG atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } + | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } + | PREFIX_BANG atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } | '{' fielddecls '}' {% do { decls <- acsA (\cs -> (sLL $1 $> $ HsRecTy (EpAnn (glR $1) (AnnList (Just $ listAsAnchor $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) $2)) ; checkRecordSyntax decls }} @@ -2292,12 +2292,12 @@ atype :: { LHsType GhcPs } | quasiquote { mapLocA (HsSpliceTy noExtField) $1 } | splice_untyped { mapLocA (HsSpliceTy noExtField) $1 } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } | SIMPLEQUOTE '(' ktype ',' comma_types1 ')' {% do { h <- addTrailingCommaA $3 (gl $4) ; acsA (\cs -> sLL $1 $> $ HsExplicitTupleTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mop $2,mcp $6] cs) (h : $5)) }} | SIMPLEQUOTE '[' comma_types0 ']' {% acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mos $2,mcs $4] cs) IsPromoted $3) } - | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } -- Two or more [ty, ty, ty] must be a promoted list type, just as -- if you had written '[ty, ty, ty] @@ -2366,7 +2366,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } : fds1 ',' fd {% do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | fd { sL1A $1 [$1] } fd :: { LHsFunDep GhcPs } @@ -2377,7 +2377,7 @@ fd :: { LHsFunDep GhcPs } varids0 :: { Located [LocatedN RdrName] } : {- empty -} { noLoc [] } - | varids0 tyvar { sLL $1 (reLocN $>) ($2 : (unLoc $1)) } + | varids0 tyvar { sLL $1 $> ($2 : (unLoc $1)) } ----------------------------------------------------------------------------- -- Kinds @@ -2464,7 +2464,7 @@ constrs1 :: { Located [LConDecl GhcPs] } : constrs1 '|' constr {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | constr { sL1A $1 [$1] } constr :: { LConDecl GhcPs } @@ -2518,7 +2518,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } - : derivings deriving { sLL $1 (reLoc $>) ($2 : unLoc $1) } -- AZ: order? + : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? | deriving { sL1 (reLoc $>) [$1] } -- The outer Located is just to allow the caller to @@ -2603,7 +2603,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } (GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }} gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } - : gdrhs gdrh { sLL $1 (reLoc $>) ($2 : unLoc $1) } + : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } | gdrh { sL1 (reLoc $1) [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } @@ -2616,14 +2616,14 @@ sigdecl :: { LHsDecl GhcPs } infixexp '::' sigtype {% do { $1 <- runPV (unECP $1) ; v <- checkValSigLhs $1 - ; acsA (\cs -> (sLLAl $1 (reLoc $>) $ SigD noExtField $ + ; acsA (\cs -> (sLL $1 $> $ SigD noExtField $ TypeSig (EpAnn (glAR $1) (AnnSig (mu AnnDcolon $2) []) cs) [v] (mkHsWildCardBndrs $3)))} } | var ',' sig_vars '::' sigtype {% do { v <- addTrailingCommaN $1 (gl $2) ; let sig cs = TypeSig (EpAnn (glNR $1) (AnnSig (mu AnnDcolon $4) []) cs) (v : reverse (unLoc $3)) (mkHsWildCardBndrs $5) - ; acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ SigD noExtField (sig cs) ) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField (sig cs) ) }} | infix prec ops {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $3 @@ -2717,22 +2717,22 @@ exp :: { ECP } | infixexp '-<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 HsFirstOrderApp True) } | infixexp '>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 HsFirstOrderApp False) } | infixexp '-<<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 HsHigherOrderApp True) } | infixexp '>>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 HsHigherOrderApp False) } -- See Note [%shift: exp -> infixexp] | infixexp %shift { $1 } @@ -2758,7 +2758,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLLlA $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2845,7 +2845,7 @@ fexp :: { ECP } | 'static' aexp {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 (reLoc $>) $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } + acsA (\cs -> sLL $1 $> $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } | aexp { $1 } @@ -2872,8 +2872,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLLlA $1 $> - [reLocA $ sLLlA $1 $> + (reLocA $ sLL $1 $> + [reLocA $ sLL $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2929,7 +2929,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLLlA $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -3000,10 +3000,10 @@ aexp2 :: { ECP } | splice_untyped { ECP $ pvA $ mkHsSplicePV $1 } | splice_typed { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLocA $1) } - | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } - | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } -- See Note [%shift: aexp2 -> TH_TY_QUOTE] | TH_TY_QUOTE %shift {% reportEmptyDoubleQuotes (getLoc $1) } | '[|' exp '|]' {% runPV (unECP $2) >>= \ $2 -> @@ -3032,8 +3032,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3042,13 +3042,13 @@ splice_exp :: { LHsExpr GhcPs } splice_untyped :: { Located (HsUntypedSplice GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } + acs (\cs -> sLL $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } splice_typed :: { Located ((EpAnnCO, EpAnn [AddEpAnn]), LHsExpr GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } + acs (\cs -> sLL $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } cmdargs :: { [LHsCmdTop GhcPs] } : cmdargs acmd { $2 : $1 } @@ -3093,7 +3093,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL (reLoc $1) (reLocN $>) $ SectionL noAnn $1 (n2l $2) } + reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3233,7 +3233,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3249,20 +3249,20 @@ transformqual :: { Located (RealSrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> Stmt -- Function is applied to a list of stmts *in order* : 'then' exp {% runPV (unECP $2) >>= \ $2 -> acs (\cs-> - sLLlA $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } + sLL $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } | 'then' exp 'by' exp {% runPV (unECP $2) >>= \ $2 -> runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkTransformByStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnBy $3] cs) ss $2 $4))) } | 'then' 'group' 'using' exp {% runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] cs) ss $4))) } | 'then' 'group' 'by' exp 'using' exp {% runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupByUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] cs) ss $4 $6))) } -- Note that 'group' is a special_id, which means that you can enable @@ -3281,7 +3281,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3309,11 +3309,11 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs : alts1(PATS) ';' alt(PATS) { $1 >>= \ $1 -> $3 >>= \ $3 -> case snd $ unLoc $1 of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) ++ (mz AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) ,[$3])) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLL $1 (reLoc $>) (fst $ unLoc $1,$3 : h' : t)) } + return (sLL $1 $> (fst $ unLoc $1,$3 : h' : t)) } | alts1(PATS) ';' { $1 >>= \ $1 -> case snd $ unLoc $1 of [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -3338,7 +3338,7 @@ alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) } ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : '->' exp { unECP $2 >>= \ $2 -> - acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } + acs (\cs -> sLL $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } | gdpats { $1 >>= \gdpats -> return $ sL1 gdpats (reverse (unLoc gdpats)) } @@ -3405,11 +3405,11 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( : stmts ';' stmt { $1 >>= \ $1 -> $3 >>= \ ($3 :: LStmt GhcPs (LocatedA b)) -> case (snd $ unLoc $1) of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) ,$3 : (snd $ unLoc $1))) (h:t) -> do { h' <- addTrailingSemiA h (gl $2) - ; return $ sLL $1 (reLoc $>) (fst $ unLoc $1,$3 :(h':t)) }} + ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(h':t)) }} | stmts ';' { $1 >>= \ $1 -> case (snd $ unLoc $1) of @@ -3435,13 +3435,13 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : qual { $1 } | 'rec' stmtlist { $2 >>= \ $2 -> - acsA (\cs -> (sLL $1 (reLoc $>) $ mkRecStmt + acsA (\cs -> (sLL $1 $> $ mkRecStmt (EpAnn (glR $1) (hsDoAnn $1 $2 AnnRec) cs) $2)) } qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : bindpat '<-' exp { unECP $3 >>= \ $3 -> - acsA (\cs -> sLLlA (reLoc $1) $> + acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> return $ sL1 $1 $ mkBodyStmt $1 } @@ -3467,7 +3467,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... @@ -3512,7 +3512,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3525,7 +3525,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (let { this = $3; rest = h':t } - in rest `seq` this `seq` sLL $1 (reLoc $>) (this : rest)) } + in rest `seq` this `seq` sLL $1 $> (this : rest)) } | dbinds ';' {% case unLoc $1 of (h:t) -> do h' <- addTrailingSemiA h (gl $2) @@ -3535,7 +3535,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed dbind :: { LIPBind GhcPs } dbind : ipvar '=' exp {% runPV (unECP $3) >>= \ $3 -> - acsA (\cs -> sLLlA $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } + acsA (\cs -> sLL $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } ipvar :: { Located HsIPName } : IPDUPVARID { sL1 $1 (HsIPName (getIPDUPVARID $1)) } @@ -3557,11 +3557,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLLAA $1 $> (Or [h,$3])) } } + ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLLAA (head $1) (last $1) (And ($1)) } + { reLocA $ sLL (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -3577,7 +3577,7 @@ name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } namelist :: { Located [LocatedN RdrName] } namelist : name_var { sL1N $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} name_var :: { LocatedN RdrName } name_var : var { $1 } @@ -3609,12 +3609,12 @@ con :: { LocatedN RdrName } con_list :: { Located (NonEmpty (LocatedN RdrName)) } con_list : con { sL1N $1 (pure $1) } - | con ',' con_list {% sLL (reLocN $1) $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } + | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } qcon_list : qcon { sL1N $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} -- See Note [ExplicitTuple] in GHC.Hs.Expr sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors @@ -4141,30 +4141,17 @@ sL1n :: Located a -> b -> LocatedN b sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} -sLL :: Located a -> Located b -> c -> Located c +sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} sLLa :: Located a -> Located b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) -{-# INLINE sLLlA #-} -sLLlA :: Located a -> LocatedAn t b -> c -> Located c -sLLlA x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) - -{-# INLINE sLLAl #-} -sLLAl :: LocatedAn t a -> Located b -> c -> Located c -sLLAl x y = sL (comb2 y x) -- #define LL sL (comb2 $1 $>) - {-# INLINE sLLAsl #-} -sLLAsl :: [LocatedAn t a] -> Located b -> c -> Located c +sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c sLLAsl [] = sL1 -sLLAsl (x:_) = sLLAl x - -{-# INLINE sLLAA #-} -sLLAA :: LocatedAn t a -> LocatedAn u b -> c -> Located c -sLLAA x y = sL (comb2 (reLoc y) (reLoc x)) -- #define LL sL (comb2 $1 $>) - +sLLAsl (x:_) = sLL x {- Note [Adding location info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== m4/find_python.m4 ===================================== @@ -5,6 +5,11 @@ AC_DEFUN([FIND_PYTHON],[ dnl Prefer the mingw64 distribution on Windows due to #17483. AC_PATH_PROG([PYTHON], [python3], [], [/mingw64/bin $PATH]) - PythonCmd="$PYTHON" + if test "$HostOS" = "mingw32" + then + PythonCmd=$(cygpath -m "$PYTHON") + else + PythonCmd="$PYTHON" + fi AC_SUBST([PythonCmd]) ]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f50b177ddd86f20a5fd42b1ab001a33e0474954...1027e6f74931ab3c791b536bbed85132c6bb90d5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f50b177ddd86f20a5fd42b1ab001a33e0474954...1027e6f74931ab3c791b536bbed85132c6bb90d5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 07:23:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 15 Jul 2023 03:23:51 -0400 Subject: [Git][ghc/ghc][master] EPA: Simplify GHC/Parser.y sLL Message-ID: <64b24987b2eb_3edd85127ee50c224946@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -804,12 +804,12 @@ msubsts :: { OrdList (LHsModuleSubst PackageName) } | msubst { unitOL $1 } msubst :: { LHsModuleSubst PackageName } - : modid '=' moduleid { sLL (reLoc $1) $> $ (reLoc $1, $3) } - | modid VARSYM modid VARSYM { sLL (reLoc $1) $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } + : modid '=' moduleid { sLL $1 $> $ (reLoc $1, $3) } + | modid VARSYM modid VARSYM { sLL $1 $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) } moduleid :: { LHsModuleId PackageName } : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar (reLoc $2) } - | unitid ':' modid { sLL $1 (reLoc $>) $ HsModuleId $1 (reLoc $3) } + | unitid ':' modid { sLL $1 $> $ HsModuleId $1 (reLoc $3) } pkgname :: { Located PackageName } : STRING { sL1 $1 $ PackageName (getSTRING $1) } @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL (reLoc $1) (reLoc $>) $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1168,7 +1168,7 @@ optqualified :: { Located (Maybe EpaLocation) } maybeas :: { (Maybe EpaLocation,Located (Maybe (LocatedA ModuleName))) } : 'as' modid { (Just (glAA $1) - ,sLL $1 (reLoc $>) (Just $2)) } + ,sLL $1 $> (Just $2)) } | {- empty -} { (Nothing,noLoc Nothing) } maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])) } @@ -1209,9 +1209,9 @@ importlist1 :: { OrdList (LIE GhcPs) } | import { $1 } import :: { OrdList (LIE GhcPs) } - : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL (reLoc $1) $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } - | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 (reLocN $>) $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } + | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1230,7 +1230,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } : ops ',' op {% case (unLoc $1) of SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) - return (sLL $1 (reLocN $>) (snocOL hs t' `appOL` unitOL $3)) } + return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } | op { sL1N $1 (unitOL $1) } ----------------------------------------------------------------------------- @@ -1357,7 +1357,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order {% case unLoc $1 of (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | oqtycon { sL1N $1 [$1] } inst_decl :: { LInstDecl GhcPs } @@ -1415,7 +1415,7 @@ deriv_strategy_no_via :: { LDerivStrategy GhcPs } | 'newtype' {% acsA (\cs -> sL1 $1 (NewtypeStrategy (EpAnn (glR $1) [mj AnnNewtype $1] cs))) } deriv_strategy_via :: { LDerivStrategy GhcPs } - : 'via' sigktype {% acsA (\cs -> sLLlA $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) + : 'via' sigktype {% acsA (\cs -> sLL $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glR $1) [mj AnnVia $1] cs) $2))) } deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } @@ -1429,15 +1429,15 @@ deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) } : {- empty -} { noLoc ([], Nothing) } - | '|' injectivity_cond { sLL $1 (reLoc $>) ([mj AnnVbar $1] + | '|' injectivity_cond { sLL $1 $> ([mj AnnVbar $1] , Just ($2)) } injectivity_cond :: { LInjectivityAnn GhcPs } : tyvarid '->' inj_varids - {% acsA (\cs -> sLL (reLocN $1) $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } + {% acsA (\cs -> sLL $1 $> (InjectivityAnn (EpAnn (glNR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) } inj_varids :: { Located [LocatedN RdrName] } - : inj_varids tyvarid { sLL $1 (reLocN $>) ($2 : unLoc $1) } + : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } | tyvarid { sL1N $1 [$1] } -- Closed type families @@ -1462,16 +1462,16 @@ ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] } : ty_fam_inst_eqns ';' ty_fam_inst_eqn {% let (L loc eqn) = $3 in case unLoc $1 of - [] -> return (sLLlA $1 $> (L loc eqn : unLoc $1)) + [] -> return (sLL $1 $> (L loc eqn : unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLLlA $1 $> ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | ty_fam_inst_eqns ';' {% case unLoc $1 of [] -> return (sLL $1 $> (unLoc $1)) (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | ty_fam_inst_eqn { sLLAA $1 $> [$1] } + | ty_fam_inst_eqn { sLL $1 $> [$1] } | {- empty -} { noLoc [] } ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs } @@ -1572,26 +1572,26 @@ data_or_newtype :: { Located (AddEpAnn, NewOrData) } opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } : { noLoc ([] , Nothing) } - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], Just $2) } + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 (reLoc $>) ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } - | '::' kind { sLL $1 (reLoc $>) ( [mu AnnDcolon $1] + | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 (reLoc $>) ([mj AnnEqual $1, mj AnnVbar $3] + ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, @@ -1602,14 +1602,14 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- T Int [a] -- for associated types -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } - : context '=>' type {% acs (\cs -> (sLLAA $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } + : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } | type { sL1A $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 >> fromSpecTyVarBndrs $2 >>= \tvbs -> - (acs (\cs -> (sLL $1 (reLoc $>) + (acs (\cs -> (sLL $1 $> (Just ( addTrailingDarrowC $4 $5 cs) , mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6)))) } @@ -1619,7 +1619,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; cs <- getCommentsFor loc ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } - | context '=>' type {% acs (\cs -> (sLLAA $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } + | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } @@ -1643,7 +1643,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs } : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type {% do { let { err = text "in the stand-alone deriving instance" <> colon <+> quotes (ppr $5) } - ; acsA (\cs -> sLL $1 (reLoc $>) + ; acsA (\cs -> sLL $1 $> (DerivDecl (EpAnn (glR $1) [mj AnnDeriving $1, mj AnnInstance $3] cs) (mkHsWildCardBndrs $5) $2 $4)) }} ----------------------------------------------------------------------------- @@ -1674,19 +1674,19 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 } pattern_synonym_decl :: { LHsDecl GhcPs } : 'pattern' pattern_synonym_lhs '=' pat {% let (name, args, as ) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 ImplicitBidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1, mj AnnEqual $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat {% let (name, args, as) = $2 in - acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ mkPatSynBind name args $4 Unidirectional + acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) } | 'pattern' pattern_synonym_lhs '<-' pat where_decls {% do { let (name, args, as) = $2 ; mg <- mkPatSynMatchGroup name $5 - ; acsA (\cs -> sLL $1 (reLoc $>) . ValD noExtField $ + ; acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 (ExplicitBidirectional mg) (EpAnn (glR $1) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) }} @@ -1713,7 +1713,7 @@ where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype - {% acsA (\cs -> sLL $1 (reLoc $>) + {% acsA (\cs -> sLL $1 $> $ PatSynSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnPattern $1]) cs) (toList $ unLoc $2) $4) } @@ -1736,16 +1736,16 @@ decl_cls : at_decl_cls { $1 } do { v <- checkValSigLhs $2 ; let err = text "in default signature" <> colon <+> quotes (ppr $2) - ; acsA (\cs -> sLL $1 (reLoc $>) $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField $ ClassOpSig (EpAnn (glR $1) (AnnSig (mu AnnDcolon $3) [mj AnnDefault $1]) cs) True [v] $4) }} decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_cls ';' decl_cls {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do t' <- addTrailingSemiA t (gl $2) - return (sLLlA $1 $> (fst $ unLoc $1 + return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t' `appOL` unitOL $3)) } | decls_cls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> ( (fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -1824,7 +1824,7 @@ where_inst :: { Located ([AddEpAnn] -- decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } : decls ';' decl {% if isNilOL (snd $ unLoc $1) - then return (sLLlA $1 $> ((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1833,7 +1833,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } rest = snocOL hs t'; these = rest `appOL` this } return (rest `seq` this `seq` these `seq` - (sLLlA $1 $> (fst $ unLoc $1, these))) } + (sLL $1 $> (fst $ unLoc $1, these))) } | decls ';' {% if isNilOL (snd $ unLoc $1) then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2) ,snd $ unLoc $1))) @@ -1896,7 +1896,7 @@ rule :: { LRuleDecl GhcPs } : STRING rule_activation rule_foralls infixexp '=' exp {%runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acsA (\cs -> (sLLlA $1 $> $ HsRule + acsA (\cs -> (sLL $1 $> $ HsRule { rd_ext = (EpAnn (glR $1) ((fstOf3 $3) (mj AnnEqual $5 : (fst $2))) cs, getSTRINGs $1) , rd_name = L (noAnnSrcSpan $ gl $1) (getSTRING $1) , rd_act = (snd $2) `orElse` AlwaysActive @@ -2103,10 +2103,10 @@ safety :: { Located Safety } fspec :: { Located ([AddEpAnn] ,(Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)) } - : STRING var '::' sigtype { sLL $1 (reLoc $>) ([mu AnnDcolon $3] + : STRING var '::' sigtype { sLL $1 $> ([mu AnnDcolon $3] ,(L (getLoc $1) (getStringLiteral $1), $2, $4)) } - | var '::' sigtype { sLL (reLocN $1) (reLoc $>) ([mu AnnDcolon $2] + | var '::' sigtype { sLL $1 $> ([mu AnnDcolon $2] ,(noLoc (StringLiteral NoSourceText nilFS Nothing), $1, $3)) } -- if the entity string is missing, it defaults to the empty string; -- the meaning of an empty entity string depends on the calling @@ -2127,8 +2127,8 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } -- See Note [forall-or-nothing rule] in GHC.Hs.Type. sigktype :: { LHsSigType GhcPs } : sigtype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ + sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2139,10 +2139,10 @@ sigtype :: { LHsSigType GhcPs } sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order : sig_vars ',' var {% case unLoc $1 of - [] -> return (sLL $1 (reLocN $>) ($3 : unLoc $1)) + [] -> return (sLL $1 $> ($3 : unLoc $1)) (h:t) -> do h' <- addTrailingCommaN h (gl $2) - return (sLL $1 (reLocN $>) ($3 : h' : t)) } + return (sLL $1 $> ($3 : h' : t)) } | var { sL1N $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } @@ -2168,7 +2168,7 @@ forall_telescope :: { Located (HsForAllTelescope GhcPs) } -- A ktype is a ctype, possibly with a kind annotation ktype :: { LHsType GhcPs } : ctype { $1 } - | ctype '::' kind {% acsA (\cs -> sLLAA $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- A ctype is a for-all type ctype :: { LHsType GhcPs } @@ -2176,12 +2176,12 @@ ctype :: { LHsType GhcPs } HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } - | context '=>' ctype {% acsA (\cs -> (sLL (reLoc $1) (reLoc $>) $ + | context '=>' ctype {% acsA (\cs -> (sLL $1 $> $ HsQualTy { hst_ctxt = addTrailingDarrowC $1 $2 cs , hst_xqual = NoExtField , hst_body = $3 })) } - | ipvar '::' ctype {% acsA (\cs -> sLL $1 (reLoc $>) (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } + | ipvar '::' ctype {% acsA (\cs -> sLL $1 $> (HsIParamTy (EpAnn (glR $1) [mu AnnDcolon $2] cs) (reLocA $1) $3)) } | type { $1 } ---------------------- @@ -2213,21 +2213,21 @@ is connected to the first type too. type :: { LHsType GhcPs } -- See Note [%shift: type -> btype] : btype %shift { $1 } - | btype '->' ctype {% acsA (\cs -> sLL (reLoc $1) (reLoc $>) + | btype '->' ctype {% acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsUnrestrictedArrow (hsUniTok $2)) $1 $3) } | btype mult '->' ctype {% hintLinear (getLoc $2) >> let arr = (unLoc $2) (hsUniTok $3) - in acsA (\cs -> sLL (reLoc $1) (reLoc $>) + in acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) arr $1 $4) } | btype '->.' ctype {% hintLinear (getLoc $2) >> - acsA (\cs -> sLL (reLoc $1) (reLoc $>) + acsA (\cs -> sLL $1 $> $ HsFunTy (EpAnn (glAR $1) NoEpAnns cs) (HsLinearArrow (HsLolly (hsTok $2))) $1 $3) } -- [mu AnnLollyU $2] } mult :: { Located (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs) } - : PREFIX_PERCENT atype { sLL $1 (reLoc $>) (mkMultTy (hsTok $1) $2) } + : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy (hsTok $1) $2) } btype :: { LHsType GhcPs } : infixtype {% runPV $1 } @@ -2258,10 +2258,10 @@ tyarg :: { LHsType GhcPs } tyop :: { (LocatedN RdrName, PromotionFlag) } : qtyconop { ($1, NotPromoted) } | tyvarop { ($1, NotPromoted) } - | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE qconop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } - | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 (reLoc $>) (unLoc $2)) + | SIMPLEQUOTE varop {% do { op <- amsrn (sLL $1 $> (unLoc $2)) (NameAnnQuote (glAA $1) (gl $2) []) ; return (op, IsPromoted) } } @@ -2273,8 +2273,8 @@ atype :: { LHsType GhcPs } ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer - | PREFIX_TILDE atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } - | PREFIX_BANG atype {% acsA (\cs -> sLLlA $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } + | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } + | PREFIX_BANG atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnBang $1] cs) SrcStrict $2)) } | '{' fielddecls '}' {% do { decls <- acsA (\cs -> (sLL $1 $> $ HsRecTy (EpAnn (glR $1) (AnnList (Just $ listAsAnchor $2) (Just $ moc $1) (Just $ mcc $3) [] []) cs) $2)) ; checkRecordSyntax decls }} @@ -2292,12 +2292,12 @@ atype :: { LHsType GhcPs } | quasiquote { mapLocA (HsSpliceTy noExtField) $1 } | splice_untyped { mapLocA (HsSpliceTy noExtField) $1 } -- see Note [Promotion] for the followings - | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE qcon_nowiredlist {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } | SIMPLEQUOTE '(' ktype ',' comma_types1 ')' {% do { h <- addTrailingCommaA $3 (gl $4) ; acsA (\cs -> sLL $1 $> $ HsExplicitTupleTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mop $2,mcp $6] cs) (h : $5)) }} | SIMPLEQUOTE '[' comma_types0 ']' {% acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mj AnnSimpleQuote $1,mos $2,mcs $4] cs) IsPromoted $3) } - | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 (reLocN $>) $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } + | SIMPLEQUOTE var {% acsA (\cs -> sLL $1 $> $ HsTyVar (EpAnn (glR $1) [mj AnnSimpleQuote $1,mjN AnnName $2] cs) IsPromoted $2) } -- Two or more [ty, ty, ty] must be a promoted list type, just as -- if you had written '[ty, ty, ty] @@ -2366,7 +2366,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } : fds1 ',' fd {% do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | fd { sL1A $1 [$1] } fd :: { LHsFunDep GhcPs } @@ -2377,7 +2377,7 @@ fd :: { LHsFunDep GhcPs } varids0 :: { Located [LocatedN RdrName] } : {- empty -} { noLoc [] } - | varids0 tyvar { sLL $1 (reLocN $>) ($2 : (unLoc $1)) } + | varids0 tyvar { sLL $1 $> ($2 : (unLoc $1)) } ----------------------------------------------------------------------------- -- Kinds @@ -2464,7 +2464,7 @@ constrs1 :: { Located [LConDecl GhcPs] } : constrs1 '|' constr {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) - ; return (sLLlA $1 $> ($3 : h' : t)) }} + ; return (sLL $1 $> ($3 : h' : t)) }} | constr { sL1A $1 [$1] } constr :: { LConDecl GhcPs } @@ -2518,7 +2518,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } - : derivings deriving { sLL $1 (reLoc $>) ($2 : unLoc $1) } -- AZ: order? + : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? | deriving { sL1 (reLoc $>) [$1] } -- The outer Located is just to allow the caller to @@ -2603,7 +2603,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } (GRHSs (cs Semi.<> csw) (reverse (unLoc $1)) bs)) }} gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } - : gdrhs gdrh { sLL $1 (reLoc $>) ($2 : unLoc $1) } + : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } | gdrh { sL1 (reLoc $1) [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } @@ -2616,14 +2616,14 @@ sigdecl :: { LHsDecl GhcPs } infixexp '::' sigtype {% do { $1 <- runPV (unECP $1) ; v <- checkValSigLhs $1 - ; acsA (\cs -> (sLLAl $1 (reLoc $>) $ SigD noExtField $ + ; acsA (\cs -> (sLL $1 $> $ SigD noExtField $ TypeSig (EpAnn (glAR $1) (AnnSig (mu AnnDcolon $2) []) cs) [v] (mkHsWildCardBndrs $3)))} } | var ',' sig_vars '::' sigtype {% do { v <- addTrailingCommaN $1 (gl $2) ; let sig cs = TypeSig (EpAnn (glNR $1) (AnnSig (mu AnnDcolon $4) []) cs) (v : reverse (unLoc $3)) (mkHsWildCardBndrs $5) - ; acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ SigD noExtField (sig cs) ) }} + ; acsA (\cs -> sLL $1 $> $ SigD noExtField (sig cs) ) }} | infix prec ops {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $3 @@ -2717,22 +2717,22 @@ exp :: { ECP } | infixexp '-<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annlarrowtail $2) cs) $1 $3 HsFirstOrderApp True) } | infixexp '>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu Annrarrowtail $2) cs) $3 $1 HsFirstOrderApp False) } | infixexp '-<<' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnLarrowtail $2) cs) $1 $3 HsHigherOrderApp True) } | infixexp '>>-' exp {% runPV (unECP $1) >>= \ $1 -> runPV (unECP $3) >>= \ $3 -> fmap ecpFromCmd $ - acsA (\cs -> sLLAA $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 + acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glAR $1) (mu AnnRarrowtail $2) cs) $3 $1 HsHigherOrderApp False) } -- See Note [%shift: exp -> infixexp] | infixexp %shift { $1 } @@ -2758,7 +2758,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLLlA $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2845,7 +2845,7 @@ fexp :: { ECP } | 'static' aexp {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 (reLoc $>) $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } + acsA (\cs -> sLL $1 $> $ HsStatic (EpAnn (glR $1) [mj AnnStatic $1] cs) $2) } | aexp { $1 } @@ -2872,8 +2872,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLLlA $1 $> - [reLocA $ sLLlA $1 $> + (reLocA $ sLL $1 $> + [reLocA $ sLL $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2929,7 +2929,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLLlA $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -3000,10 +3000,10 @@ aexp2 :: { ECP } | splice_untyped { ECP $ pvA $ mkHsSplicePV $1 } | splice_typed { ecpFromExp $ fmap (uncurry HsTypedSplice) (reLocA $1) } - | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } - | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } - | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } + | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } + | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 $> $ HsUntypedBracket (EpAnn (glR $1) [mj AnnThTyQuote $1 ] cs) (VarBr noExtField False $2)) } -- See Note [%shift: aexp2 -> TH_TY_QUOTE] | TH_TY_QUOTE %shift {% reportEmptyDoubleQuotes (getLoc $1) } | '[|' exp '|]' {% runPV (unECP $2) >>= \ $2 -> @@ -3032,8 +3032,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 (reLoc $>) ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3042,13 +3042,13 @@ splice_exp :: { LHsExpr GhcPs } splice_untyped :: { Located (HsUntypedSplice GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } + acs (\cs -> sLL $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } splice_typed :: { Located ((EpAnnCO, EpAnn [AddEpAnn]), LHsExpr GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } + acs (\cs -> sLL $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } cmdargs :: { [LHsCmdTop GhcPs] } : cmdargs acmd { $2 : $1 } @@ -3093,7 +3093,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL (reLoc $1) (reLocN $>) $ SectionL noAnn $1 (n2l $2) } + reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3233,7 +3233,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3249,20 +3249,20 @@ transformqual :: { Located (RealSrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> Stmt -- Function is applied to a list of stmts *in order* : 'then' exp {% runPV (unECP $2) >>= \ $2 -> acs (\cs-> - sLLlA $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } + sLL $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) } | 'then' exp 'by' exp {% runPV (unECP $2) >>= \ $2 -> runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkTransformByStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnBy $3] cs) ss $2 $4))) } | 'then' 'group' 'using' exp {% runPV (unECP $4) >>= \ $4 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] cs) ss $4))) } | 'then' 'group' 'by' exp 'using' exp {% runPV (unECP $4) >>= \ $4 -> runPV (unECP $6) >>= \ $6 -> - acs (\cs -> sLLlA $1 $> ( + acs (\cs -> sLL $1 $> ( \r ss -> (mkGroupByUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] cs) ss $4 $6))) } -- Note that 'group' is a special_id, which means that you can enable @@ -3281,7 +3281,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } case unLoc $1 of (h:t) -> do h' <- addTrailingCommaA h (gl $2) - return (sLL $1 (reLoc $>) ($3 : (h':t))) } + return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> return $ sL1A $1 [$1] } @@ -3309,11 +3309,11 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs : alts1(PATS) ';' alt(PATS) { $1 >>= \ $1 -> $3 >>= \ $3 -> case snd $ unLoc $1 of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) ++ (mz AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) ,[$3])) (h:t) -> do h' <- addTrailingSemiA h (gl $2) - return (sLL $1 (reLoc $>) (fst $ unLoc $1,$3 : h' : t)) } + return (sLL $1 $> (fst $ unLoc $1,$3 : h' : t)) } | alts1(PATS) ';' { $1 >>= \ $1 -> case snd $ unLoc $1 of [] -> return (sLL $1 $> ((fst $ unLoc $1) ++ (mz AnnSemi $2) @@ -3338,7 +3338,7 @@ alt_rhs :: { forall b. DisambECP b => PV (Located (GRHSs GhcPs (LocatedA b))) } ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : '->' exp { unECP $2 >>= \ $2 -> - acs (\cs -> sLLlA $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } + acs (\cs -> sLL $1 $> (unguardedRHS (EpAnn (glR $1) (GrhsAnn Nothing (mu AnnRarrow $1)) cs) (comb2 $1 $2) $2)) } | gdpats { $1 >>= \gdpats -> return $ sL1 gdpats (reverse (unLoc gdpats)) } @@ -3405,11 +3405,11 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( : stmts ';' stmt { $1 >>= \ $1 -> $3 >>= \ ($3 :: LStmt GhcPs (LocatedA b)) -> case (snd $ unLoc $1) of - [] -> return (sLL $1 (reLoc $>) ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) + [] -> return (sLL $1 $> ((fst $ unLoc $1) `snocOL` (mj AnnSemi $2) ,$3 : (snd $ unLoc $1))) (h:t) -> do { h' <- addTrailingSemiA h (gl $2) - ; return $ sLL $1 (reLoc $>) (fst $ unLoc $1,$3 :(h':t)) }} + ; return $ sLL $1 $> (fst $ unLoc $1,$3 :(h':t)) }} | stmts ';' { $1 >>= \ $1 -> case (snd $ unLoc $1) of @@ -3435,13 +3435,13 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : qual { $1 } | 'rec' stmtlist { $2 >>= \ $2 -> - acsA (\cs -> (sLL $1 (reLoc $>) $ mkRecStmt + acsA (\cs -> (sLL $1 $> $ mkRecStmt (EpAnn (glR $1) (hsDoAnn $1 $2 AnnRec) cs) $2)) } qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } : bindpat '<-' exp { unECP $3 >>= \ $3 -> - acsA (\cs -> sLLlA (reLoc $1) $> + acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> return $ sL1 $1 $ mkBodyStmt $1 } @@ -3467,7 +3467,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... @@ -3512,7 +3512,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 (reLoc $>) ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3525,7 +3525,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (let { this = $3; rest = h':t } - in rest `seq` this `seq` sLL $1 (reLoc $>) (this : rest)) } + in rest `seq` this `seq` sLL $1 $> (this : rest)) } | dbinds ';' {% case unLoc $1 of (h:t) -> do h' <- addTrailingSemiA h (gl $2) @@ -3535,7 +3535,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed dbind :: { LIPBind GhcPs } dbind : ipvar '=' exp {% runPV (unECP $3) >>= \ $3 -> - acsA (\cs -> sLLlA $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } + acsA (\cs -> sLL $1 $> (IPBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (reLocA $1) $3)) } ipvar :: { Located HsIPName } : IPDUPVARID { sL1 $1 (HsIPName (getIPDUPVARID $1)) } @@ -3557,11 +3557,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLLAA $1 $> (Or [h,$3])) } } + ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLLAA (head $1) (last $1) (And ($1)) } + { reLocA $ sLL (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -3577,7 +3577,7 @@ name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } namelist :: { Located [LocatedN RdrName] } namelist : name_var { sL1N $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} name_var :: { LocatedN RdrName } name_var : var { $1 } @@ -3609,12 +3609,12 @@ con :: { LocatedN RdrName } con_list :: { Located (NonEmpty (LocatedN RdrName)) } con_list : con { sL1N $1 (pure $1) } - | con ',' con_list {% sLL (reLocN $1) $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } + | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } qcon_list : qcon { sL1N $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) - ; return (sLL (reLocN $1) $> (h : unLoc $3)) }} + ; return (sLL $1 $> (h : unLoc $3)) }} -- See Note [ExplicitTuple] in GHC.Hs.Expr sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors @@ -4141,30 +4141,17 @@ sL1n :: Located a -> b -> LocatedN b sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} -sLL :: Located a -> Located b -> c -> Located c +sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} sLLa :: Located a -> Located b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) -{-# INLINE sLLlA #-} -sLLlA :: Located a -> LocatedAn t b -> c -> Located c -sLLlA x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) - -{-# INLINE sLLAl #-} -sLLAl :: LocatedAn t a -> Located b -> c -> Located c -sLLAl x y = sL (comb2 y x) -- #define LL sL (comb2 $1 $>) - {-# INLINE sLLAsl #-} -sLLAsl :: [LocatedAn t a] -> Located b -> c -> Located c +sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c sLLAsl [] = sL1 -sLLAsl (x:_) = sLLAl x - -{-# INLINE sLLAA #-} -sLLAA :: LocatedAn t a -> LocatedAn u b -> c -> Located c -sLLAA x y = sL (comb2 (reLoc y) (reLoc x)) -- #define LL sL (comb2 $1 $>) - +sLLAsl (x:_) = sLL x {- Note [Adding location info] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54bca32419943db3edf0625c2bf4d06cfac8b9ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54bca32419943db3edf0625c2bf4d06cfac8b9ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 07:24:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 15 Jul 2023 03:24:28 -0400 Subject: [Git][ghc/ghc][master] Configure: canonicalise PythonCmd on Windows Message-ID: <64b249ac20878_3edd85b3fb022997d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - 1 changed file: - m4/find_python.m4 Changes: ===================================== m4/find_python.m4 ===================================== @@ -5,6 +5,11 @@ AC_DEFUN([FIND_PYTHON],[ dnl Prefer the mingw64 distribution on Windows due to #17483. AC_PATH_PROG([PYTHON], [python3], [], [/mingw64/bin $PATH]) - PythonCmd="$PYTHON" + if test "$HostOS" = "mingw32" + then + PythonCmd=$(cygpath -m "$PYTHON") + else + PythonCmd="$PYTHON" + fi AC_SUBST([PythonCmd]) ]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8863828a1f6f0badb255d245d73bcc094e76838 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8863828a1f6f0badb255d245d73bcc094e76838 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 07:25:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 15 Jul 2023 03:25:00 -0400 Subject: [Git][ghc/ghc][master] Improve Note [Binder-swap during float-out] Message-ID: <64b249cce163e_3edd85b3fb0233232@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - 1 changed file: - compiler/GHC/Core/Opt/SetLevels.hs Changes: ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -44,13 +44,33 @@ case x of wild { p -> ...wild... } we substitute x for wild in the RHS of the case alternatives: case x of wild { p -> ...x... } - This means that a sub-expression involving x is not "trapped" inside the RHS. + This means that a sub-expression involving x is not "trapped" inside the RHS + (i.e. it can now be floated out, whereas if it mentioned wild it could not). And it's not inconvenient because we already have a substitution. - Note that this is EXACTLY BACKWARDS from the what the simplifier does. - The simplifier tries to get rid of occurrences of x, in favour of wild, - in the hope that there will only be one remaining occurrence of x, namely - the scrutinee of the case, and we can inline it. + For example, consider: + + f x = letrec go y = case x of z { (a,b) -> ...(expensive z)... } + in ... + + If we do the reverse binder-swap we get + + f x = letrec go y = case x of z { (a,b) -> ...(expensive x)... } + in ... + + and now we can float out: + + f x = let t = expensive x + in letrec go y = case x of z { (a,b) -> ...(t)... } + in ... + + Now (expensive x) is computed once, rather than once each time around the 'go' loop. + + Note that this is EXACTLY BACKWARDS from the what the simplifier does. + The simplifier tries to get rid of occurrences of x, in favour of wild, + in the hope that there will only be one remaining occurrence of x, namely + the scrutinee of the case, and we can inline it. + -} module GHC.Core.Opt.SetLevels ( View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca1e636a9c4d8947a680c36167683616d09f4625 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ca1e636a9c4d8947a680c36167683616d09f4625 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 07:33:12 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Sat, 15 Jul 2023 03:33:12 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Type patterns (#22478, #18986) Message-ID: <64b24bb8e28d3_3edd85127ee50c2355f3@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 8a52f781 by Andrei Borzenkov at 2023-07-15T11:32:59+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 30 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - testsuite/tests/gadt/T18191.stderr - + testsuite/tests/rename/should_compile/T22478a.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a52f78133c4d4a76c005d35705e076c9ba1acb2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a52f78133c4d4a76c005d35705e076c9ba1acb2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 08:51:28 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 15 Jul 2023 04:51:28 -0400 Subject: [Git][ghc/ghc][wip/az/epa-annlist-decls] 22 commits: compiler: Fingerprint more code generation flags Message-ID: <64b25e10d0a41_3edd85b3f4c24995e@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-annlist-decls at Glasgow Haskell Compiler / GHC Commits: d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - 56828c5b by Alan Zimmerman at 2023-07-15T09:45:01+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Config.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0594578f12ad07a665c17f3b44dcb4d17f3b7cc...56828c5b3429b822a16cec36559a12880d177666 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0594578f12ad07a665c17f3b44dcb4d17f3b7cc...56828c5b3429b822a16cec36559a12880d177666 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 08:59:28 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 15 Jul 2023 04:59:28 -0400 Subject: [Git][ghc/ghc][wip/az/epa-improve-getmonobind] 23 commits: compiler: Fingerprint more code generation flags Message-ID: <64b25ff026a44_3edd85127ee50c2501a7@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-improve-getmonobind at Glasgow Haskell Compiler / GHC Commits: d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - 56828c5b by Alan Zimmerman at 2023-07-15T09:45:01+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 6acf2ec6 by Alan Zimmerman at 2023-07-15T09:59:02+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Bind.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc634fd6a0e1ccf023c85a16f570ed04b839d3c5...6acf2ec60675f9af7bddc457cfb3760143c62696 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc634fd6a0e1ccf023c85a16f570ed04b839d3c5...6acf2ec60675f9af7bddc457cfb3760143c62696 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 09:00:40 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 15 Jul 2023 05:00:40 -0400 Subject: [Git][ghc/ghc][wip/az/epa-improve-sl1] 24 commits: compiler: Fingerprint more code generation flags Message-ID: <64b2603832ea8_3edd85b3f602503e6@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-improve-sl1 at Glasgow Haskell Compiler / GHC Commits: d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - 56828c5b by Alan Zimmerman at 2023-07-15T09:45:01+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 6acf2ec6 by Alan Zimmerman at 2023-07-15T09:59:02+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - a94f6428 by Alan Zimmerman at 2023-07-15T10:00:11+01:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Bind.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20c7cd0a187bd0862c8d71a017bf28e63620094a...a94f64280a6f6a4e1beaf28fc65ce17250cf31e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/20c7cd0a187bd0862c8d71a017bf28e63620094a...a94f64280a6f6a4e1beaf28fc65ce17250cf31e8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 10:43:34 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 15 Jul 2023 06:43:34 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 50 commits: compiler: Fingerprint more code generation flags Message-ID: <64b27856e11e_3edd85127ee50c26116b@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - 56828c5b by Alan Zimmerman at 2023-07-15T09:45:01+01:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 6acf2ec6 by Alan Zimmerman at 2023-07-15T09:59:02+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - a94f6428 by Alan Zimmerman at 2023-07-15T10:00:11+01:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 4bd01449 by Alan Zimmerman at 2023-07-15T10:03:59+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 5a688a14 by Alan Zimmerman at 2023-07-15T10:05:13+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 73af5abb by Alan Zimmerman at 2023-07-15T10:05:17+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - c079291b by Alan Zimmerman at 2023-07-15T10:05:17+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - 2e1c0c7e by Alan Zimmerman at 2023-07-15T10:05:17+01:00 EPA: Fix span for GRHS - - - - - b27b2d27 by Alan Zimmerman at 2023-07-15T10:05:17+01:00 EPA: Fix span for Located Context - - - - - 3e297a2b by Alan Zimmerman at 2023-07-15T10:05:17+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - db78062b by Alan Zimmerman at 2023-07-15T10:05:17+01:00 EPA: widen more TrailingAnn usages - - - - - bc3ab26f by Alan Zimmerman at 2023-07-15T10:05:17+01:00 EPA: Capture full range for a CaseAlt Match - - - - - eef22411 by Alan Zimmerman at 2023-07-15T10:05:17+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - d04ac5fe by Alan Zimmerman at 2023-07-15T10:05:17+01:00 WIP - - - - - 773fa5cc by Alan Zimmerman at 2023-07-15T10:05:17+01:00 Fixup after rebase - - - - - 2effbf49 by Alan Zimmerman at 2023-07-15T10:05:17+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 6a63ede7 by Alan Zimmerman at 2023-07-15T10:05:17+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 9d2a9b12 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - de1732df by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - eb5f6f2e by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 18f65b60 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: More extending anchors to full span in Parser.y - - - - - b11aff96 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - a80254b6 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: Fix simple tests - - - - - c0aabfb2 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 955a3125 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ee9ecde4 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: deal with fallout from getMonoBind - - - - - 3eb57884 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA fix captureLineSpacing - - - - - a2aed54d by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA print any comments in the span before exiting it - - - - - 63cb29c6 by Alan Zimmerman at 2023-07-15T10:05:18+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e64ea9abbd847d5eedaa90a982b42fac0a9b711...63cb29c6118445b0342a2c21c72ca76cbd97d3ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e64ea9abbd847d5eedaa90a982b42fac0a9b711...63cb29c6118445b0342a2c21c72ca76cbd97d3ac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 11:24:52 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 15 Jul 2023 07:24:52 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] MO_SS_Conv: Don't give up the highest bit for sign Message-ID: <64b282044478c_3edd85b3f9c2708e1@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: eb35fd83 by Sven Tennie at 2023-07-15T13:22:31+02:00 MO_SS_Conv: Don't give up the highest bit for sign According to this test, reducing the value for the sign is not correct. narrow[W32→W8](sext[W16→W32](load[W16](0x223972::W64))) test ( bits64 buffer ) { bits64 ret; (ret) = prim %popcnt8(%lobits8(%sx32(bits16[buffer + (2242930 :: bits64)]))); return (ret); } 4 /= 5 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -675,8 +675,7 @@ getRegister' config plat expr = ] `appOL` truncateReg from to dst where - -- Why -1? We need to shift out one more bit for the sign. - shift = 64 - (widthInBits from - widthInBits to - 1) + shift = 64 - (widthInBits from - widthInBits to) -- Dyadic machops: -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb35fd83839448236d5f4f94f674aa38939d40cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb35fd83839448236d5f4f94f674aa38939d40cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 14:31:40 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 15 Jul 2023 10:31:40 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 21 commits: EPA: Widen anchor when adding a trailingAnn Message-ID: <64b2adcc6b5d_3edd8543bcfa0315694@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 2dc7df49 by Alan Zimmerman at 2023-07-15T12:36:42+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - e9c192a0 by Alan Zimmerman at 2023-07-15T12:36:42+01:00 EPA: widen more TrailingAnn usages - - - - - 051d2539 by Alan Zimmerman at 2023-07-15T12:36:42+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 8ae98393 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 7fa212ab by Alan Zimmerman at 2023-07-15T12:36:43+01:00 WIP - - - - - 32ee2272 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 Fixup after rebase - - - - - 9e538fc1 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 72d101fe by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 054418b8 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - 4fde7d72 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 1ed51a34 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - e9a24aa4 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: More extending anchors to full span in Parser.y - - - - - 9c5e7bd9 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 579a7351 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: Fix simple tests - - - - - d9162edd by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - b0fa35dc by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 8620d7c7 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: deal with fallout from getMonoBind - - - - - 5eb51bf3 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA fix captureLineSpacing - - - - - 3068ffbd by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA print any comments in the span before exiting it - - - - - f4c7ac07 by Alan Zimmerman at 2023-07-15T12:36:43+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 86109835 by Alan Zimmerman at 2023-07-15T15:23:08+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 12 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Unit/Module/Warnings.hs - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63cb29c6118445b0342a2c21c72ca76cbd97d3ac...86109835e775144a72d7f4ecf09dc5d83a44f08f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/63cb29c6118445b0342a2c21c72ca76cbd97d3ac...86109835e775144a72d7f4ecf09dc5d83a44f08f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 22:27:37 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 15 Jul 2023 18:27:37 -0400 Subject: [Git][ghc/ghc][wip/T22404] More wibbles Message-ID: <64b31d58df606_3e28d5b51e410609e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 0c0d689b by Simon Peyton Jones at 2023-07-15T23:27:12+01:00 More wibbles - - - - - 3 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -954,26 +954,6 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine = let !(WUD body_uds res) = addInScope env [bndr] thing_inside in WUD body_uds (combine [NonRec bndr rhs] res) - -- Fast path for top level, non-recursive bindings, with no unfoldings or rules - | TopLevel <- lvl - , not (idHasRules bndr) - , not (bndr `elemVarEnv` ire) - = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside - in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] - then WUD body_uds body - else let - unf = idUnfolding bndr - rhs_env = addOneShotsFromDmd bndr $ - setNonTailCtxt (mkNonRecRhsCtxt tagged_bndr unf) env - !rhs_wuds@(WTUD _ rhs') = occAnalLamTail rhs_env rhs - !(WTUD (TUD _ unf_uds) _) = occAnalUnfolding rhs_env unf - rhs_uds = adjustTailUsage Nothing rhs_wuds - full_rhs_uds | isStableUnfolding unf = rhs_uds `andUDs` markAllNonTail unf_uds - | otherwise = rhs_uds - - in WUD (full_rhs_uds `andUDs` body_uds) -- Note `andUDs` - (combine [NonRec tagged_bndr rhs'] body) - -- /Existing/ non-recursive join points -- Analyse the RHS and /then/ the body | NotTopLevel <- lvl @@ -993,11 +973,35 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` (combine [NonRec tagged_bndr rhs'] body) + -- Fast path for top level, non-recursive bindings, with no rules + -- This is a very common case. Semantically though, you can delete this + -- entire equation and fall through to the general case + -- Fast path: + -- * Top level so cannot be a join point + -- * Top level so no binder swap, so no need to update unfolding + -- * No rules so no faffing with them + | TopLevel <- lvl + , not (idHasRules bndr || (bndr `elemVarEnv` ire)) + = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside + in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else let + unf = idUnfolding bndr + rhs_env = addOneShotsFromDmd bndr $ + setNonTailCtxt (mkNonRecRhsCtxt tagged_bndr unf) env + !rhs_wuds@(WTUD _ rhs') = occAnalLamTail rhs_env rhs + !(WTUD (TUD _ unf_uds) _) = occAnalUnfolding rhs_env unf + rhs_uds = adjustTailUsage Nothing rhs_wuds + full_rhs_uds | isStableUnfolding unf = rhs_uds `andUDs` markAllNonTail unf_uds + | otherwise = rhs_uds + + in WUD (full_rhs_uds `andUDs` body_uds) -- Note `andUDs` + (combine [NonRec tagged_bndr rhs'] body) + -- The normal case, including newly-discovered join points -- Analyse the body and /then/ the RHS | otherwise - = let - !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside + = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body else let @@ -2169,8 +2173,10 @@ occ_anal_lam_tail env (Lam bndr expr) env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } !(WUD usage expr') = occ_anal_lam_tail env1 expr - bndr2 = tagLamBinder usage bndr1 - in WUD usage (Lam bndr2 expr') + bndr2 = tagLamBinder usage bndr1 + usage1 = usage `addManyOccs` coVarsOfType (idType bndr) + -- usage1: see Note [Gather occurrences of coercion variables] + in WUD usage1 (Lam bndr2 expr') -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] @@ -2459,7 +2465,7 @@ We gather CoVar occurrences from: * The (Type ty) and (Coercion co) cases of occAnal * The type 'ty' of a lambda-binder (\(x:ty). blah) - See addLamCoVarOccs + See addCoVarOccs But it is not necessary to gather CoVars from the types of other binders. @@ -2938,10 +2944,7 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points fix_up_uds :: WithUsageDetails a -> WithUsageDetails a -- Remove usage for bndrs -- Add usage info for CoVars used in the types of bndrs - fix_up_uds (WUD uds res) = WUD with_co_var_occs res - where - trimmed_uds = uds `delDetails` bndrs - with_co_var_occs = trimmed_uds `addManyOccs` coVarOccs bndrs + fix_up_uds (WUD uds res) = WUD (uds `delDetails` bndrs) res add_bad_joins :: WithUsageDetails a -> WithUsageDetails a -- Add usage info for occ_join_points that we cannot push inwardsa @@ -2982,8 +2985,6 @@ addJoinPoint env bndr rhs_uds mkZeroedForm :: UsageDetails -> OccInfoEnv -- See Note [Occurrence analysis for join points] for "zeroed form" ---mkZeroedForm EmptyUDs --- = emptyVarEnv mkZeroedForm (UD { ud_env = rhs_occs }) = mapMaybeUFM do_one rhs_occs where @@ -3416,8 +3417,8 @@ type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's data LocalOcc = OneOccL { lo_n_br :: {-# UNPACK #-} !Int , lo_tail :: {-# UNPACK #-} !TailCallInfo - -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3) - -- gives NoTailCallInfo + -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3) + -- gives NoTailCallInfo , lo_int_cxt :: !InterestingCxt } | ManyOccL !TailCallInfo @@ -3439,10 +3440,8 @@ data UsageDetails , ud_z_tail :: !ZappedSet } -- INVARIANT: All three zapped sets are subsets of ud_env --- | EmptyUDs instance Outputable UsageDetails where --- ppr EmptyUDs = text "EmptyUDs" ppr ud@(UD { ud_env = env, ud_z_tail = z_tail }) = text "UD" <+> (braces $ fsep $ punctuate comma $ [ ppr uq <+> text ":->" <+> ppr (mkOccInfoByUnique ud uq) @@ -3507,24 +3506,12 @@ add_many_occ v env | isId v = extendVarEnv env v (ManyOccL NoTailCallInfo) addManyOccs :: UsageDetails -> VarSet -> UsageDetails addManyOccs uds var_set | isEmptyVarSet var_set = uds - | otherwise = case uds of --- EmptyUDs -> mkSimpleDetails (add_to emptyVarEnv) - UD { ud_env = env } -> uds { ud_env = add_to env } + | otherwise = uds { ud_env = add_to (ud_env uds) } where add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set - -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes - -coVarOccs :: [Var] -> VarSet --- Add any CoVars free in the types of a telescope of lambda-binders --- See Note [Gather occurrences of coercion variables] -coVarOccs bndrs - = foldr get emptyVarSet bndrs - where - get bndr cvs = (cvs `delVarSet` bndr) `unionVarSet` - coVarsOfType (varType bndr) + -- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes emptyDetails :: UsageDetails ---emptyDetails = EmptyUDs emptyDetails = mkSimpleDetails emptyVarEnv mkSimpleDetails :: OccInfoEnv -> UsageDetails @@ -3534,7 +3521,6 @@ mkSimpleDetails env = UD { ud_env = env , ud_z_tail = emptyVarEnv } modifyUDEnv :: (OccInfoEnv -> OccInfoEnv) -> UsageDetails -> UsageDetails --- modifyUDEnv f EmptyUDs = mkSimpleDetails (f emptyVarEnv) modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env } {- @@ -3545,12 +3531,10 @@ emptyDetails = UD { ud_env = emptyVarEnv -} isEmptyDetails :: UsageDetails -> Bool ---isEmptyDetails EmptyUDs = True isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env delDetails :: UsageDetails -> [Id] -> UsageDetails -- Delete these binders from the UsageDetails --- delDetails EmptyUDs _ = EmptyUDs delDetails (UD { ud_env = env , ud_z_many = z_many , ud_z_in_lam = z_in_lam @@ -3562,15 +3546,9 @@ delDetails (UD { ud_env = env markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails ---markAllMany EmptyUDs = EmptyUDs markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env } - ---markAllInsideLam EmptyUDs = EmptyUDs markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env } - ---markAllNonTail EmptyUDs = EmptyUDs markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env } - markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3582,7 +3560,6 @@ markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud lookupLocalDetails :: UsageDetails -> Id -> Maybe LocalOcc ---lookupLocalDetails EmptyUDs _ = Nothing lookupLocalDetails (UD { ud_env = env }) id = lookupVarEnv env id lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo @@ -3600,13 +3577,10 @@ lookupDetails ud id = mkOccInfoByUnique ud (idUnique id) usedIn :: Id -> UsageDetails -> Bool v `usedIn` uds | isExportedId v = True - | otherwise = case uds of --- EmptyUDs -> False - UD { ud_env = env } -> v `elemVarEnv` env + | otherwise = v `elemVarEnv` ud_env uds udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds --- udFreeVars _ EmptyUDs = emptyVarSet udFreeVars bndrs (UD { ud_env = env }) = restrictFreeVars bndrs env restrictFreeVars :: VarSet -> OccInfoEnv -> VarSet @@ -3618,8 +3592,6 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails {-# INLINE combineUsageDetailsWith #-} ---combineUsageDetailsWith _ EmptyUDs ud2 = ud2 --- combineUsageDetailsWith _ ud1 EmptyUDs = ud1 combineUsageDetailsWith plus_occ_info uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) @@ -3632,8 +3604,6 @@ combineUsageDetailsWith plus_occ_info , ud_z_tail = plusVarEnv z_tail1 z_tail2 } mkOccInfoByUnique :: UsageDetails -> Unique -> OccInfo ---mkOccInfoByUnique EmptyUDs _ --- = IAmDead mkOccInfoByUnique (UD { ud_env = env , ud_z_many = z_many , ud_z_in_lam = z_in_lam @@ -3815,16 +3785,19 @@ tagRecBinders lvl body_uds details_s setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr setBinderOcc occ_info bndr - | isTyVar bndr = bndr - | isExportedId bndr = if isManyOccs (idOccInfo bndr) - then bndr - else setIdOccInfo bndr noOccInfo - -- Don't use local usage info for visible-elsewhere things - -- BUT *do* erase any IAmALoopBreaker annotation, because we're - -- about to re-generate it and it shouldn't be "sticky" - + | isTyVar bndr = bndr + | isNoOccInfo occ_info = zap_it + | isExportedId bndr = zap_it + -- Don't use occ_info (locally-generated) for visible-elsewhere things + -- BUT *do* erase any IAmALoopBreaker annotation, because we're + -- about to re-generate it and it shouldn't be "sticky" | otherwise = setIdOccInfo bndr occ_info + where + bndr_info = idOccInfo bndr + zap_it | isNoOccInfo bndr_info = bndr + | otherwise = setIdOccInfo bndr noOccInfo + -- | Decide whether some bindings should be made into join points or not, based -- on its occurrences. This is -- Returns `False` if they can't be join points. Note that it's an ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -450,12 +450,19 @@ getRules (RuleEnv { re_local_rules = local_rule_base , re_eps_rules = eps_rule_base , re_visible_orphs = orphs }) fn - | isLocalId fn - = idCoreRules fn - | Just {} <- isDataConId_maybe fn -- Short cut for data constructor workers = [] -- and wrappers, which never have any rules + | Just export_flag <- isLocalId_maybe fn + = -- LocalIds can't have rules in the local_rule_base (used for imported fns) + -- nor external packages; but there can (just) be rules in another module + -- in the home package, if it is exported + case export_flag of + NotExported -> idCoreRules fn + Exported -> case get home_rule_base of + [] -> idCoreRules fn + home_rules -> drop_orphs home_rules ++ idCoreRules fn + | otherwise = case (get local_rule_base, get home_rule_base, get eps_rule_base) of ([], [], []) -> idCoreRules fn ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Types.Var ( -- ** Predicates isId, isTyVar, isTcTyVar, - isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar, + isLocalVar, isLocalId, isLocalId_maybe, isCoVar, isNonCoVarId, isTyCoVar, isGlobalId, isExportedId, mustHaveLocalBinding, @@ -94,6 +94,9 @@ module GHC.Types.Var ( tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, mapVarBndr, mapVarBndrs, + -- ** ExportFlag + ExportFlag(..), + -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -1239,6 +1242,10 @@ isLocalId :: Var -> Bool isLocalId (Id { idScope = LocalId _ }) = True isLocalId _ = False +isLocalId_maybe :: Var -> Maybe ExportFlag +isLocalId_maybe (Id { idScope = LocalId ef }) = Just ef +isLocalId_maybe _ = Nothing + -- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's -- These are the variables that we need to pay attention to when finding free -- variables, or doing dependency analysis. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c0d689bb9017f3a2d99cbb342f744e1d349c51e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c0d689bb9017f3a2d99cbb342f744e1d349c51e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 23:36:19 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 15 Jul 2023 19:36:19 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] 10 commits: Fix deprecation of record fields Message-ID: <64b32d7389281_3e28d5b51e41167b6@gitlab.mail> Vladislav Zavialov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - 5edc52ff by Andrei Borzenkov at 2023-07-15T23:36:16+00:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 30 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Errors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a52f78133c4d4a76c005d35705e076c9ba1acb2...5edc52ff461662864e160484cacd9a2b4c73b868 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a52f78133c4d4a76c005d35705e076c9ba1acb2...5edc52ff461662864e160484cacd9a2b4c73b868 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 15 23:42:27 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 15 Jul 2023 19:42:27 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 6 commits: base: fix haddock syntax in GHC.Profiling Message-ID: <64b32ee3712ce_3e28d5b51f812172@gitlab.mail> Vladislav Zavialov pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 29 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08574ca279bc6b234734e8d45d47b1d971de1d11...cf86f3ece835ecb389d73760c1d757622c084f0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08574ca279bc6b234734e8d45d47b1d971de1d11...cf86f3ece835ecb389d73760c1d757622c084f0f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 02:55:20 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 15 Jul 2023 22:55:20 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] 158 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <64b35c17d958e_3e28d5b51f8149186@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - a7dfab3c by Matthew Craven at 2023-07-16T02:50:15+02:00 Equality of forall-types is visibility aware (cherry-picked) - - - - - 814bab56 by Andrei Borzenkov at 2023-07-16T02:50:23+02:00 Type patterns (cherry-picked) - - - - - 5169990c by Vladislav Zavialov at 2023-07-16T04:51:24+02:00 WIP: Visible forall in types of terms - - - - - 818356ef by Vladislav Zavialov at 2023-07-16T04:51:24+02:00 VDQ: accept test suite changes Not all of these are quite right: in some contexts, the suggestion to enable RequiredTypeArguments is incorrect, as enabling the extension wouldn't make the program accepted. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a400b921d03985149fff416236bb874e7d2b89b7...818356ef5f72d8567e188636141aa8cb439cda76 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a400b921d03985149fff416236bb874e7d2b89b7...818356ef5f72d8567e188636141aa8cb439cda76 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 03:35:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 15 Jul 2023 23:35:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: EPA: Simplify GHC/Parser.y sLL Message-ID: <64b36592afca_3e28d5b51d01580a7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 6535df13 by Vladislav Zavialov at 2023-07-15T23:35:41-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - docs/core-spec/core-spec.mng - libraries/base/changelog.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1027e6f74931ab3c791b536bbed85132c6bb90d5...6535df13c287ef417fa18de64765911ce1eb0d7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1027e6f74931ab3c791b536bbed85132c6bb90d5...6535df13c287ef417fa18de64765911ce1eb0d7f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 05:56:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 16 Jul 2023 01:56:13 -0400 Subject: [Git][ghc/ghc][master] Equality of forall-types is visibility aware Message-ID: <64b3867ddeb7d_3e28d5b51bc18757f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - docs/core-spec/core-spec.mng - testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/pmcheck/should_compile/T11195.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf86f3ece835ecb389d73760c1d757622c084f0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf86f3ece835ecb389d73760c1d757622c084f0f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 05:57:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 16 Jul 2023 01:57:00 -0400 Subject: [Git][ghc/ghc][master] List and Tuple: update documentation Message-ID: <64b386aca2f4d_3e28d5b51f819127b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 4 changed files: - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -113,6 +113,8 @@ * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to `Debug.Trace`, per [CLC proposal #36](https://github.com/haskell/core-libraries-committee/issues/36). + * Export `List` from `GHC.List` + ([CLC proposal #186](https://github.com/haskell/core-libraries-committee/issues/186)). ## 4.17.0.0 *August 2022* ===================================== libraries/ghc-prim/GHC/Tuple/Prim.hs ===================================== @@ -24,6 +24,9 @@ default () -- Double and Integer aren't available yet -- | The unit datatype @Unit@ has one non-undefined member, the nullary -- constructor @()@. +-- +-- @since 0.11.0 +-- data Unit = () -- The desugarer uses 1-tuples, @@ -107,147 +110,471 @@ getSolo :: Solo a -> a -- to have getSolo as its own separate function (#20562) getSolo (MkSolo a) = a +-- | A tuple of zero elements, a synonym for 'Unit'. +-- +-- @since 0.11.0 +-- type Tuple0 = Unit + +-- | A tuple of one element, a synonym for 'Solo'. +-- +-- @since 0.11.0 +-- type Tuple1 = Solo + +-- | A tuple of two elements. +-- +-- @since 0.11.0 +-- data Tuple2 a b = (a,b) + +-- | A tuple of three elements. +-- +-- @since 0.11.0 +-- data Tuple3 a b c = (a,b,c) + +-- | A tuple of four elements. +-- +-- @since 0.11.0 +-- data Tuple4 a b c d = (a,b,c,d) + +-- | A tuple of five elements. +-- +-- @since 0.11.0 +-- data Tuple5 a b c d e = (a,b,c,d,e) + +-- | A tuple of six elements. +-- +-- @since 0.11.0 +-- data Tuple6 a b c d e f = (a,b,c,d,e,f) + +-- | A tuple of seven elements. +-- +-- @since 0.11.0 +-- data Tuple7 a b c d e f g = (a,b,c,d,e,f,g) + +-- | A tuple of eight elements. +-- +-- @since 0.11.0 +-- data Tuple8 a b c d e f g h = (a,b,c,d,e,f,g,h) + +-- | A tuple of nine elements. +-- +-- @since 0.11.0 +-- data Tuple9 a b c d e f g h i = (a,b,c,d,e,f,g,h,i) + +-- | A tuple of ten elements. +-- +-- @since 0.11.0 +-- data Tuple10 a b c d e f g h i j = (a,b,c,d,e,f,g,h,i,j) + +-- | A tuple of eleven elements. +-- +-- @since 0.11.0 +-- data Tuple11 a b c d e f g h i j k = (a,b,c,d,e,f,g,h,i,j,k) + +-- | A tuple of twelve elements. +-- +-- @since 0.11.0 +-- data Tuple12 a b c d e f g h i j k l = (a,b,c,d,e,f,g,h,i,j,k,l) + +-- | A tuple of 13 elements. +-- +-- @since 0.11.0 +-- data Tuple13 a b c d e f g h i j k l m = (a,b,c,d,e,f,g,h,i,j,k,l,m) + +-- | A tuple of 14 elements. +-- +-- @since 0.11.0 +-- data Tuple14 a b c d e f g h i j k l m n = (a,b,c,d,e,f,g,h,i,j,k,l,m,n) + +-- | A tuple of 15 elements. +-- +-- @since 0.11.0 +-- data Tuple15 a b c d e f g h i j k l m n o = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) + +-- | A tuple of 16 elements. +-- +-- @since 0.11.0 +-- data Tuple16 a b c d e f g h i j k l m n o p = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) + +-- | A tuple of 17 elements. +-- +-- @since 0.11.0 +-- data Tuple17 a b c d e f g h i j k l m n o p q = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) + +-- | A tuple of 18 elements. +-- +-- @since 0.11.0 +-- data Tuple18 a b c d e f g h i j k l m n o p q r = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) + +-- | A tuple of 19 elements. +-- +-- @since 0.11.0 +-- data Tuple19 a b c d e f g h i j k l m n o p q r s = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) + +-- | A tuple of 20 elements. +-- +-- @since 0.11.0 +-- data Tuple20 a b c d e f g h i j k l m n o p q r s t = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) + +-- | A tuple of 21 elements. + +-- +-- @since 0.11.0 +-- data Tuple21 a b c d e f g h i j k l m n o p q r s t u = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) + +-- | A tuple of 22 elements. +-- +-- @since 0.11.0 +-- data Tuple22 a b c d e f g h i j k l m n o p q r s t u v = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) + +-- | A tuple of 23 elements. +-- +-- @since 0.11.0 +-- data Tuple23 a b c d e f g h i j k l m n o p q r s t u v w = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) + +-- | A tuple of 24 elements. +-- +-- @since 0.11.0 +-- data Tuple24 a b c d e f g h i j k l m n o p q r s t u v w x = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) + +-- | A tuple of 25 elements. +-- +-- @since 0.11.0 +-- data Tuple25 a b c d e f g h i j k l m n o p q r s t u v w x y = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) + +-- | A tuple of 26 elements. +-- +-- @since 0.11.0 +-- data Tuple26 a b c d e f g h i j k l m n o p q r s t u v w x y z = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) +-- | A tuple of 27 elements. +-- +-- @since 0.11.0 +-- data Tuple27 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1) + +-- | A tuple of 28 elements. +-- +-- @since 0.11.0 +-- data Tuple28 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1) + +-- | A tuple of 29 elements. +-- +-- @since 0.11.0 +-- data Tuple29 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1) + +-- | A tuple of 30 elements. +-- +-- @since 0.11.0 +-- data Tuple30 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1) + +-- | A tuple of 31 elements. +-- +-- @since 0.11.0 +-- data Tuple31 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1) + +-- | A tuple of 32 elements. +-- +-- @since 0.11.0 +-- data Tuple32 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1) + +-- | A tuple of 33 elements. +-- +-- @since 0.11.0 +-- data Tuple33 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1) + +-- | A tuple of 34 elements. +-- +-- @since 0.11.0 +-- data Tuple34 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1) + +-- | A tuple of 35 elements. +-- +-- @since 0.11.0 +-- data Tuple35 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1) + +-- | A tuple of 36 elements. +-- +-- @since 0.11.0 +-- data Tuple36 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1) + +-- | A tuple of 37 elements. +-- +-- @since 0.11.0 +-- data Tuple37 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1) + +-- | A tuple of 38 elements. +-- +-- @since 0.11.0 +-- data Tuple38 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1) + +-- | A tuple of 39 elements. +-- +-- @since 0.11.0 +-- data Tuple39 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1) + +-- | A tuple of 40 elements. +-- +-- @since 0.11.0 +-- data Tuple40 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1) + +-- | A tuple of 41 elements. +-- +-- @since 0.11.0 +-- data Tuple41 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1) + +-- | A tuple of 42 elements. +-- +-- @since 0.11.0 +-- data Tuple42 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1) + +-- | A tuple of 43 elements. +-- +-- @since 0.11.0 +-- data Tuple43 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1) + +-- | A tuple of 44 elements. +-- +-- @since 0.11.0 +-- data Tuple44 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1) + +-- | A tuple of 45 elements. +-- +-- @since 0.11.0 +-- data Tuple45 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,r1,s1) + +-- | A tuple of 46 elements. +-- +-- @since 0.11.0 +-- data Tuple46 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1) + +-- | A tuple of 47 elements. +-- +-- @since 0.11.0 +-- data Tuple47 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1) + +-- | A tuple of 48 elements. +-- +-- @since 0.11.0 +-- data Tuple48 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1) + +-- | A tuple of 49 elements. +-- +-- @since 0.11.0 +-- data Tuple49 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1) + +-- | A tuple of 50 elements. +-- +-- @since 0.11.0 +-- data Tuple50 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1) + +-- | A tuple of 51 elements. +-- +-- @since 0.11.0 +-- data Tuple51 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1) + +-- | A tuple of 52 elements. +-- +-- @since 0.11.0 +-- data Tuple52 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1) + +-- | A tuple of 53 elements. +-- +-- @since 0.11.0 +-- data Tuple53 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2) + +-- | A tuple of 54 elements. +-- +-- @since 0.11.0 +-- data Tuple54 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2) + +-- | A tuple of 55 elements. +-- +-- @since 0.11.0 +-- data Tuple55 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2) + +-- | A tuple of 56 elements. +-- +-- @since 0.11.0 +-- data Tuple56 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2) + +-- | A tuple of 57 elements. +-- +-- @since 0.11.0 +-- data Tuple57 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2) + +-- | A tuple of 58 elements. +-- +-- @since 0.11.0 +-- data Tuple58 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2) + +-- | A tuple of 59 elements. +-- +-- @since 0.11.0 +-- data Tuple59 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2) + +-- | A tuple of 60 elements. +-- +-- @since 0.11.0 +-- data Tuple60 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2) + +-- | A tuple of 61 elements. +-- +-- @since 0.11.0 +-- data Tuple61 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2) + +-- | A tuple of 62 elements. +-- +-- @since 0.11.0 +-- data Tuple62 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2) + +-- | A tuple of 63 elements. +-- +-- @since 0.11.0 +-- data Tuple63 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2,k2) + +-- | A tuple of 64 elements. +-- +-- @since 0.11.0 +-- data Tuple64 a b c d e f g h i j k l m n o p q r s t u v w x y z a1 b1 c1 d1 e1 f1 g1 h1 i1 j1 k1 l1 m1 n1 o1 p1 q1 r1 s1 t1 u1 v1 w1 x1 y1 z1 a2 b2 c2 d2 e2 f2 g2 h2 i2 j2 k2 l2 = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, ===================================== libraries/ghc-prim/GHC/Types.hs ===================================== @@ -184,6 +184,8 @@ type family Any :: k where { } -- >>> ['h','e','l','l','o'] == "hello" -- True -- +-- @since 0.10.0 +-- data List a = [] | a : List a ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -41,6 +41,9 @@ Warning: on unsupported architectures, the software emulation provided by the fallback to the C standard library is not guaranteed to be IEEE-compliant. +- `Unit`, `Tuple0`, `Tuple1`, `Tuple2`, `Tuple3` and so on (up to `Tuple64`) + are now exported from `GHC.Tuple.Prim` and reexported from `GHC.Tuple`. + ## 0.10.0 - Shipped with GHC 9.6.1 @@ -71,6 +74,8 @@ We are working on ways to allow users and library authors to get back the performance benefits of the old behaviour where possible. +- `List` is now exported from `GHC.Types`. + ## 0.9.0 *August 2022* - Shipped with GHC 9.4.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f13acbf187d7a0810f42705b95d593b1e2e5611 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f13acbf187d7a0810f42705b95d593b1e2e5611 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 06:21:37 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Sun, 16 Jul 2023 02:21:37 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] 3 commits: Equality of forall-types is visibility aware Message-ID: <64b38c718862e_3e28d5b51bc1939b5@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5edc52ff461662864e160484cacd9a2b4c73b868...2afbddb0f24df20cfc42279bb8695f91bbd3c1e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5edc52ff461662864e160484cacd9a2b4c73b868...2afbddb0f24df20cfc42279bb8695f91bbd3c1e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 11:00:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 16 Jul 2023 07:00:03 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: List and Tuple: update documentation Message-ID: <64b3cdb321fc6_3e28d5b51a8246043@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 857fdb00 by sheaf at 2023-07-16T06:59:58-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - 30 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6535df13c287ef417fa18de64765911ce1eb0d7f...857fdb005d35eb65047fd6a39d290c8230762584 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6535df13c287ef417fa18de64765911ce1eb0d7f...857fdb005d35eb65047fd6a39d290c8230762584 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 13:20:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 16 Jul 2023 09:20:34 -0400 Subject: [Git][ghc/ghc][master] Type patterns (#22478, #18986) Message-ID: <64b3eea29d327_3e28d5b51802662a8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 30 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - testsuite/tests/gadt/T18191.stderr - + testsuite/tests/rename/should_compile/T22478a.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2afbddb0f24df20cfc42279bb8695f91bbd3c1e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2afbddb0f24df20cfc42279bb8695f91bbd3c1e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 13:21:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 16 Jul 2023 09:21:16 -0400 Subject: [Git][ghc/ghc][master] Don't use substTyUnchecked in newMetaTyVar Message-ID: <64b3eeccb01bf_3e28d53702f302697b1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - 1 changed file: - compiler/GHC/Tc/Utils/TcMType.hs Changes: ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1001,16 +1001,7 @@ new_meta_tv_x info subst tv ; let subst1 = extendTvSubstWithClone subst tv new_tv ; return (subst1, new_tv) } where - substd_kind = substTyUnchecked subst (tyVarKind tv) - -- NOTE: #12549 is fixed so we could use - -- substTy here, but the tc_infer_args problem - -- is not yet fixed so leaving as unchecked for now. - -- OLD NOTE: - -- Unchecked because we call newMetaTyVarX from - -- tcInstTyBinder, which is called from tcInferTyApps - -- which does not yet take enough trouble to ensure - -- the in-scope set is right; e.g. #12785 trips - -- if we use substTy here + substd_kind = substTy subst (tyVarKind tv) newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType newMetaTyVarTyAtLevel tc_lvl kind View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb1a6ab1df473c7ec0e1cbb20fc7124706326ce1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb1a6ab1df473c7ec0e1cbb20fc7124706326ce1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 17:37:13 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 16 Jul 2023 13:37:13 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] 5 commits: Equality of forall-types is visibility aware Message-ID: <64b42ac9b086f_3e28d53702f303249e5@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - 2237142e by Vladislav Zavialov at 2023-07-16T18:53:21+02:00 WIP: Visible forall in types of terms - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/818356ef5f72d8567e188636141aa8cb439cda76...2237142e2d19299a9e42ddc6272bbac01b2e1865 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/818356ef5f72d8567e188636141aa8cb439cda76...2237142e2d19299a9e42ddc6272bbac01b2e1865 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 18:05:44 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 16 Jul 2023 14:05:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/release-notes-9.10 Message-ID: <64b431783c496_3e28d5b51943314f2@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/release-notes-9.10 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/release-notes-9.10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 18:10:00 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sun, 16 Jul 2023 14:10:00 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 49 commits: Hadrian: enable GHCi support on riscv64 Message-ID: <64b4327899dd4_3e28d5b51bc333476@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - b49aa787 by Apoorv Ingle at 2023-07-16T13:09:30-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 1f0650c7 by Apoorv Ingle at 2023-07-16T13:09:30-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 2c4bf5ba by Apoorv Ingle at 2023-07-16T13:09:30-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - f1201d1c by Apoorv Ingle at 2023-07-16T13:09:30-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - 453b4c7f by Apoorv Ingle at 2023-07-16T13:09:30-05:00 trying out changes to heralds - - - - - d8093947 by Apoorv Ingle at 2023-07-16T13:09:30-05:00 add location information for last statements - - - - - 056dd32f by Apoorv Ingle at 2023-07-16T13:09:30-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - 62e8ca9c by Apoorv Ingle at 2023-07-16T13:09:30-05:00 adjusting the generated spans for proper error messages - - - - - 52a786c3 by Apoorv Ingle at 2023-07-16T13:09:30-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - 835ad30a by Apoorv Ingle at 2023-07-16T13:09:30-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - 0640afc7 by Apoorv Ingle at 2023-07-16T13:09:30-05:00 - addStmtCtxt to add the right statement context in the error contexts - expansion stmt to span over bind/>>= application and pattern rather than only the arguments - - - - - 875ff85d by Apoorv Ingle at 2023-07-16T13:09:31-05:00 add stmt context in tcApp rather other places - - - - - 4a99a732 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 add the correct expression context in tcApp - - - - - 9deeeb00 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 disable expansion if applicative do is enabled - - - - - 5669da25 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 handle a special in desugaring when a do block has only one statment, the ds location should be set to that of the last statement - - - - - 4a3c386d by Apoorv Ingle at 2023-07-16T13:09:31-05:00 do not add argument context if it is a do statement - - - - - c6e5eb2e by Apoorv Ingle at 2023-07-16T13:09:31-05:00 remove applicative do expansion - - - - - e1bceb04 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 add context of first do statement in addArgCtxt, somehow it goes missing - - - - - c727ace7 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 add the argument location in error ctxt if it is the first argument of a >> or a >>= - - - - - 8ce2e53e by Apoorv Ingle at 2023-07-16T13:09:31-05:00 - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - - - - - dbd37282 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 some cleanup needed - - - - - 7ddb10de by Apoorv Ingle at 2023-07-16T13:09:31-05:00 - VAExpansionStmt doesn't need srcloc - fix the ppr function for XExprs - - - - - e3f2d4ed by Apoorv Ingle at 2023-07-16T13:09:31-05:00 - Blame the binding body but keep the error context about the statement in addArgCtxt - - - - - 29a0f033 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 - fix the location displayed for the errors that crop up during type checking LetStmt - - - - - 810c1a4b by Apoorv Ingle at 2023-07-16T13:09:31-05:00 Add the statement context in addHeadCtxt - - - - - 98d4359f by Apoorv Ingle at 2023-07-16T13:09:31-05:00 make sure user >> and generated >> have appropriate error messages - - - - - 9550f631 by Apoorv Ingle at 2023-07-16T13:09:31-05:00 - aligning expand stmt context pushing on error stack. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/257c8fc24d49de94d25dcc80c1aa7786a4557042...9550f631dca4fd38643124de63cbbce820508788 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/257c8fc24d49de94d25dcc80c1aa7786a4557042...9550f631dca4fd38643124de63cbbce820508788 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 18:23:40 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sun, 16 Jul 2023 14:23:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/locateda-epa-improve-2023-07-15 Message-ID: <64b435acc2058_3e28d5b515833804b@gitlab.mail> Alan Zimmerman pushed new branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/locateda-epa-improve-2023-07-15 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 18:35:38 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 16 Jul 2023 14:35:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/break-vta Message-ID: <64b4387a9e4c9_3e28d51fa1c790340284@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/break-vta at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/break-vta You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 21:20:12 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sun, 16 Jul 2023 17:20:12 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 24 commits: Put BufSpan into RealSrcSpan Message-ID: <64b45f0ccc8d0_3e28d5b51d036965f@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: d4954257 by Alan Zimmerman at 2023-07-16T21:36:21+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 39c23b2c by Alan Zimmerman at 2023-07-16T21:36:25+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 5366cfe9 by Alan Zimmerman at 2023-07-16T21:36:25+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - d4fc3fa6 by Alan Zimmerman at 2023-07-16T21:36:26+01:00 EPA: Fix span for GRHS - - - - - 726c2ba4 by Alan Zimmerman at 2023-07-16T21:36:26+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - 293c9516 by Alan Zimmerman at 2023-07-16T21:36:26+01:00 EPA: widen more TrailingAnn usages - - - - - e2d824b6 by Alan Zimmerman at 2023-07-16T21:36:26+01:00 EPA: Capture full range for a CaseAlt Match - - - - - c7baaa14 by Alan Zimmerman at 2023-07-16T21:36:26+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 7e1c3a67 by Alan Zimmerman at 2023-07-16T21:36:26+01:00 WIP - - - - - f1442332 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 0793694f by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - f2e670cb by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - 746229e0 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 5be0cc4b by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - f053c89a by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: More extending anchors to full span in Parser.y - - - - - 3c80fb1d by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 583cb821 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: Fix simple tests - - - - - 07fb41b4 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 567e8862 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 0ebaf524 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: deal with fallout from getMonoBind - - - - - fa1b3477 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA fix captureLineSpacing - - - - - bbcf4d87 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA print any comments in the span before exiting it - - - - - c022d236 by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 8539da8e by Alan Zimmerman at 2023-07-16T21:37:22+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 23 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c66c4134944acf95a3ca27fad5f3a97eca8466b8...8539da8e72c84293e9f2b1e77f74204ebd8347a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c66c4134944acf95a3ca27fad5f3a97eca8466b8...8539da8e72c84293e9f2b1e77f74204ebd8347a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 16 22:33:12 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sun, 16 Jul 2023 18:33:12 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 18 commits: EPA: Capture full range for a CaseAlt Match Message-ID: <64b4702828ee5_3e28d51fa1c790384497@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: e30a9e11 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 378b3fbc by Alan Zimmerman at 2023-07-16T22:51:39+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - a1d535b5 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 WIP - - - - - 3e6baeff by Alan Zimmerman at 2023-07-16T22:51:39+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 3acf8031 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 5fa3edb1 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - b69e69f0 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - bb6b5856 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 588b61b8 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: More extending anchors to full span in Parser.y - - - - - 84320548 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 4c42fd68 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: Fix simple tests - - - - - b3179c06 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 7506b46e by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 63ce7d3a by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: deal with fallout from getMonoBind - - - - - 404f9a65 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA fix captureLineSpacing - - - - - 6492244f by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA print any comments in the span before exiting it - - - - - 3acbeee9 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 22090351 by Alan Zimmerman at 2023-07-16T22:51:39+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 11 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/ThToHs.hs - testsuite/tests/ghc-api/exactprint/Test20239.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8539da8e72c84293e9f2b1e77f74204ebd8347a5...220903519e0ab34b8903fc13039037e0b3721070 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8539da8e72c84293e9f2b1e77f74204ebd8347a5...220903519e0ab34b8903fc13039037e0b3721070 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 01:56:19 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sun, 16 Jul 2023 21:56:19 -0400 Subject: [Git][ghc/ghc][wip/sized-literals-deriving] 91 commits: hadrian: Fix dependencies of docs:* rule Message-ID: <64b49fc3ee586_3e28d5b51944070bd@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/sized-literals-deriving at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - f3614a1e by Krzysztof Gogolewski at 2023-07-17T03:54:28+02:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f4cc96b3a2360840d05a2263f61cb23d5b2d15d...f3614a1ed9101bb649ecb58c6edab40f597f8179 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f4cc96b3a2360840d05a2263f61cb23d5b2d15d...f3614a1ed9101bb649ecb58c6edab40f597f8179 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 02:11:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 16 Jul 2023 22:11:50 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/ghc-9.8 Message-ID: <64b4a3664e485_3e28d5b51944138c4@gitlab.mail> Ben Gamari deleted branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 02:11:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 16 Jul 2023 22:11:48 -0400 Subject: [Git][ghc/ghc][ghc-9.8] 40 commits: Bump deepseq bound to allow 1.5 Message-ID: <64b4a3645911c_3e28d5b5194413648@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 1228d3a4 by Ben Gamari at 2023-07-06T20:16:06-04:00 Bump deepseq bound to allow 1.5 - - - - - d3ffdaf9 by Ben Gamari at 2023-07-06T20:21:22-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - bf57fc9a by Ben Gamari at 2023-07-06T21:50:24-04:00 template-haskell: Bump version to 2.21.0.0 - - - - - 433d99a3 by Ben Gamari at 2023-07-12T09:42:25-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 89cb22c2 by Matthew Pickering at 2023-07-12T09:42:25-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 (cherry picked from commit 6295416ba0bc3e729b1f3dea56ef5d722f98ee9d) - - - - - 44b3c6d4 by Matthew Pickering at 2023-07-12T09:42:25-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 (cherry picked from commit 75b8b39a860a643b78405787bac582ba7cc3cb21) - - - - - b934a05f by Ben Gamari at 2023-07-12T09:42:25-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. (cherry picked from commit 46c9bcd6a47bdaa70869ed64da315315974b8b1d) - - - - - 8a6eb56a by Ben Gamari at 2023-07-12T09:42:25-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. (cherry picked from commit ec55035f8fe901b5d369221975fb1a741c677acb) - - - - - 7a5a1163 by Ben Gamari at 2023-07-12T09:42:25-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. (cherry picked from commit 3a09b789102dc0ea20a9af0912bc817ac5cb8c59) - - - - - ea1fb768 by Bryan Richter at 2023-07-12T09:42:25-04:00 Add missing void prototypes to rts functions See #23561. (cherry picked from commit 82ac6bf113526f61913943b911089534705984fb) - - - - - a474caef by Ben Gamari at 2023-07-12T09:42:25-04:00 gitlab-ci: Bump DOCKER_REV Ensuring that we bootstrap with GHC 9.4 universally. - - - - - 024861af by Ben Gamari at 2023-07-12T09:42:26-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. - - - - - 3b12e852 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. (cherry picked from commit 5b6612bc4f6b0a7ecc9868750bee1c359ffca871) - - - - - d72181cd by Ben Gamari at 2023-07-12T09:42:26-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files (cherry picked from commit 8b35e8caafeeccbf06b7faa70e807028a3f0ff43) - - - - - 594525fa by Ben Gamari at 2023-07-12T09:42:26-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. (cherry picked from commit d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8) - - - - - 555ad690 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. (cherry picked from commit 7c7d1f66d35f73a2faa898a33aa80cd276159dc2) - - - - - c4bb9e3e by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Various warnings fixes (cherry picked from commit cb92051e3d85575ff6abd753c9b135930cc50cf8) - - - - - f484169c by Ben Gamari at 2023-07-12T09:42:26-04:00 hadrian: Ignore warnings in unix and semaphore-compat (cherry picked from commit dec81dd1fd0475dde4929baae625d155387300bb) - - - - - 9922b77c by Matthew Pickering at 2023-07-12T09:42:26-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 (cherry picked from commit d7f6448aa06bbf26173a06ee5c624f5b734786c5) - - - - - ab74326f by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. (cherry picked from commit fd8c57694a00f6359bd66365f1284388c869ac60) - - - - - 9d9d9bc5 by Luite Stegeman at 2023-07-12T09:42:26-04:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 (cherry picked from commit 564164ef323a9f2cdeb8c69dcb2cf6df6382de4e) - - - - - a6ebaa83 by Torsten Schmits at 2023-07-12T09:42:26-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 (cherry picked from commit 40f4ef7c40e747dfea491d297475458d2ccaf860) - - - - - 3d6bd455 by Torsten Schmits at 2023-07-12T09:42:26-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 (cherry picked from commit 6fdcf969db85f3fe64123ba150e9226a0d2995cd) - - - - - a814fb6d by Ben Bellick at 2023-07-12T09:42:26-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure (cherry picked from commit 03f941f45607a5ee52ca53a358333bbb41ddb1bc) - - - - - cee76805 by aadaa_fgtaa at 2023-07-12T09:42:26-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts (cherry picked from commit b3e1436f968c0c36a27ea0339ee2554970b329fe) - - - - - 445dc082 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Add failing test case for #23492 (cherry picked from commit 6074cc3cda9b9836c784942a1aa7f766fb142787) - - - - - c505474d by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. (cherry picked from commit 356a269258a50bf67811fe0edb193fc9f82dfad1) - - - - - 765c1de8 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils (cherry picked from commit 3efe7f399a53ec7930c8a333ad2c114d956f0c2a) - - - - - 809f9b81 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors (cherry picked from commit dd782343f131cfd983a7fb2431d9d4a9ae497551) - - - - - 76668b6e by Ben Gamari at 2023-07-12T09:42:26-04:00 Fix breakpoint - - - - - 2b3da4c4 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. (cherry picked from commit bb0ed354b9b05c0774c1e9379823bceb785987ce) - - - - - 62bfea7a by Ben Gamari at 2023-07-13T08:10:26-04:00 gitlab-ci: Bump ci-images To freeze emsdk, avoiding #23641. - - - - - a01879a7 by Ben Gamari at 2023-07-13T08:10:26-04:00 testsuite: Accept metric changes Metric Increase: T6048 - - - - - c046a238 by Ben Gamari at 2023-07-13T08:10:26-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. - - - - - f356a7e8 by Ben Gamari at 2023-07-13T08:10:26-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. - - - - - c86a4055 by Ben Gamari at 2023-07-13T16:19:02-04:00 Update generate_bootstrap_plans - - - - - d58049ef by Ben Gamari at 2023-07-13T16:28:54-04:00 hadrian/bootstrap: Drop GHC 9.2 plans - - - - - a79d1806 by Ben Gamari at 2023-07-13T16:29:39-04:00 hadrian/bootstrap: Add 9.6.2 plans - - - - - 4f142ee9 by Ben Gamari at 2023-07-13T16:34:08-04:00 hadrian/bootstrap: Regenerate existing plans - - - - - 031d7f7c by Ben Gamari at 2023-07-13T17:27:30-04:00 gitlab-ci: Drop test-bootstrap:9.2 jobs - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - ghc/ghc-bin.cabal.in - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18658545ce45254a4679c13de5dcc56a4c8373f...031d7f7ca035cfe87a72da5c757ba85e52c50a40 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18658545ce45254a4679c13de5dcc56a4c8373f...031d7f7ca035cfe87a72da5c757ba85e52c50a40 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 02:28:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 16 Jul 2023 22:28:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Don't use substTyUnchecked in newMetaTyVar Message-ID: <64b4a748b2330_3e28d5b518041747f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - ccd70d7f by sheaf at 2023-07-16T22:28:01-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 86cb5da2 by sheaf at 2023-07-16T22:28:01-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 95c01b41 by Alan Zimmerman at 2023-07-16T22:28:02-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 20 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr - + testsuite/tests/overloadedrecflds/should_compile/T23557.hs - + testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/parser/should_compile/DumpSemis.stderr - + testsuite/tests/rename/should_fail/SimilarNamesImport.hs - + testsuite/tests/rename/should_fail/SimilarNamesImport.stderr - + testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs - testsuite/tests/rename/should_fail/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1707,9 +1707,9 @@ cvars1 :: { [RecordPatSynField GhcPs] } where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) } : 'where' '{' decls '}' {% amsrl (sLL $1 $> (snd $ unLoc $3)) - (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) [mj AnnWhere $1] (fst $ unLoc $3)) } + (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) (mj AnnWhere $1: (fst $ unLoc $3)) []) } | 'where' vocurly decls close {% amsrl (sLL $1 $3 (snd $ unLoc $3)) - (AnnList (Just $ glR $3) Nothing Nothing [mj AnnWhere $1] (fst $ unLoc $3))} + (AnnList (Just $ glR $3) Nothing Nothing (mj AnnWhere $1: (fst $ unLoc $3)) []) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype @@ -1822,9 +1822,9 @@ where_inst :: { Located ([AddEpAnn] -- Declarations in binding groups other than classes and instances -- -decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } +decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } : decls ';' decl {% if isNilOL (snd $ unLoc $1) - then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemiA $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1835,7 +1835,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } return (rest `seq` this `seq` these `seq` (sLL $1 $> (fst $ unLoc $1, these))) } | decls ';' {% if isNilOL (snd $ unLoc $1) - then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemiA $2) ,snd $ unLoc $1))) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1846,9 +1846,9 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } - : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) [] (fst $ unLoc $2) + : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) (fst $ unLoc $2) [] ,sL1 $2 $ snd $ unLoc $2) } - | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing [] (fst $ unLoc $2) + | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) [] ,sL1 $2 $ snd $ unLoc $2) } -- Binding groups other than those of class and instance declarations @@ -4282,6 +4282,9 @@ mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)] msemi :: Located e -> [TrailingAnn] msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)] +msemiA :: Located e -> [AddEpAnn] +msemiA l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)] + msemim :: Located e -> Maybe EpaLocation msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l) ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -497,7 +497,7 @@ patch_anchor r1 (Anchor r0 op) = Anchor r op fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs) - = (EpAnn (widenAnchor anchor (map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs) + = (EpAnn (widenAnchor anchor (r ++ map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs) -- | The 'Anchor' for a stmtlist is based on either the location or -- the first semicolon annotion. ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -38,6 +38,8 @@ import GHC.Driver.Ppr import GHC.Rename.Env import GHC.Rename.Fixity import GHC.Rename.Utils ( warnUnusedTopBinds ) +import GHC.Rename.Unbound +import qualified GHC.Rename.Unbound as Unbound import GHC.Tc.Errors.Types import GHC.Tc.Utils.Env @@ -67,6 +69,7 @@ import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Types.Avail import GHC.Types.FieldLabel +import GHC.Types.Hint import GHC.Types.SourceFile import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Basic ( TopLevelFlag(..) ) @@ -308,7 +311,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in -- -- 4. A boolean 'AnyHpcUsage' which is true if the imported module -- used HPC. -rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc) +rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc) -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage) rnImportDecl this_mod (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name @@ -1228,11 +1231,11 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) = failLookupWith (QualImportError rdr) | otherwise = case lookups of - [] -> failLookupWith (BadImport ie BadImportIsParent) + [] -> failLookupWith (BadImport ie IsNotSubordinate) item:items -> return $ item :| items where lookups = concatMap nonDetNameEnvElts - $ lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr) + $ lookupImpOccEnv (RelevantGREsFOS WantNormal) imp_occ_env (rdrNameOcc rdr) lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])] lookup_lie (L loc ieRdr) @@ -1252,7 +1255,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- 'BadImportW' is only constructed below in 'handle_bad_import', in -- the 'EverythingBut' case, so that's what we pass to -- 'badImportItemErr'. - reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails + reason <- badImportItemErr iface decl_spec ie IsNotSubordinate all_avails pure (TcRnDodgyImports (DodgyImportsHiding reason)) warning_msg (DeprecatedExport n w) = pure (TcRnPragmaWarning { @@ -1338,7 +1341,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) dc_name = lookup_parent ie (setRdrNameSpace tc srcDataName) in case catIELookupM [ tc_name, dc_name ] of - [] -> failLookupWith (BadImport ie BadImportIsParent) + [] -> failLookupWith (BadImport ie IsNotSubordinate) names -> return ( [mkIEThingAbs tc' l (imp_item name) | name <- names], []) | otherwise -> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc') @@ -1354,7 +1357,8 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- See Note [Importing DuplicateRecordFields] case lookupChildren subnames rdr_ns of - Failed rdrs -> failLookupWith (BadImport (IEThingWith (deprecation, ann) ltc wc rdrs ) BadImportIsSubordinate) + Failed rdrs -> failLookupWith $ + BadImport (IEThingWith (deprecation, ann) ltc wc rdrs) IsSubordinate -- We are trying to import T( a,b,c,d ), and failed -- to find 'b' and 'd'. So we make up an import item -- to report as failing, namely T( b, d ). @@ -1382,7 +1386,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) where n = greName gre handle_bad_import m = catchIELookup m $ \err -> case err of - BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie]) + BadImport ie _ + | want_hiding == EverythingBut + -> return ([], [BadImportW ie]) _ -> failLookupWith err mk_depr_export_warning gre @@ -1398,11 +1404,13 @@ data IELookupWarning | DodgyImport GlobalRdrElt | DeprecatedExport Name (WarningTxt GhcRn) -data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate +-- | Is this import/export item a subordinate or not? +data IsSubordinate + = IsSubordinate | IsNotSubordinate data IELookupError = QualImportError RdrName - | BadImport (IE GhcPs) BadImportIsSubordinate + | BadImport (IE GhcPs) IsSubordinate | IllegalImport failLookupWith :: IELookupError -> IELookupM a @@ -1486,6 +1494,23 @@ mkImportOccEnv hsc_env decl_spec all_avails = else item1 -- Discard standalone pattern P in favour of T(P). +-- | Essentially like @lookupGRE env (LookupOccName occ which_gres)@, +-- but working with 'ImpOccItem's instead of 'GlobalRdrElt's. +lookupImpOccEnv :: WhichGREs GREInfo + -> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem] +lookupImpOccEnv which_gres env occ = + mapMaybe relevant_items $ lookupOccEnv_AllNameSpaces env occ + where + is_relevant :: ImpOccItem -> Bool + is_relevant (ImpOccItem { imp_item = gre }) = + greIsRelevant which_gres (occNameSpace occ) gre + relevant_items :: NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem) + relevant_items nms + | let nms' = filterNameEnv is_relevant nms + = if isEmptyNameEnv nms' + then Nothing + else Just nms' + {- ************************************************************************ * * @@ -2134,21 +2159,42 @@ DRFPatSynExport for a test of this. -} badImportItemErr - :: ModIface -> ImpDeclSpec -> IE GhcPs -> BadImportIsSubordinate + :: ModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinate -> [AvailInfo] -> TcRn ImportLookupReason badImportItemErr iface decl_spec ie sub avails = do patsyns_enabled <- xoptM LangExt.PatternSynonyms expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces - pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled) + dflags <- getDynFlags + hsc_env <- getTopEnv + let rdr_env = mkGlobalRdrEnv + $ gresFromAvails hsc_env (Just imp_spec) all_avails + pure (ImportLookupBad (importErrorKind dflags rdr_env expl_ns_enabled) iface decl_spec ie patsyns_enabled) where - importErrorKind expl_ns_enabled + importErrorKind dflags rdr_env expl_ns_enabled | any checkIfTyCon avails = case sub of - BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled - BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren + IsNotSubordinate -> BadImportAvailTyCon expl_ns_enabled + IsSubordinate -> BadImportNotExportedSubordinates unavailableChildren | any checkIfVarName avails = BadImportAvailVar | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) - | otherwise = BadImportNotExported + | otherwise = BadImportNotExported suggs + where + suggs = similar_suggs ++ fieldSelectorSuggestions rdr_env rdr + similar_names = + similarNameSuggestions (Unbound.LF WL_Anything WL_Global) + dflags rdr_env emptyLocalRdrEnv rdr + similar_suggs = + case NE.nonEmpty $ mapMaybe imported_item $ similar_names of + Just similar -> [ SuggestSimilarNames rdr similar ] + Nothing -> [ ] + + -- Only keep imported items, and set the "HowInScope" to + -- "Nothing" to avoid printing "imported from..." in the suggestion + -- error message. + imported_item (SimilarRdrName rdr_name (Just (ImportedBy {}))) + = Just (SimilarRdrName rdr_name Nothing) + imported_item _ = Nothing + checkIfDataCon = checkIfAvailMatches isDataConName checkIfTyCon = checkIfAvailMatches isTyConName checkIfVarName = @@ -2164,9 +2210,12 @@ badImportItemErr iface decl_spec ie sub avails = do Nothing -> False Avail{} -> False availOccName = occName . availName - importedFS = occNameFS . rdrNameOcc $ ieName ie - unavailableChildren = map (rdrNameOcc) $ case ie of - IEThingWith _ _ _ ns -> map (ieWrappedName . unLoc) ns + rdr = ieName ie + importedFS = occNameFS $ rdrNameOcc rdr + imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } + all_avails = mi_exports iface + unavailableChildren = case ie of + IEThingWith _ _ _ ns -> map (rdrNameOcc . ieWrappedName . unLoc) ns _ -> panic "importedChildren failed pattern match: no children" addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn () ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -15,6 +15,8 @@ module GHC.Rename.Unbound , reportUnboundName , reportUnboundName' , unknownNameSuggestions + , similarNameSuggestions + , fieldSelectorSuggestions , WhatLooking(..) , WhereLooking(..) , LookingFor(..) @@ -225,7 +227,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env all_possibilities :: [(String, SimilarName)] all_possibilities = case what_look of WL_None -> [] - _ -> [ (showPpr dflags r, SimilarRdrName r (LocallyBoundAt loc)) + _ -> [ (showPpr dflags r, SimilarRdrName r (Just $ LocallyBoundAt loc)) | (r,loc) <- local_possibilities local_env ] ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ] @@ -256,7 +258,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)] global_possibilities global_env - | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual how) + | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual (Just how)) | gre <- globalRdrEnvElts global_env , isGreOk looking_for gre , let occ = greOccName gre @@ -271,7 +273,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env rdr_unqual = mkRdrUnqual occ , correct_name_space occ , sim <- case (unquals_in_scope gre, quals_only gre) of - (how:_, _) -> [ SimilarRdrName rdr_unqual how ] + (how:_, _) -> [ SimilarRdrName rdr_unqual (Just how) ] ([], pr:_) -> [ pr ] -- See Note [Only-quals] ([], []) -> [] ] @@ -299,7 +301,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env quals_only :: GlobalRdrElt -> [SimilarName] -- Ones for which *only* the qualified version is in scope quals_only (gre at GRE { gre_imp = is }) - = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (ImportedBy ispec)) + = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (Just $ ImportedBy ispec)) | i <- bagToList is, let ispec = is_decl i, is_qual ispec ] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -62,9 +62,11 @@ import GHC.Driver.Backend import GHC.Hs import GHC.Tc.Errors.Types +import GHC.Tc.Types.BasicTypes import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank (Rank(..)) +import GHC.Tc.Types.TH import GHC.Tc.Utils.TcType import GHC.Types.Error @@ -116,8 +118,6 @@ import Data.List ( groupBy, sortBy, tails , partition, unfoldr ) import Data.Ord ( comparing ) import Data.Bifunctor -import GHC.Tc.Types.TH -import GHC.Tc.Types.BasicTypes defaultTcRnMessageOpts :: TcRnMessageOpts @@ -3085,12 +3085,12 @@ instance Diagnostic TcRnMessage where let mod_name = moduleName $ is_mod is occ = rdrNameOcc $ ieName ie in case k of - BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] - BadImportNotExported -> noHints - BadImportAvailTyCon ex_ns -> + BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] + BadImportNotExported suggs -> suggs + BadImportAvailTyCon ex_ns -> [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns] ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] - BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] + BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints TcRnImportLookup{} -> noHints @@ -5343,7 +5343,7 @@ pprImportLookup = \case hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) 2 (vcat msgs) in case k of - BadImportNotExported -> + BadImportNotExported _ -> vcat [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> text "does not export" <+> quotes (ppr ie) <> dot ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5250,7 +5250,7 @@ data WhenMatching data BadImportKind -- | Module does not export... - = BadImportNotExported + = BadImportNotExported [GhcHint] -- ^ suggestions for what might have been meant -- | Missing @type@ keyword when importing a type. -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+) -- Then we want to suggest using `import TypeLits( type (+) )` ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1001,16 +1001,7 @@ new_meta_tv_x info subst tv ; let subst1 = extendTvSubstWithClone subst tv new_tv ; return (subst1, new_tv) } where - substd_kind = substTyUnchecked subst (tyVarKind tv) - -- NOTE: #12549 is fixed so we could use - -- substTy here, but the tc_infer_args problem - -- is not yet fixed so leaving as unchecked for now. - -- OLD NOTE: - -- Unchecked because we call newMetaTyVarX from - -- tcInstTyBinder, which is called from tcInferTyApps - -- which does not yet take enough trouble to ensure - -- the in-scope set is right; e.g. #12785 trips - -- if we use substTy here + substd_kind = substTy subst (tyVarKind tv) newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType newMetaTyVarTyAtLevel tc_lvl kind ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -515,7 +515,7 @@ data HowInScope data SimilarName = SimilarName Name - | SimilarRdrName RdrName HowInScope + | SimilarRdrName RdrName (Maybe HowInScope) -- | Something is promoted to the type-level without a promotion tick. data UntickedPromotedThing ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -353,18 +353,17 @@ pprSimilarName :: NameSpace -> SimilarName -> SDoc pprSimilarName _ (SimilarName name) = quotes (ppr name) <+> parens (pprDefinedAt name) pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope) - = case how_in_scope of - LocallyBoundAt loc -> - pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc' - where - loc' = case loc of - UnhelpfulSpan l -> parens (ppr l) - RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) - ImportedBy is -> - pp_ns rdr_name <+> quotes (ppr rdr_name) <+> - parens (text "imported from" <+> ppr (moduleName $ is_mod is)) - + = pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc where + loc = case how_in_scope of + Nothing -> empty + Just scope -> case scope of + LocallyBoundAt loc -> + case loc of + UnhelpfulSpan l -> parens (ppr l) + RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) + ImportedBy is -> + parens (text "imported from" <+> ppr (moduleName $ is_mod is)) pp_ns :: RdrName -> SDoc pp_ns rdr | ns /= tried_ns = pprNameSpace ns | otherwise = empty ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -1313,19 +1313,19 @@ lookupGRE env = \case -- -- This allows us to first look in e.g. the data 'NameSpace', and then fall back -- to the type/class 'NameSpace'. -highestPriorityGREs :: forall info prio +highestPriorityGREs :: forall gre prio . Ord prio - => (GlobalRdrEltX info -> Maybe prio) + => (gre -> Maybe prio) -- ^ priority function -- lower value <=> higher priority - -> [GlobalRdrEltX info] -> [GlobalRdrEltX info] + -> [gre] -> [gre] highestPriorityGREs priority gres = take_highest_prio $ NE.group $ sort [ S.Arg prio gre | gre <- gres , prio <- maybeToList $ priority gre ] where - take_highest_prio :: [NE.NonEmpty (S.Arg prio (GlobalRdrEltX info))] -> [GlobalRdrEltX info] + take_highest_prio :: [NE.NonEmpty (S.Arg prio gre)] -> [gre] take_highest_prio [] = [] take_highest_prio (fs:_) = map (\ (S.Arg _ gre) -> gre) $ NE.toList fs {-# INLINEABLE highestPriorityGREs #-} ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr ===================================== @@ -1,6 +1,6 @@ -T22106_C.hs:5:9: error: [GHC-88464] - Variable not in scope: bar +T22106_C.hs:3:21: error: [GHC-61689] + Module ‘T22106_aux’ does not export ‘bar’. Suggested fix: Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’ that has been suppressed by NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T23557.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Werror=unused-imports #-} + +module T23557 (main) where + +import T23557_aux (foo) + +main :: IO () +main = print foo + +-- We should not get an unused import for the import of the field selector "foo", +-- because the module we are importing from uses NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module T23557_aux where + +foo :: Int +foo = 23 + +data Foo = Foo { + foo :: Int +} ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -50,9 +50,9 @@ test('BootFldReexport' test('T23220' , [req_th, extra_files(['T23220_aux.hs'])] , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0']) - test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0']) test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0']) +test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-v0']) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -1517,17 +1517,12 @@ (AddEpAnn AnnOpenC (EpaSpan { DumpSemis.hs:34:13 }))) (Just (AddEpAnn AnnCloseC (EpaSpan { DumpSemis.hs:34:31 }))) - [] - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:14 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:15 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:16 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:17 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:18 }))]) + [(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:14 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:15 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:16 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:17 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:18 }))] + []) (EpaComments [])) (ValBinds ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport.hs ===================================== @@ -0,0 +1,3 @@ +module SimilarNamesImport where + +import SimilarNamesImport_aux ( dyzzy, Wabble, wabble, Trizzle(bizzy) ) ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport.stderr ===================================== @@ -0,0 +1,16 @@ + +SimilarNamesImport.hs:3:33: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘dyzzy’. + Suggested fix: + Perhaps use one of these: record field of MkD ‘dizzy’, ‘xyzzy’ + +SimilarNamesImport.hs:3:40: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘Wabble’. + Suggested fix: Perhaps use ‘Wibble’ + +SimilarNamesImport.hs:3:48: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘wabble’. + +SimilarNamesImport.hs:3:56: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘Trizzle’. + Suggested fix: Perhaps use one of these: ‘Drizzle’, ‘Frizzle’ ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs ===================================== @@ -0,0 +1,11 @@ +module SimilarNamesImport_aux where + +xyzzy :: Double +xyzzy = exp $ pi * sqrt 163 + + +data Drizzle = MkD { dizzy :: Int } +data Frizzle = MkE { fizzy :: Bool } + +data Wibble + ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -199,6 +199,7 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('SimilarNamesImport', [extra_files(['SimilarNamesImport_aux.hs'])], multimod_compile_fail, ['SimilarNamesImport', '-v0']) test('T23510a', normal, compile_fail, ['']) test('T16635a', normal, compile_fail, ['']) test('T16635b', normal, compile_fail, ['']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1176,32 +1176,27 @@ markKwT (AddVbarAnn ss) = AddVbarAnn <$> markKwA AnnVbar ss -- --------------------------------------------------------------------- markAnnList :: (Monad m, Monoid w) - => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) -markAnnList reallyTrail ann action = do - markAnnListA reallyTrail ann $ \a -> do + => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) +markAnnList ann action = do + markAnnListA ann $ \a -> do r <- action return (a,r) markAnnListA :: (Monad m, Monoid w) - => Bool -> EpAnn AnnList + => EpAnn AnnList -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a)) -> EP w m (EpAnn AnnList, a) -markAnnListA _ EpAnnNotUsed action = do +markAnnListA EpAnnNotUsed action = do action EpAnnNotUsed -markAnnListA reallyTrail an action = do +markAnnListA an action = do debugM $ "markAnnListA: an=" ++ showAst an an0 <- markLensMAA an lal_open - an1 <- if (not reallyTrail) - then markTrailingL an0 lal_trailing - else return an0 - an2 <- markEpAnnAllL an1 lal_rest AnnSemi - (an3, r) <- action an2 - an4 <- markLensMAA an3 lal_close - an5 <- if reallyTrail - then markTrailingL an4 lal_trailing - else return an4 - debugM $ "markAnnListA: an5=" ++ showAst an - return (an5, r) + an1 <- markEpAnnAllL an0 lal_rest AnnSemi + (an2, r) <- action an1 + an3 <- markLensMAA an2 lal_close + an4 <- markTrailingL an3 lal_trailing + debugM $ "markAnnListA: an4=" ++ showAst an + return (an4, r) -- --------------------------------------------------------------------- @@ -2297,12 +2292,12 @@ instance ExactPrint (HsLocalBinds GhcPs) where when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc) _ -> return () - (an1, valbinds') <- markAnnList False an0 $ markAnnotatedWithLayout valbinds + (an1, valbinds') <- markAnnList an0 $ markAnnotatedWithLayout valbinds debugM $ "exact HsValBinds: an1=" ++ showAst an1 return (HsValBinds an1 valbinds') exact (HsIPBinds an bs) = do - (as, ipb) <- markAnnList True an (markEpAnnL an lal_rest AnnWhere + (as, ipb) <- markAnnList an (markEpAnnL an lal_rest AnnWhere >> markAnnotated bs >>= \bs' -> return (HsIPBinds an bs'::HsLocalBinds GhcPs)) case ipb of @@ -2845,7 +2840,7 @@ instance ExactPrint (HsExpr GhcPs) where exact (HsDo an do_or_list_comp stmts) = do debugM $ "HsDo" - (an',stmts') <- markAnnListA True an $ \a -> exactDo a do_or_list_comp stmts + (an',stmts') <- markAnnListA an $ \a -> exactDo a do_or_list_comp stmts return (HsDo an' do_or_list_comp stmts') exact (ExplicitList an es) = do @@ -3379,7 +3374,7 @@ instance ( exact (RecStmt an stmts a b c d e) = do debugM $ "RecStmt" an0 <- markEpAnnL an lal_rest AnnRec - (an1, stmts') <- markAnnList True an0 (markAnnotated stmts) + (an1, stmts') <- markAnnList an0 (markAnnotated stmts) return (RecStmt an1 stmts' a b c d e) -- --------------------------------------------------------------------- @@ -4400,7 +4395,7 @@ instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where an0 <- markEpAnnL an lal_rest AnnHiding p <- getPosP debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p - (an1, ies') <- markAnnList True an0 (markAnnotated ies) + (an1, ies') <- markAnnList an0 (markAnnotated ies) return (L (SrcSpanAnn an1 l) ies') instance (ExactPrint (Match GhcPs (LocatedA body))) @@ -4423,7 +4418,7 @@ instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr Gh setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) stmts) = do debugM $ "LocatedL [ExprLStmt" - (an'', stmts') <- markAnnList True an $ do + (an'', stmts') <- markAnnList an $ do case snocView stmts of Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do debugM $ "LocatedL [ExprLStmt: snocView" @@ -4450,7 +4445,7 @@ instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) fs) = do debugM $ "LocatedL [LConDeclField" - (an', fs') <- markAnnList True an (markAnnotated fs) + (an', fs') <- markAnnList an (markAnnotated fs) return (L (SrcSpanAnn an' l) fs') instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where @@ -4458,7 +4453,7 @@ instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) bf) = do debugM $ "LocatedL [LBooleanFormula" - (an', bf') <- markAnnList True an (markAnnotated bf) + (an', bf') <- markAnnList an (markAnnotated bf) return (L (SrcSpanAnn an' l) bf') -- --------------------------------------------------------------------- @@ -4616,7 +4611,7 @@ instance ExactPrint (Pat GhcPs) where return (BangPat an0 pat') exact (ListPat an pats) = do - (an', pats') <- markAnnList True an (markAnnotated pats) + (an', pats') <- markAnnList an (markAnnotated pats) return (ListPat an' pats') exact (TuplePat an pats boxity) = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/857fdb005d35eb65047fd6a39d290c8230762584...95c01b41970b100966a091138ea2276721139a30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/857fdb005d35eb65047fd6a39d290c8230762584...95c01b41970b100966a091138ea2276721139a30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 02:55:18 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sun, 16 Jul 2023 22:55:18 -0400 Subject: [Git][ghc/ghc][wip/core-lint-let] 248 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <64b4ad96d4edd_3e28d5b51584249f6@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/core-lint-let at Glasgow Haskell Compiler / GHC Commits: 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - 56cf0b4d by Krzysztof Gogolewski at 2023-07-17T04:55:04+02:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c4efac01009d8b7929a11ccb74a32c1dc1fca32...56cf0b4dbbeb091691d29771b53fee8e8c94d865 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c4efac01009d8b7929a11ccb74a32c1dc1fca32...56cf0b4dbbeb091691d29771b53fee8e8c94d865 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 06:48:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 02:48:49 -0400 Subject: [Git][ghc/ghc][master] 2 commits: rnImports: var shouldn't import NoFldSelectors Message-ID: <64b4e4519230_3e28d5b515844852a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 15 changed files: - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr - + testsuite/tests/overloadedrecflds/should_compile/T23557.hs - + testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - + testsuite/tests/rename/should_fail/SimilarNamesImport.hs - + testsuite/tests/rename/should_fail/SimilarNamesImport.stderr - + testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -38,6 +38,8 @@ import GHC.Driver.Ppr import GHC.Rename.Env import GHC.Rename.Fixity import GHC.Rename.Utils ( warnUnusedTopBinds ) +import GHC.Rename.Unbound +import qualified GHC.Rename.Unbound as Unbound import GHC.Tc.Errors.Types import GHC.Tc.Utils.Env @@ -67,6 +69,7 @@ import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Types.Avail import GHC.Types.FieldLabel +import GHC.Types.Hint import GHC.Types.SourceFile import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Basic ( TopLevelFlag(..) ) @@ -308,7 +311,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in -- -- 4. A boolean 'AnyHpcUsage' which is true if the imported module -- used HPC. -rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc) +rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc) -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage) rnImportDecl this_mod (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name @@ -1228,11 +1231,11 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) = failLookupWith (QualImportError rdr) | otherwise = case lookups of - [] -> failLookupWith (BadImport ie BadImportIsParent) + [] -> failLookupWith (BadImport ie IsNotSubordinate) item:items -> return $ item :| items where lookups = concatMap nonDetNameEnvElts - $ lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr) + $ lookupImpOccEnv (RelevantGREsFOS WantNormal) imp_occ_env (rdrNameOcc rdr) lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])] lookup_lie (L loc ieRdr) @@ -1252,7 +1255,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- 'BadImportW' is only constructed below in 'handle_bad_import', in -- the 'EverythingBut' case, so that's what we pass to -- 'badImportItemErr'. - reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails + reason <- badImportItemErr iface decl_spec ie IsNotSubordinate all_avails pure (TcRnDodgyImports (DodgyImportsHiding reason)) warning_msg (DeprecatedExport n w) = pure (TcRnPragmaWarning { @@ -1338,7 +1341,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) dc_name = lookup_parent ie (setRdrNameSpace tc srcDataName) in case catIELookupM [ tc_name, dc_name ] of - [] -> failLookupWith (BadImport ie BadImportIsParent) + [] -> failLookupWith (BadImport ie IsNotSubordinate) names -> return ( [mkIEThingAbs tc' l (imp_item name) | name <- names], []) | otherwise -> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc') @@ -1354,7 +1357,8 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- See Note [Importing DuplicateRecordFields] case lookupChildren subnames rdr_ns of - Failed rdrs -> failLookupWith (BadImport (IEThingWith (deprecation, ann) ltc wc rdrs ) BadImportIsSubordinate) + Failed rdrs -> failLookupWith $ + BadImport (IEThingWith (deprecation, ann) ltc wc rdrs) IsSubordinate -- We are trying to import T( a,b,c,d ), and failed -- to find 'b' and 'd'. So we make up an import item -- to report as failing, namely T( b, d ). @@ -1382,7 +1386,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) where n = greName gre handle_bad_import m = catchIELookup m $ \err -> case err of - BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie]) + BadImport ie _ + | want_hiding == EverythingBut + -> return ([], [BadImportW ie]) _ -> failLookupWith err mk_depr_export_warning gre @@ -1398,11 +1404,13 @@ data IELookupWarning | DodgyImport GlobalRdrElt | DeprecatedExport Name (WarningTxt GhcRn) -data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate +-- | Is this import/export item a subordinate or not? +data IsSubordinate + = IsSubordinate | IsNotSubordinate data IELookupError = QualImportError RdrName - | BadImport (IE GhcPs) BadImportIsSubordinate + | BadImport (IE GhcPs) IsSubordinate | IllegalImport failLookupWith :: IELookupError -> IELookupM a @@ -1486,6 +1494,23 @@ mkImportOccEnv hsc_env decl_spec all_avails = else item1 -- Discard standalone pattern P in favour of T(P). +-- | Essentially like @lookupGRE env (LookupOccName occ which_gres)@, +-- but working with 'ImpOccItem's instead of 'GlobalRdrElt's. +lookupImpOccEnv :: WhichGREs GREInfo + -> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem] +lookupImpOccEnv which_gres env occ = + mapMaybe relevant_items $ lookupOccEnv_AllNameSpaces env occ + where + is_relevant :: ImpOccItem -> Bool + is_relevant (ImpOccItem { imp_item = gre }) = + greIsRelevant which_gres (occNameSpace occ) gre + relevant_items :: NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem) + relevant_items nms + | let nms' = filterNameEnv is_relevant nms + = if isEmptyNameEnv nms' + then Nothing + else Just nms' + {- ************************************************************************ * * @@ -2134,21 +2159,42 @@ DRFPatSynExport for a test of this. -} badImportItemErr - :: ModIface -> ImpDeclSpec -> IE GhcPs -> BadImportIsSubordinate + :: ModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinate -> [AvailInfo] -> TcRn ImportLookupReason badImportItemErr iface decl_spec ie sub avails = do patsyns_enabled <- xoptM LangExt.PatternSynonyms expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces - pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled) + dflags <- getDynFlags + hsc_env <- getTopEnv + let rdr_env = mkGlobalRdrEnv + $ gresFromAvails hsc_env (Just imp_spec) all_avails + pure (ImportLookupBad (importErrorKind dflags rdr_env expl_ns_enabled) iface decl_spec ie patsyns_enabled) where - importErrorKind expl_ns_enabled + importErrorKind dflags rdr_env expl_ns_enabled | any checkIfTyCon avails = case sub of - BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled - BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren + IsNotSubordinate -> BadImportAvailTyCon expl_ns_enabled + IsSubordinate -> BadImportNotExportedSubordinates unavailableChildren | any checkIfVarName avails = BadImportAvailVar | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) - | otherwise = BadImportNotExported + | otherwise = BadImportNotExported suggs + where + suggs = similar_suggs ++ fieldSelectorSuggestions rdr_env rdr + similar_names = + similarNameSuggestions (Unbound.LF WL_Anything WL_Global) + dflags rdr_env emptyLocalRdrEnv rdr + similar_suggs = + case NE.nonEmpty $ mapMaybe imported_item $ similar_names of + Just similar -> [ SuggestSimilarNames rdr similar ] + Nothing -> [ ] + + -- Only keep imported items, and set the "HowInScope" to + -- "Nothing" to avoid printing "imported from..." in the suggestion + -- error message. + imported_item (SimilarRdrName rdr_name (Just (ImportedBy {}))) + = Just (SimilarRdrName rdr_name Nothing) + imported_item _ = Nothing + checkIfDataCon = checkIfAvailMatches isDataConName checkIfTyCon = checkIfAvailMatches isTyConName checkIfVarName = @@ -2164,9 +2210,12 @@ badImportItemErr iface decl_spec ie sub avails = do Nothing -> False Avail{} -> False availOccName = occName . availName - importedFS = occNameFS . rdrNameOcc $ ieName ie - unavailableChildren = map (rdrNameOcc) $ case ie of - IEThingWith _ _ _ ns -> map (ieWrappedName . unLoc) ns + rdr = ieName ie + importedFS = occNameFS $ rdrNameOcc rdr + imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } + all_avails = mi_exports iface + unavailableChildren = case ie of + IEThingWith _ _ _ ns -> map (rdrNameOcc . ieWrappedName . unLoc) ns _ -> panic "importedChildren failed pattern match: no children" addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn () ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -15,6 +15,8 @@ module GHC.Rename.Unbound , reportUnboundName , reportUnboundName' , unknownNameSuggestions + , similarNameSuggestions + , fieldSelectorSuggestions , WhatLooking(..) , WhereLooking(..) , LookingFor(..) @@ -225,7 +227,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env all_possibilities :: [(String, SimilarName)] all_possibilities = case what_look of WL_None -> [] - _ -> [ (showPpr dflags r, SimilarRdrName r (LocallyBoundAt loc)) + _ -> [ (showPpr dflags r, SimilarRdrName r (Just $ LocallyBoundAt loc)) | (r,loc) <- local_possibilities local_env ] ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ] @@ -256,7 +258,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)] global_possibilities global_env - | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual how) + | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual (Just how)) | gre <- globalRdrEnvElts global_env , isGreOk looking_for gre , let occ = greOccName gre @@ -271,7 +273,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env rdr_unqual = mkRdrUnqual occ , correct_name_space occ , sim <- case (unquals_in_scope gre, quals_only gre) of - (how:_, _) -> [ SimilarRdrName rdr_unqual how ] + (how:_, _) -> [ SimilarRdrName rdr_unqual (Just how) ] ([], pr:_) -> [ pr ] -- See Note [Only-quals] ([], []) -> [] ] @@ -299,7 +301,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env quals_only :: GlobalRdrElt -> [SimilarName] -- Ones for which *only* the qualified version is in scope quals_only (gre at GRE { gre_imp = is }) - = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (ImportedBy ispec)) + = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (Just $ ImportedBy ispec)) | i <- bagToList is, let ispec = is_decl i, is_qual ispec ] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -62,9 +62,11 @@ import GHC.Driver.Backend import GHC.Hs import GHC.Tc.Errors.Types +import GHC.Tc.Types.BasicTypes import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank (Rank(..)) +import GHC.Tc.Types.TH import GHC.Tc.Utils.TcType import GHC.Types.Error @@ -116,8 +118,6 @@ import Data.List ( groupBy, sortBy, tails , partition, unfoldr ) import Data.Ord ( comparing ) import Data.Bifunctor -import GHC.Tc.Types.TH -import GHC.Tc.Types.BasicTypes defaultTcRnMessageOpts :: TcRnMessageOpts @@ -3085,12 +3085,12 @@ instance Diagnostic TcRnMessage where let mod_name = moduleName $ is_mod is occ = rdrNameOcc $ ieName ie in case k of - BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] - BadImportNotExported -> noHints - BadImportAvailTyCon ex_ns -> + BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] + BadImportNotExported suggs -> suggs + BadImportAvailTyCon ex_ns -> [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns] ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] - BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] + BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints TcRnImportLookup{} -> noHints @@ -5343,7 +5343,7 @@ pprImportLookup = \case hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) 2 (vcat msgs) in case k of - BadImportNotExported -> + BadImportNotExported _ -> vcat [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> text "does not export" <+> quotes (ppr ie) <> dot ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5250,7 +5250,7 @@ data WhenMatching data BadImportKind -- | Module does not export... - = BadImportNotExported + = BadImportNotExported [GhcHint] -- ^ suggestions for what might have been meant -- | Missing @type@ keyword when importing a type. -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+) -- Then we want to suggest using `import TypeLits( type (+) )` ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -515,7 +515,7 @@ data HowInScope data SimilarName = SimilarName Name - | SimilarRdrName RdrName HowInScope + | SimilarRdrName RdrName (Maybe HowInScope) -- | Something is promoted to the type-level without a promotion tick. data UntickedPromotedThing ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -353,18 +353,17 @@ pprSimilarName :: NameSpace -> SimilarName -> SDoc pprSimilarName _ (SimilarName name) = quotes (ppr name) <+> parens (pprDefinedAt name) pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope) - = case how_in_scope of - LocallyBoundAt loc -> - pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc' - where - loc' = case loc of - UnhelpfulSpan l -> parens (ppr l) - RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) - ImportedBy is -> - pp_ns rdr_name <+> quotes (ppr rdr_name) <+> - parens (text "imported from" <+> ppr (moduleName $ is_mod is)) - + = pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc where + loc = case how_in_scope of + Nothing -> empty + Just scope -> case scope of + LocallyBoundAt loc -> + case loc of + UnhelpfulSpan l -> parens (ppr l) + RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) + ImportedBy is -> + parens (text "imported from" <+> ppr (moduleName $ is_mod is)) pp_ns :: RdrName -> SDoc pp_ns rdr | ns /= tried_ns = pprNameSpace ns | otherwise = empty ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -1313,19 +1313,19 @@ lookupGRE env = \case -- -- This allows us to first look in e.g. the data 'NameSpace', and then fall back -- to the type/class 'NameSpace'. -highestPriorityGREs :: forall info prio +highestPriorityGREs :: forall gre prio . Ord prio - => (GlobalRdrEltX info -> Maybe prio) + => (gre -> Maybe prio) -- ^ priority function -- lower value <=> higher priority - -> [GlobalRdrEltX info] -> [GlobalRdrEltX info] + -> [gre] -> [gre] highestPriorityGREs priority gres = take_highest_prio $ NE.group $ sort [ S.Arg prio gre | gre <- gres , prio <- maybeToList $ priority gre ] where - take_highest_prio :: [NE.NonEmpty (S.Arg prio (GlobalRdrEltX info))] -> [GlobalRdrEltX info] + take_highest_prio :: [NE.NonEmpty (S.Arg prio gre)] -> [gre] take_highest_prio [] = [] take_highest_prio (fs:_) = map (\ (S.Arg _ gre) -> gre) $ NE.toList fs {-# INLINEABLE highestPriorityGREs #-} ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr ===================================== @@ -1,6 +1,6 @@ -T22106_C.hs:5:9: error: [GHC-88464] - Variable not in scope: bar +T22106_C.hs:3:21: error: [GHC-61689] + Module ‘T22106_aux’ does not export ‘bar’. Suggested fix: Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’ that has been suppressed by NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T23557.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Werror=unused-imports #-} + +module T23557 (main) where + +import T23557_aux (foo) + +main :: IO () +main = print foo + +-- We should not get an unused import for the import of the field selector "foo", +-- because the module we are importing from uses NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module T23557_aux where + +foo :: Int +foo = 23 + +data Foo = Foo { + foo :: Int +} ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -50,9 +50,9 @@ test('BootFldReexport' test('T23220' , [req_th, extra_files(['T23220_aux.hs'])] , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0']) - test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0']) test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0']) +test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-v0']) ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport.hs ===================================== @@ -0,0 +1,3 @@ +module SimilarNamesImport where + +import SimilarNamesImport_aux ( dyzzy, Wabble, wabble, Trizzle(bizzy) ) ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport.stderr ===================================== @@ -0,0 +1,16 @@ + +SimilarNamesImport.hs:3:33: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘dyzzy’. + Suggested fix: + Perhaps use one of these: record field of MkD ‘dizzy’, ‘xyzzy’ + +SimilarNamesImport.hs:3:40: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘Wabble’. + Suggested fix: Perhaps use ‘Wibble’ + +SimilarNamesImport.hs:3:48: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘wabble’. + +SimilarNamesImport.hs:3:56: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘Trizzle’. + Suggested fix: Perhaps use one of these: ‘Drizzle’, ‘Frizzle’ ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs ===================================== @@ -0,0 +1,11 @@ +module SimilarNamesImport_aux where + +xyzzy :: Double +xyzzy = exp $ pi * sqrt 163 + + +data Drizzle = MkD { dizzy :: Int } +data Frizzle = MkE { fizzy :: Bool } + +data Wibble + ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -199,6 +199,7 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('SimilarNamesImport', [extra_files(['SimilarNamesImport_aux.hs'])], multimod_compile_fail, ['SimilarNamesImport', '-v0']) test('T23510a', normal, compile_fail, ['']) test('T16635a', normal, compile_fail, ['']) test('T16635b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb1a6ab1df473c7ec0e1cbb20fc7124706326ce1...1af2e7735283251c686bdb1154afab6df5e45053 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb1a6ab1df473c7ec0e1cbb20fc7124706326ce1...1af2e7735283251c686bdb1154afab6df5e45053 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 06:49:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 02:49:28 -0400 Subject: [Git][ghc/ghc][master] EPA: Store leading AnnSemi for decllist in al_rest Message-ID: <64b4e478b18a2_3e28d5b5158452288@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 4 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_compile/DumpSemis.stderr - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1707,9 +1707,9 @@ cvars1 :: { [RecordPatSynField GhcPs] } where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) } : 'where' '{' decls '}' {% amsrl (sLL $1 $> (snd $ unLoc $3)) - (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) [mj AnnWhere $1] (fst $ unLoc $3)) } + (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) (mj AnnWhere $1: (fst $ unLoc $3)) []) } | 'where' vocurly decls close {% amsrl (sLL $1 $3 (snd $ unLoc $3)) - (AnnList (Just $ glR $3) Nothing Nothing [mj AnnWhere $1] (fst $ unLoc $3))} + (AnnList (Just $ glR $3) Nothing Nothing (mj AnnWhere $1: (fst $ unLoc $3)) []) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype @@ -1822,9 +1822,9 @@ where_inst :: { Located ([AddEpAnn] -- Declarations in binding groups other than classes and instances -- -decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } +decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } : decls ';' decl {% if isNilOL (snd $ unLoc $1) - then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemiA $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1835,7 +1835,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } return (rest `seq` this `seq` these `seq` (sLL $1 $> (fst $ unLoc $1, these))) } | decls ';' {% if isNilOL (snd $ unLoc $1) - then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemiA $2) ,snd $ unLoc $1))) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1846,9 +1846,9 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } - : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) [] (fst $ unLoc $2) + : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) (fst $ unLoc $2) [] ,sL1 $2 $ snd $ unLoc $2) } - | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing [] (fst $ unLoc $2) + | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) [] ,sL1 $2 $ snd $ unLoc $2) } -- Binding groups other than those of class and instance declarations @@ -4282,6 +4282,9 @@ mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)] msemi :: Located e -> [TrailingAnn] msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)] +msemiA :: Located e -> [AddEpAnn] +msemiA l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)] + msemim :: Located e -> Maybe EpaLocation msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l) ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -497,7 +497,7 @@ patch_anchor r1 (Anchor r0 op) = Anchor r op fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs) - = (EpAnn (widenAnchor anchor (map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs) + = (EpAnn (widenAnchor anchor (r ++ map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs) -- | The 'Anchor' for a stmtlist is based on either the location or -- the first semicolon annotion. ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -1517,17 +1517,12 @@ (AddEpAnn AnnOpenC (EpaSpan { DumpSemis.hs:34:13 }))) (Just (AddEpAnn AnnCloseC (EpaSpan { DumpSemis.hs:34:31 }))) - [] - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:14 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:15 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:16 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:17 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:18 }))]) + [(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:14 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:15 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:16 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:17 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:18 }))] + []) (EpaComments [])) (ValBinds ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1176,32 +1176,27 @@ markKwT (AddVbarAnn ss) = AddVbarAnn <$> markKwA AnnVbar ss -- --------------------------------------------------------------------- markAnnList :: (Monad m, Monoid w) - => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) -markAnnList reallyTrail ann action = do - markAnnListA reallyTrail ann $ \a -> do + => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) +markAnnList ann action = do + markAnnListA ann $ \a -> do r <- action return (a,r) markAnnListA :: (Monad m, Monoid w) - => Bool -> EpAnn AnnList + => EpAnn AnnList -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a)) -> EP w m (EpAnn AnnList, a) -markAnnListA _ EpAnnNotUsed action = do +markAnnListA EpAnnNotUsed action = do action EpAnnNotUsed -markAnnListA reallyTrail an action = do +markAnnListA an action = do debugM $ "markAnnListA: an=" ++ showAst an an0 <- markLensMAA an lal_open - an1 <- if (not reallyTrail) - then markTrailingL an0 lal_trailing - else return an0 - an2 <- markEpAnnAllL an1 lal_rest AnnSemi - (an3, r) <- action an2 - an4 <- markLensMAA an3 lal_close - an5 <- if reallyTrail - then markTrailingL an4 lal_trailing - else return an4 - debugM $ "markAnnListA: an5=" ++ showAst an - return (an5, r) + an1 <- markEpAnnAllL an0 lal_rest AnnSemi + (an2, r) <- action an1 + an3 <- markLensMAA an2 lal_close + an4 <- markTrailingL an3 lal_trailing + debugM $ "markAnnListA: an4=" ++ showAst an + return (an4, r) -- --------------------------------------------------------------------- @@ -2297,12 +2292,12 @@ instance ExactPrint (HsLocalBinds GhcPs) where when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc) _ -> return () - (an1, valbinds') <- markAnnList False an0 $ markAnnotatedWithLayout valbinds + (an1, valbinds') <- markAnnList an0 $ markAnnotatedWithLayout valbinds debugM $ "exact HsValBinds: an1=" ++ showAst an1 return (HsValBinds an1 valbinds') exact (HsIPBinds an bs) = do - (as, ipb) <- markAnnList True an (markEpAnnL an lal_rest AnnWhere + (as, ipb) <- markAnnList an (markEpAnnL an lal_rest AnnWhere >> markAnnotated bs >>= \bs' -> return (HsIPBinds an bs'::HsLocalBinds GhcPs)) case ipb of @@ -2845,7 +2840,7 @@ instance ExactPrint (HsExpr GhcPs) where exact (HsDo an do_or_list_comp stmts) = do debugM $ "HsDo" - (an',stmts') <- markAnnListA True an $ \a -> exactDo a do_or_list_comp stmts + (an',stmts') <- markAnnListA an $ \a -> exactDo a do_or_list_comp stmts return (HsDo an' do_or_list_comp stmts') exact (ExplicitList an es) = do @@ -3379,7 +3374,7 @@ instance ( exact (RecStmt an stmts a b c d e) = do debugM $ "RecStmt" an0 <- markEpAnnL an lal_rest AnnRec - (an1, stmts') <- markAnnList True an0 (markAnnotated stmts) + (an1, stmts') <- markAnnList an0 (markAnnotated stmts) return (RecStmt an1 stmts' a b c d e) -- --------------------------------------------------------------------- @@ -4400,7 +4395,7 @@ instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where an0 <- markEpAnnL an lal_rest AnnHiding p <- getPosP debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p - (an1, ies') <- markAnnList True an0 (markAnnotated ies) + (an1, ies') <- markAnnList an0 (markAnnotated ies) return (L (SrcSpanAnn an1 l) ies') instance (ExactPrint (Match GhcPs (LocatedA body))) @@ -4423,7 +4418,7 @@ instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr Gh setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) stmts) = do debugM $ "LocatedL [ExprLStmt" - (an'', stmts') <- markAnnList True an $ do + (an'', stmts') <- markAnnList an $ do case snocView stmts of Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do debugM $ "LocatedL [ExprLStmt: snocView" @@ -4450,7 +4445,7 @@ instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) fs) = do debugM $ "LocatedL [LConDeclField" - (an', fs') <- markAnnList True an (markAnnotated fs) + (an', fs') <- markAnnList an (markAnnotated fs) return (L (SrcSpanAnn an' l) fs') instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where @@ -4458,7 +4453,7 @@ instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) bf) = do debugM $ "LocatedL [LBooleanFormula" - (an', bf') <- markAnnList True an (markAnnotated bf) + (an', bf') <- markAnnList an (markAnnotated bf) return (L (SrcSpanAnn an' l) bf') -- --------------------------------------------------------------------- @@ -4616,7 +4611,7 @@ instance ExactPrint (Pat GhcPs) where return (BangPat an0 pat') exact (ListPat an pats) = do - (an', pats') <- markAnnList True an (markAnnotated pats) + (an', pats') <- markAnnList an (markAnnotated pats) return (ListPat an' pats') exact (TuplePat an pats boxity) = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/654fdb989d44e9bdc961f9af7b8171c551b37151 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/654fdb989d44e9bdc961f9af7b8171c551b37151 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 07:48:25 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 17 Jul 2023 03:48:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-mk_tup Message-ID: <64b4f2493e2db_3e28d5b51bc46109d@gitlab.mail> Josh Meredith pushed new branch wip/js-mk_tup at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-mk_tup You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 09:52:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 05:52:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rnImports: var shouldn't import NoFldSelectors Message-ID: <64b50f4ca5dd0_3e28d53d5ed304513650@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - f332470b by Rodrigo Mesquita at 2023-07-17T05:51:44-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - 1bc23213 by Sylvain Henry at 2023-07-17T05:51:54-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 28 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Reader.hs - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs - rts/js/arith.js - testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr - + testsuite/tests/overloadedrecflds/should_compile/T23557.hs - + testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/parser/should_compile/DumpSemis.stderr - + testsuite/tests/rename/should_fail/SimilarNamesImport.hs - + testsuite/tests/rename/should_fail/SimilarNamesImport.stderr - + testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs - testsuite/tests/rename/should_fail/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1707,9 +1707,9 @@ cvars1 :: { [RecordPatSynField GhcPs] } where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) } : 'where' '{' decls '}' {% amsrl (sLL $1 $> (snd $ unLoc $3)) - (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) [mj AnnWhere $1] (fst $ unLoc $3)) } + (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) (mj AnnWhere $1: (fst $ unLoc $3)) []) } | 'where' vocurly decls close {% amsrl (sLL $1 $3 (snd $ unLoc $3)) - (AnnList (Just $ glR $3) Nothing Nothing [mj AnnWhere $1] (fst $ unLoc $3))} + (AnnList (Just $ glR $3) Nothing Nothing (mj AnnWhere $1: (fst $ unLoc $3)) []) } pattern_synonym_sig :: { LSig GhcPs } : 'pattern' con_list '::' sigtype @@ -1822,9 +1822,9 @@ where_inst :: { Located ([AddEpAnn] -- Declarations in binding groups other than classes and instances -- -decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } +decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } : decls ';' decl {% if isNilOL (snd $ unLoc $1) - then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemiA $2) , unitOL $3)) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1835,7 +1835,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } return (rest `seq` this `seq` these `seq` (sLL $1 $> (fst $ unLoc $1, these))) } | decls ';' {% if isNilOL (snd $ unLoc $1) - then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2) + then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemiA $2) ,snd $ unLoc $1))) else case (snd $ unLoc $1) of SnocOL hs t -> do @@ -1846,9 +1846,9 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } - : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) [] (fst $ unLoc $2) + : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) (fst $ unLoc $2) [] ,sL1 $2 $ snd $ unLoc $2) } - | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing [] (fst $ unLoc $2) + | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) [] ,sL1 $2 $ snd $ unLoc $2) } -- Binding groups other than those of class and instance declarations @@ -4282,6 +4282,9 @@ mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)] msemi :: Located e -> [TrailingAnn] msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)] +msemiA :: Located e -> [AddEpAnn] +msemiA l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)] + msemim :: Located e -> Maybe EpaLocation msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l) ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -497,7 +497,7 @@ patch_anchor r1 (Anchor r0 op) = Anchor r op fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs) - = (EpAnn (widenAnchor anchor (map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs) + = (EpAnn (widenAnchor anchor (r ++ map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs) -- | The 'Anchor' for a stmtlist is based on either the location or -- the first semicolon annotion. ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -38,6 +38,8 @@ import GHC.Driver.Ppr import GHC.Rename.Env import GHC.Rename.Fixity import GHC.Rename.Utils ( warnUnusedTopBinds ) +import GHC.Rename.Unbound +import qualified GHC.Rename.Unbound as Unbound import GHC.Tc.Errors.Types import GHC.Tc.Utils.Env @@ -67,6 +69,7 @@ import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Types.Avail import GHC.Types.FieldLabel +import GHC.Types.Hint import GHC.Types.SourceFile import GHC.Types.SrcLoc as SrcLoc import GHC.Types.Basic ( TopLevelFlag(..) ) @@ -308,7 +311,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in -- -- 4. A boolean 'AnyHpcUsage' which is true if the imported module -- used HPC. -rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc) +rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc) -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage) rnImportDecl this_mod (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name @@ -1228,11 +1231,11 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) = failLookupWith (QualImportError rdr) | otherwise = case lookups of - [] -> failLookupWith (BadImport ie BadImportIsParent) + [] -> failLookupWith (BadImport ie IsNotSubordinate) item:items -> return $ item :| items where lookups = concatMap nonDetNameEnvElts - $ lookupOccEnv_WithFields imp_occ_env (rdrNameOcc rdr) + $ lookupImpOccEnv (RelevantGREsFOS WantNormal) imp_occ_env (rdrNameOcc rdr) lookup_lie :: LIE GhcPs -> TcRn [(LIE GhcRn, [GlobalRdrElt])] lookup_lie (L loc ieRdr) @@ -1252,7 +1255,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- 'BadImportW' is only constructed below in 'handle_bad_import', in -- the 'EverythingBut' case, so that's what we pass to -- 'badImportItemErr'. - reason <- badImportItemErr iface decl_spec ie BadImportIsParent all_avails + reason <- badImportItemErr iface decl_spec ie IsNotSubordinate all_avails pure (TcRnDodgyImports (DodgyImportsHiding reason)) warning_msg (DeprecatedExport n w) = pure (TcRnPragmaWarning { @@ -1338,7 +1341,7 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) dc_name = lookup_parent ie (setRdrNameSpace tc srcDataName) in case catIELookupM [ tc_name, dc_name ] of - [] -> failLookupWith (BadImport ie BadImportIsParent) + [] -> failLookupWith (BadImport ie IsNotSubordinate) names -> return ( [mkIEThingAbs tc' l (imp_item name) | name <- names], []) | otherwise -> do ImpOccItem { imp_item = gre } <- lookup_parent ie (ieWrappedName tc') @@ -1354,7 +1357,8 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) -- See Note [Importing DuplicateRecordFields] case lookupChildren subnames rdr_ns of - Failed rdrs -> failLookupWith (BadImport (IEThingWith (deprecation, ann) ltc wc rdrs ) BadImportIsSubordinate) + Failed rdrs -> failLookupWith $ + BadImport (IEThingWith (deprecation, ann) ltc wc rdrs) IsSubordinate -- We are trying to import T( a,b,c,d ), and failed -- to find 'b' and 'd'. So we make up an import item -- to report as failing, namely T( b, d ). @@ -1382,7 +1386,9 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items)) where n = greName gre handle_bad_import m = catchIELookup m $ \err -> case err of - BadImport ie _ | want_hiding == EverythingBut -> return ([], [BadImportW ie]) + BadImport ie _ + | want_hiding == EverythingBut + -> return ([], [BadImportW ie]) _ -> failLookupWith err mk_depr_export_warning gre @@ -1398,11 +1404,13 @@ data IELookupWarning | DodgyImport GlobalRdrElt | DeprecatedExport Name (WarningTxt GhcRn) -data BadImportIsSubordinate = BadImportIsParent | BadImportIsSubordinate +-- | Is this import/export item a subordinate or not? +data IsSubordinate + = IsSubordinate | IsNotSubordinate data IELookupError = QualImportError RdrName - | BadImport (IE GhcPs) BadImportIsSubordinate + | BadImport (IE GhcPs) IsSubordinate | IllegalImport failLookupWith :: IELookupError -> IELookupM a @@ -1486,6 +1494,23 @@ mkImportOccEnv hsc_env decl_spec all_avails = else item1 -- Discard standalone pattern P in favour of T(P). +-- | Essentially like @lookupGRE env (LookupOccName occ which_gres)@, +-- but working with 'ImpOccItem's instead of 'GlobalRdrElt's. +lookupImpOccEnv :: WhichGREs GREInfo + -> OccEnv (NameEnv ImpOccItem) -> OccName -> [NameEnv ImpOccItem] +lookupImpOccEnv which_gres env occ = + mapMaybe relevant_items $ lookupOccEnv_AllNameSpaces env occ + where + is_relevant :: ImpOccItem -> Bool + is_relevant (ImpOccItem { imp_item = gre }) = + greIsRelevant which_gres (occNameSpace occ) gre + relevant_items :: NameEnv ImpOccItem -> Maybe (NameEnv ImpOccItem) + relevant_items nms + | let nms' = filterNameEnv is_relevant nms + = if isEmptyNameEnv nms' + then Nothing + else Just nms' + {- ************************************************************************ * * @@ -2134,21 +2159,42 @@ DRFPatSynExport for a test of this. -} badImportItemErr - :: ModIface -> ImpDeclSpec -> IE GhcPs -> BadImportIsSubordinate + :: ModIface -> ImpDeclSpec -> IE GhcPs -> IsSubordinate -> [AvailInfo] -> TcRn ImportLookupReason badImportItemErr iface decl_spec ie sub avails = do patsyns_enabled <- xoptM LangExt.PatternSynonyms expl_ns_enabled <- xoptM LangExt.ExplicitNamespaces - pure (ImportLookupBad (importErrorKind expl_ns_enabled) iface decl_spec ie patsyns_enabled) + dflags <- getDynFlags + hsc_env <- getTopEnv + let rdr_env = mkGlobalRdrEnv + $ gresFromAvails hsc_env (Just imp_spec) all_avails + pure (ImportLookupBad (importErrorKind dflags rdr_env expl_ns_enabled) iface decl_spec ie patsyns_enabled) where - importErrorKind expl_ns_enabled + importErrorKind dflags rdr_env expl_ns_enabled | any checkIfTyCon avails = case sub of - BadImportIsParent -> BadImportAvailTyCon expl_ns_enabled - BadImportIsSubordinate -> BadImportNotExportedSubordinates unavailableChildren + IsNotSubordinate -> BadImportAvailTyCon expl_ns_enabled + IsSubordinate -> BadImportNotExportedSubordinates unavailableChildren | any checkIfVarName avails = BadImportAvailVar | Just con <- find checkIfDataCon avails = BadImportAvailDataCon (availOccName con) - | otherwise = BadImportNotExported + | otherwise = BadImportNotExported suggs + where + suggs = similar_suggs ++ fieldSelectorSuggestions rdr_env rdr + similar_names = + similarNameSuggestions (Unbound.LF WL_Anything WL_Global) + dflags rdr_env emptyLocalRdrEnv rdr + similar_suggs = + case NE.nonEmpty $ mapMaybe imported_item $ similar_names of + Just similar -> [ SuggestSimilarNames rdr similar ] + Nothing -> [ ] + + -- Only keep imported items, and set the "HowInScope" to + -- "Nothing" to avoid printing "imported from..." in the suggestion + -- error message. + imported_item (SimilarRdrName rdr_name (Just (ImportedBy {}))) + = Just (SimilarRdrName rdr_name Nothing) + imported_item _ = Nothing + checkIfDataCon = checkIfAvailMatches isDataConName checkIfTyCon = checkIfAvailMatches isTyConName checkIfVarName = @@ -2164,9 +2210,12 @@ badImportItemErr iface decl_spec ie sub avails = do Nothing -> False Avail{} -> False availOccName = occName . availName - importedFS = occNameFS . rdrNameOcc $ ieName ie - unavailableChildren = map (rdrNameOcc) $ case ie of - IEThingWith _ _ _ ns -> map (ieWrappedName . unLoc) ns + rdr = ieName ie + importedFS = occNameFS $ rdrNameOcc rdr + imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } + all_avails = mi_exports iface + unavailableChildren = case ie of + IEThingWith _ _ _ ns -> map (rdrNameOcc . ieWrappedName . unLoc) ns _ -> panic "importedChildren failed pattern match: no children" addDupDeclErr :: NonEmpty GlobalRdrElt -> TcRn () ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -15,6 +15,8 @@ module GHC.Rename.Unbound , reportUnboundName , reportUnboundName' , unknownNameSuggestions + , similarNameSuggestions + , fieldSelectorSuggestions , WhatLooking(..) , WhereLooking(..) , LookingFor(..) @@ -225,7 +227,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env all_possibilities :: [(String, SimilarName)] all_possibilities = case what_look of WL_None -> [] - _ -> [ (showPpr dflags r, SimilarRdrName r (LocallyBoundAt loc)) + _ -> [ (showPpr dflags r, SimilarRdrName r (Just $ LocallyBoundAt loc)) | (r,loc) <- local_possibilities local_env ] ++ [ (showPpr dflags r, rp) | (r, rp) <- global_possibilities global_env ] @@ -256,7 +258,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env global_possibilities :: GlobalRdrEnv -> [(RdrName, SimilarName)] global_possibilities global_env - | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual how) + | tried_is_qual = [ (rdr_qual, SimilarRdrName rdr_qual (Just how)) | gre <- globalRdrEnvElts global_env , isGreOk looking_for gre , let occ = greOccName gre @@ -271,7 +273,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env rdr_unqual = mkRdrUnqual occ , correct_name_space occ , sim <- case (unquals_in_scope gre, quals_only gre) of - (how:_, _) -> [ SimilarRdrName rdr_unqual how ] + (how:_, _) -> [ SimilarRdrName rdr_unqual (Just how) ] ([], pr:_) -> [ pr ] -- See Note [Only-quals] ([], []) -> [] ] @@ -299,7 +301,7 @@ similarNameSuggestions looking_for@(LF what_look where_look) dflags global_env quals_only :: GlobalRdrElt -> [SimilarName] -- Ones for which *only* the qualified version is in scope quals_only (gre at GRE { gre_imp = is }) - = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (ImportedBy ispec)) + = [ (SimilarRdrName (mkRdrQual (is_as ispec) (greOccName gre)) (Just $ ImportedBy ispec)) | i <- bagToList is, let ispec = is_decl i, is_qual ispec ] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -62,9 +62,11 @@ import GHC.Driver.Backend import GHC.Hs import GHC.Tc.Errors.Types +import GHC.Tc.Types.BasicTypes import GHC.Tc.Types.Constraint import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank (Rank(..)) +import GHC.Tc.Types.TH import GHC.Tc.Utils.TcType import GHC.Types.Error @@ -116,8 +118,6 @@ import Data.List ( groupBy, sortBy, tails , partition, unfoldr ) import Data.Ord ( comparing ) import Data.Bifunctor -import GHC.Tc.Types.TH -import GHC.Tc.Types.BasicTypes defaultTcRnMessageOpts :: TcRnMessageOpts @@ -3085,12 +3085,12 @@ instance Diagnostic TcRnMessage where let mod_name = moduleName $ is_mod is occ = rdrNameOcc $ ieName ie in case k of - BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] - BadImportNotExported -> noHints - BadImportAvailTyCon ex_ns -> + BadImportAvailVar -> [ImportSuggestion occ $ CouldRemoveTypeKeyword mod_name] + BadImportNotExported suggs -> suggs + BadImportAvailTyCon ex_ns -> [useExtensionInOrderTo empty LangExt.ExplicitNamespaces | not ex_ns] ++ [ImportSuggestion occ $ CouldAddTypeKeyword mod_name] - BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] + BadImportAvailDataCon par -> [ImportSuggestion occ $ ImportDataCon (Just (mod_name, patsyns_enabled)) par] BadImportNotExportedSubordinates{} -> noHints TcRnImportLookup{} -> noHints @@ -5343,7 +5343,7 @@ pprImportLookup = \case hang (text "In the import of" <+> pprImpDeclSpec iface decl_spec <> colon) 2 (vcat msgs) in case k of - BadImportNotExported -> + BadImportNotExported _ -> vcat [ text "Module" <+> pprImpDeclSpec iface decl_spec <+> text "does not export" <+> quotes (ppr ie) <> dot ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -5250,7 +5250,7 @@ data WhenMatching data BadImportKind -- | Module does not export... - = BadImportNotExported + = BadImportNotExported [GhcHint] -- ^ suggestions for what might have been meant -- | Missing @type@ keyword when importing a type. -- e.g. `import TypeLits( (+) )`, where TypeLits exports a /type/ (+), not a /term/ (+) -- Then we want to suggest using `import TypeLits( type (+) )` ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -515,7 +515,7 @@ data HowInScope data SimilarName = SimilarName Name - | SimilarRdrName RdrName HowInScope + | SimilarRdrName RdrName (Maybe HowInScope) -- | Something is promoted to the type-level without a promotion tick. data UntickedPromotedThing ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -353,18 +353,17 @@ pprSimilarName :: NameSpace -> SimilarName -> SDoc pprSimilarName _ (SimilarName name) = quotes (ppr name) <+> parens (pprDefinedAt name) pprSimilarName tried_ns (SimilarRdrName rdr_name how_in_scope) - = case how_in_scope of - LocallyBoundAt loc -> - pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc' - where - loc' = case loc of - UnhelpfulSpan l -> parens (ppr l) - RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) - ImportedBy is -> - pp_ns rdr_name <+> quotes (ppr rdr_name) <+> - parens (text "imported from" <+> ppr (moduleName $ is_mod is)) - + = pp_ns rdr_name <+> quotes (ppr rdr_name) <+> loc where + loc = case how_in_scope of + Nothing -> empty + Just scope -> case scope of + LocallyBoundAt loc -> + case loc of + UnhelpfulSpan l -> parens (ppr l) + RealSrcSpan l _ -> parens (text "line" <+> int (srcSpanStartLine l)) + ImportedBy is -> + parens (text "imported from" <+> ppr (moduleName $ is_mod is)) pp_ns :: RdrName -> SDoc pp_ns rdr | ns /= tried_ns = pprNameSpace ns | otherwise = empty ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -1313,19 +1313,19 @@ lookupGRE env = \case -- -- This allows us to first look in e.g. the data 'NameSpace', and then fall back -- to the type/class 'NameSpace'. -highestPriorityGREs :: forall info prio +highestPriorityGREs :: forall gre prio . Ord prio - => (GlobalRdrEltX info -> Maybe prio) + => (gre -> Maybe prio) -- ^ priority function -- lower value <=> higher priority - -> [GlobalRdrEltX info] -> [GlobalRdrEltX info] + -> [gre] -> [gre] highestPriorityGREs priority gres = take_highest_prio $ NE.group $ sort [ S.Arg prio gre | gre <- gres , prio <- maybeToList $ priority gre ] where - take_highest_prio :: [NE.NonEmpty (S.Arg prio (GlobalRdrEltX info))] -> [GlobalRdrEltX info] + take_highest_prio :: [NE.NonEmpty (S.Arg prio gre)] -> [gre] take_highest_prio [] = [] take_highest_prio (fs:_) = map (\ (S.Arg _ gre) -> gre) $ NE.toList fs {-# INLINEABLE highestPriorityGREs #-} ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -84,6 +84,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,7 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` + package into this reinstallable standalone package which abides by the PVP, + in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.15.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== @@ -1,17 +1,19 @@ {-# LANGUAGE LambdaCase, ScopedTypeVariables #-} -- | Platform architecture and OS --- --- We need it in ghc-boot because ghc-pkg needs it. module GHC.Platform.ArchOS ( ArchOS(..) + + -- * Architectures , Arch(..) - , OS(..) , ArmISA(..) , ArmISAExt(..) , ArmABI(..) , PPC_64ABI(..) , stringEncodeArch + + -- * Operating systems + , OS(..) , stringEncodeOS ) where @@ -27,10 +29,6 @@ data ArchOS deriving (Read, Show, Eq, Ord) -- | Architectures --- --- TODO: It might be nice to extend these constructors with information about --- what instruction set extensions an architecture might support. --- data Arch = ArchUnknown | ArchX86 ===================================== rts/js/arith.js ===================================== @@ -60,11 +60,11 @@ function h$hs_minusWord64(h1,l1,h2,l2) { } function h$hs_plusWord64(h1,l1,h2,l2) { - var a = W64(h1,l1); - var b = W64(h2,l2); - var r = BigInt.asUintN(64, a + b); - TRACE_ARITH("Word64: " + a + " + " + b + " ==> " + r) - RETURN_W64(r); + var l = l1+l2; + var rl = l>>>0; + var rh = (h1+h2+(l!=rl?1:0))>>>0; + TRACE_ARITH("Word64: " + (h1,l1) + " + " + (h2,l2) + " ==> " + (rh,rl)) + RETURN_UBX_TUP2(rh,rl); } function h$hs_timesInt64(h1,l1,h2,l2) { ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr ===================================== @@ -1,6 +1,6 @@ -T22106_C.hs:5:9: error: [GHC-88464] - Variable not in scope: bar +T22106_C.hs:3:21: error: [GHC-61689] + Module ‘T22106_aux’ does not export ‘bar’. Suggested fix: Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’ that has been suppressed by NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T23557.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Werror=unused-imports #-} + +module T23557 (main) where + +import T23557_aux (foo) + +main :: IO () +main = print foo + +-- We should not get an unused import for the import of the field selector "foo", +-- because the module we are importing from uses NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T23557_aux.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module T23557_aux where + +foo :: Int +foo = 23 + +data Foo = Foo { + foo :: Int +} ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -50,9 +50,9 @@ test('BootFldReexport' test('T23220' , [req_th, extra_files(['T23220_aux.hs'])] , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0']) - test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0']) test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0']) +test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-v0']) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -1517,17 +1517,12 @@ (AddEpAnn AnnOpenC (EpaSpan { DumpSemis.hs:34:13 }))) (Just (AddEpAnn AnnCloseC (EpaSpan { DumpSemis.hs:34:31 }))) - [] - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:14 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:15 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:16 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:17 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:18 }))]) + [(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:14 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:15 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:16 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:17 })) + ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:18 }))] + []) (EpaComments [])) (ValBinds ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport.hs ===================================== @@ -0,0 +1,3 @@ +module SimilarNamesImport where + +import SimilarNamesImport_aux ( dyzzy, Wabble, wabble, Trizzle(bizzy) ) ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport.stderr ===================================== @@ -0,0 +1,16 @@ + +SimilarNamesImport.hs:3:33: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘dyzzy’. + Suggested fix: + Perhaps use one of these: record field of MkD ‘dizzy’, ‘xyzzy’ + +SimilarNamesImport.hs:3:40: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘Wabble’. + Suggested fix: Perhaps use ‘Wibble’ + +SimilarNamesImport.hs:3:48: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘wabble’. + +SimilarNamesImport.hs:3:56: error: [GHC-61689] + Module ‘SimilarNamesImport_aux’ does not export ‘Trizzle’. + Suggested fix: Perhaps use one of these: ‘Drizzle’, ‘Frizzle’ ===================================== testsuite/tests/rename/should_fail/SimilarNamesImport_aux.hs ===================================== @@ -0,0 +1,11 @@ +module SimilarNamesImport_aux where + +xyzzy :: Double +xyzzy = exp $ pi * sqrt 163 + + +data Drizzle = MkD { dizzy :: Int } +data Frizzle = MkE { fizzy :: Bool } + +data Wibble + ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -199,6 +199,7 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('SimilarNamesImport', [extra_files(['SimilarNamesImport_aux.hs'])], multimod_compile_fail, ['SimilarNamesImport', '-v0']) test('T23510a', normal, compile_fail, ['']) test('T16635a', normal, compile_fail, ['']) test('T16635b', normal, compile_fail, ['']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1176,32 +1176,27 @@ markKwT (AddVbarAnn ss) = AddVbarAnn <$> markKwA AnnVbar ss -- --------------------------------------------------------------------- markAnnList :: (Monad m, Monoid w) - => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) -markAnnList reallyTrail ann action = do - markAnnListA reallyTrail ann $ \a -> do + => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a) +markAnnList ann action = do + markAnnListA ann $ \a -> do r <- action return (a,r) markAnnListA :: (Monad m, Monoid w) - => Bool -> EpAnn AnnList + => EpAnn AnnList -> (EpAnn AnnList -> EP w m (EpAnn AnnList, a)) -> EP w m (EpAnn AnnList, a) -markAnnListA _ EpAnnNotUsed action = do +markAnnListA EpAnnNotUsed action = do action EpAnnNotUsed -markAnnListA reallyTrail an action = do +markAnnListA an action = do debugM $ "markAnnListA: an=" ++ showAst an an0 <- markLensMAA an lal_open - an1 <- if (not reallyTrail) - then markTrailingL an0 lal_trailing - else return an0 - an2 <- markEpAnnAllL an1 lal_rest AnnSemi - (an3, r) <- action an2 - an4 <- markLensMAA an3 lal_close - an5 <- if reallyTrail - then markTrailingL an4 lal_trailing - else return an4 - debugM $ "markAnnListA: an5=" ++ showAst an - return (an5, r) + an1 <- markEpAnnAllL an0 lal_rest AnnSemi + (an2, r) <- action an1 + an3 <- markLensMAA an2 lal_close + an4 <- markTrailingL an3 lal_trailing + debugM $ "markAnnListA: an4=" ++ showAst an + return (an4, r) -- --------------------------------------------------------------------- @@ -2297,12 +2292,12 @@ instance ExactPrint (HsLocalBinds GhcPs) where when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc) _ -> return () - (an1, valbinds') <- markAnnList False an0 $ markAnnotatedWithLayout valbinds + (an1, valbinds') <- markAnnList an0 $ markAnnotatedWithLayout valbinds debugM $ "exact HsValBinds: an1=" ++ showAst an1 return (HsValBinds an1 valbinds') exact (HsIPBinds an bs) = do - (as, ipb) <- markAnnList True an (markEpAnnL an lal_rest AnnWhere + (as, ipb) <- markAnnList an (markEpAnnL an lal_rest AnnWhere >> markAnnotated bs >>= \bs' -> return (HsIPBinds an bs'::HsLocalBinds GhcPs)) case ipb of @@ -2845,7 +2840,7 @@ instance ExactPrint (HsExpr GhcPs) where exact (HsDo an do_or_list_comp stmts) = do debugM $ "HsDo" - (an',stmts') <- markAnnListA True an $ \a -> exactDo a do_or_list_comp stmts + (an',stmts') <- markAnnListA an $ \a -> exactDo a do_or_list_comp stmts return (HsDo an' do_or_list_comp stmts') exact (ExplicitList an es) = do @@ -3379,7 +3374,7 @@ instance ( exact (RecStmt an stmts a b c d e) = do debugM $ "RecStmt" an0 <- markEpAnnL an lal_rest AnnRec - (an1, stmts') <- markAnnList True an0 (markAnnotated stmts) + (an1, stmts') <- markAnnList an0 (markAnnotated stmts) return (RecStmt an1 stmts' a b c d e) -- --------------------------------------------------------------------- @@ -4400,7 +4395,7 @@ instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where an0 <- markEpAnnL an lal_rest AnnHiding p <- getPosP debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p - (an1, ies') <- markAnnList True an0 (markAnnotated ies) + (an1, ies') <- markAnnList an0 (markAnnotated ies) return (L (SrcSpanAnn an1 l) ies') instance (ExactPrint (Match GhcPs (LocatedA body))) @@ -4423,7 +4418,7 @@ instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr Gh setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) stmts) = do debugM $ "LocatedL [ExprLStmt" - (an'', stmts') <- markAnnList True an $ do + (an'', stmts') <- markAnnList an $ do case snocView stmts of Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do debugM $ "LocatedL [ExprLStmt: snocView" @@ -4450,7 +4445,7 @@ instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) fs) = do debugM $ "LocatedL [LConDeclField" - (an', fs') <- markAnnList True an (markAnnotated fs) + (an', fs') <- markAnnList an (markAnnotated fs) return (L (SrcSpanAnn an' l) fs') instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where @@ -4458,7 +4453,7 @@ instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where setAnnotationAnchor = setAnchorAn exact (L (SrcSpanAnn an l) bf) = do debugM $ "LocatedL [LBooleanFormula" - (an', bf') <- markAnnList True an (markAnnotated bf) + (an', bf') <- markAnnList an (markAnnotated bf) return (L (SrcSpanAnn an' l) bf') -- --------------------------------------------------------------------- @@ -4616,7 +4611,7 @@ instance ExactPrint (Pat GhcPs) where return (BangPat an0 pat') exact (ListPat an pats) = do - (an', pats') <- markAnnList True an (markAnnotated pats) + (an', pats') <- markAnnList an (markAnnotated pats) return (ListPat an' pats') exact (TuplePat an pats boxity) = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95c01b41970b100966a091138ea2276721139a30...1bc23213d2a981fe2b1655c30b47c9817502a8c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95c01b41970b100966a091138ea2276721139a30...1bc23213d2a981fe2b1655c30b47c9817502a8c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 10:18:26 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 06:18:26 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Rename target files to hadrian/cfg (not on bindist) Message-ID: <64b5157227f66_3e28d53d46e168528383@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 4372c1fa by Rodrigo Mesquita at 2023-07-17T11:18:12+01:00 Rename target files to hadrian/cfg (not on bindist) - - - - - 8 changed files: - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - default.host.target.in → hadrian/cfg/default.host.target.in - default.target.in → hadrian/cfg/default.target.in - hadrian/src/Base.hs - hadrian/src/Rules/BinaryDist.hs - m4/ghc_toolchain.m4 Changes: ===================================== configure.ac ===================================== @@ -1177,7 +1177,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN +FIND_GHC_TOOLCHAIN([hadrian/cfg]) AC_CONFIG_FILES( [ mk/project.mk @@ -1187,8 +1187,8 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac - default.host.target - default.target + hadrian/cfg/default.host.target + hadrian/cfg/default.target ]) dnl Create the VERSION file, satisfying #22322. @@ -1313,5 +1313,5 @@ For more information on how to configure your GHC build, see # # VALIDATE_GHC_TOOLCHAIN([default.host.target],[default.host.target.ghc-toolchain]) -VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) +VALIDATE_GHC_TOOLCHAIN([hadrian/cfg/default.target],[hadrian/cfg/default.target.ghc-toolchain]) ===================================== distrib/configure.ac.in ===================================== @@ -312,7 +312,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN +FIND_GHC_TOOLCHAIN([.]) VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) ===================================== hadrian/.gitignore ===================================== @@ -1,5 +1,9 @@ # generated by the configure script cfg/system.config +cfg/default.host.target +cfg/default.host.target.ghc-toolchain +cfg/default.target +cfg/default.target.ghc-toolchain /ghci-stack /ghci-multi-cabal /ghci-cabal ===================================== default.host.target.in → hadrian/cfg/default.host.target.in ===================================== ===================================== default.target.in → hadrian/cfg/default.target.in ===================================== ===================================== hadrian/src/Base.hs ===================================== @@ -83,17 +83,20 @@ configFile = configPath -/- "system.config" -- | The target configuration file generated by ghc-toolchain for the -- compilation build platform buildTargetFile :: FilePath -buildTargetFile = "default.host.target" -- ROMES:TODO: Not hardcode this value? +buildTargetFile = configPath -/- "default.host.target" -- | The target configuration file generated by ghc-toolchain for the -- compilation host platform +-- +-- Currently, GHC requires that BUILD=HOST, so, for now, the host target file +-- is really just the build target file. hostTargetFile :: FilePath -hostTargetFile = "default.host.target" -- ROMES:TODO: Not hardcode this value? +hostTargetFile = buildTargetFile -- | The target configuration file generated by ghc-toolchain for the -- compilation target platform targetTargetFile :: FilePath -targetTargetFile = "default.target" -- ROMES:TODO: Not hardcode this value, depends on target +targetTargetFile = configPath -/- "default.target" -- | Path to source files of the build system, e.g. this file is located at -- @sourcePath -/- "Base.hs"@. We use this to track some of the source files. ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -258,8 +258,8 @@ bindistRules = do need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") - copyFile ("default.target.in") (bindistFilesDir -/- "default.target.in") - copyFile ("default.host.target.in") (bindistFilesDir -/- "default.host.target.in") + copyFile ("hadrian" -/- "cfg" -/- "default.target.in") (bindistFilesDir -/- "default.target.in") + copyFile ("hadrian" -/- "cfg" -/- "default.host.target.in") (bindistFilesDir -/- "default.host.target.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do ===================================== m4/ghc_toolchain.m4 ===================================== @@ -40,6 +40,7 @@ AC_DEFUN([INVOKE_GHC_TOOLCHAIN], ) > acargs - echo "--output=default.host.target.ghc-toolchain" >> acargs + echo "--output=$1/default.host.target.ghc-toolchain" >> acargs echo "--cc=$CC_STAGE0" >> acargs echo "--cc-link=$CC_STAGE0" >> acargs echo "--ar=$AR_STAGE0" >> acargs @@ -77,7 +78,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], # calling it through configure. rm -f acargs echo "--triple=$target" >> acargs - echo "--output=default.target.ghc-toolchain" >> acargs + echo "--output=$1/default.target.ghc-toolchain" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs echo "--cc=$CC" >> acargs echo "--cxx=$CXX" >> acargs @@ -131,9 +132,4 @@ AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ https://www.haskell.org/ghc/reportabug ]) fi - -dnl echo "$1:" -dnl cat $1 -dnl echo "$2:" -dnl cat $2 ]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4372c1faf41ba958e71f01fe24b9248e1809e000 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4372c1faf41ba958e71f01fe24b9248e1809e000 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 10:19:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 17 Jul 2023 06:19:17 -0400 Subject: [Git][ghc/ghc][wip/test-primops] another refactor Message-ID: <64b515a59aa09_3e28d53d4b57e8528850@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 2b0d2cea by Matthew Pickering at 2023-07-17T11:19:00+01:00 another refactor - - - - - 1 changed file: - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ViewPatterns #-} import Data.Aeson as A import qualified Data.Map as Map @@ -10,10 +11,10 @@ import Data.Map (Map) import Data.Maybe import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as B -import Data.List (intercalate) import Data.Set (Set) import qualified Data.Set as S import System.Environment +import Data.List {- Note [Generating the CI pipeline] @@ -751,11 +752,11 @@ modifyJobs = fmap -- | Modify just the validate jobs in a 'JobGroup' modifyValidateJobs :: (a -> a) -> JobGroup a -> JobGroup a -modifyValidateJobs f jg = jg { v = f <$> v jg } +modifyValidateJobs f jg = jg { v = fmap f <$> v jg } -- | Modify just the nightly jobs in a 'JobGroup' modifyNightlyJobs :: (a -> a) -> JobGroup a -> JobGroup a -modifyNightlyJobs f jg = jg { n = f <$> n jg } +modifyNightlyJobs f jg = jg { n = fmap f <$> n jg } -- Generic helpers @@ -831,9 +832,9 @@ addValidateRule t = modifyValidateJobs (addJobRule t) -- | Don't run the validate job, normally used to alleviate CI load by marking -- jobs which are unlikely to fail (ie different linux distros) disableValidate :: JobGroup Job -> JobGroup Job -disableValidate = addValidateRule Disable +disableValidate st = st { v = Nothing } -data NamedJob a = NamedJob { name :: String, jobInfo :: a } deriving Functor +data NamedJob a = NamedJob { name :: String, jobInfo :: a } deriving (Show, Functor) renameJob :: (String -> String) -> NamedJob a -> NamedJob a renameJob f (NamedJob n i) = NamedJob (f n) i @@ -843,32 +844,32 @@ instance ToJSON a => ToJSON (NamedJob a) where [ "name" A..= name nj , "jobInfo" A..= jobInfo nj ] + +--data NamedJobGroup a = NamedJobGroup { platform :: String, jg :: JobGroup a } + -- Jobs are grouped into either triples or pairs depending on whether the -- job is just validate and nightly, or also release. -data JobGroup a = StandardTriple { v :: NamedJob a - , n :: NamedJob a - , r :: NamedJob a } - | ValidateOnly { v :: NamedJob a - , n :: NamedJob a } deriving Functor +data JobGroup a = StandardTriple { v :: Maybe (NamedJob a) + , n :: Maybe (NamedJob a) + , r :: Maybe (NamedJob a) } deriving (Functor, Show) instance ToJSON a => ToJSON (JobGroup a) where - toJSON jg = object - [ "v" A..= v jg - , "n" A..= n jg - , "r" A..= r jg + toJSON StandardTriple{..} = object + [ "v" A..= v + , "n" A..= n + , "r" A..= r ] rename :: (String -> String) -> JobGroup a -> JobGroup a -rename f (StandardTriple nv nn nr) = StandardTriple (renameJob f nv) (renameJob f nn) (renameJob f nr) -rename f (ValidateOnly nv nn) = ValidateOnly (renameJob f nv) (renameJob f nn) +rename f (StandardTriple nv nn nr) = StandardTriple (renameJob f <$> nv) (renameJob f <$> nn) (renameJob f <$> nr) -- | Construct a 'JobGroup' which consists of a validate, nightly and release build with -- a specific config. standardBuildsWithConfig :: Arch -> Opsys -> BuildConfig -> JobGroup Job standardBuildsWithConfig a op bc = - StandardTriple (validate a op bc) - (nightly a op bc) - (release a op bc) + StandardTriple (Just (validate a op bc)) + (Just (nightly a op bc)) + (Just (release a op bc)) -- | Construct a 'JobGroup' which consists of a validate, nightly and release builds with -- the 'vanilla' config. @@ -878,11 +879,12 @@ standardBuilds a op = standardBuildsWithConfig a op vanilla -- | Construct a 'JobGroup' which just consists of a validate and nightly build. We don't -- produce releases for these jobs. validateBuilds :: Arch -> Opsys -> BuildConfig -> JobGroup Job -validateBuilds a op bc = ValidateOnly (validate a op bc) (nightly a op bc) +validateBuilds a op bc = StandardTriple { v = Just (validate a op bc) + , n = Just (nightly a op bc) + , r = Nothing } flattenJobGroup :: JobGroup a -> [(String, a)] -flattenJobGroup (StandardTriple a b c) = map flattenNamedJob [a,b,c] -flattenJobGroup (ValidateOnly a b) = map flattenNamedJob [a, b] +flattenJobGroup (StandardTriple a b c) = map flattenNamedJob (catMaybes [a,b,c]) flattenNamedJob :: NamedJob a -> (String, a) flattenNamedJob (NamedJob n i) = (n, i) @@ -992,27 +994,51 @@ mkPlatform arch opsys = archName arch <> "-" <> opsysName opsys -- * Prefer jobs which have a corresponding release pipeline -- * Explicitly require tie-breaking for other cases. platform_mapping :: Map String (JobGroup BindistInfo) -platform_mapping = Map.map go $ - Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ v j)), j) | j <- filter hasReleaseBuild job_groups ] +platform_mapping = Map.map go combined_result where whitelist = [ "x86_64-linux-alpine3_12-validate" , "x86_64-linux-deb10-validate" , "x86_64-linux-deb11-validate" , "x86_64-linux-fedora33-release" + , "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" , "x86_64-windows-validate" + , "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" + , "nightly-x86_64-linux-deb11-validate" + , "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" + , "nightly-aarch64-linux-deb10-validate" + , "nightly-x86_64-linux-alpine3_12-validate" + , "nightly-x86_64-linux-deb10-validate" + , "nightly-x86_64-linux-fedora33-release" + , "nightly-x86_64-windows-validate" + , "release-x86_64-linux-alpine3_12-release+no_split_sections" + , "release-x86_64-linux-deb10-release" + , "release-x86_64-linux-deb11-release" + , "release-x86_64-linux-fedora33-release" + , "release-x86_64-windows-release+no_split_sections" ] + process sel = Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ j)), j) | (sel -> Just j) <- job_groups ] + + vs = process v + ns = process n + rs = process r + + all_platforms = Map.keysSet vs <> Map.keysSet ns <> Map.keysSet rs + + combined_result = Map.fromList [ (p, StandardTriple { v = Map.lookup p vs + , n = Map.lookup p ns + , r = Map.lookup p rs }) + | p <- S.toList all_platforms ] + combine a b - | name (v a) `elem` whitelist = a -- Explicitly selected - | name (v b) `elem` whitelist = b - | otherwise = error (show (name (v a)) ++ show (name (v b))) + | name a `elem` whitelist = a -- Explicitly selected + | name b `elem` whitelist = b + | otherwise = error (show (name a) ++ show (name b)) go = fmap (BindistInfo . unwords . fromJust . mmlookup "BIN_DIST_NAME" . jobVariables) - hasReleaseBuild (StandardTriple{}) = True - hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { _bindistName :: String } +data BindistInfo = BindistInfo { _bindistName :: String } deriving Show instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b0d2cead1368a1d2fe85e57c9ac608c9c4a4a06 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b0d2cead1368a1d2fe85e57c9ac608c9c4a4a06 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 10:42:20 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 06:42:20 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Add Note [How we configure the bundled windows toolchain] Message-ID: <64b51b0c6df83_3e28d53d4b57e853086d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c80799d4 by Rodrigo Mesquita at 2023-07-17T11:42:14+01:00 Add Note [How we configure the bundled windows toolchain] - - - - - 3 changed files: - hadrian/src/Rules/Generate.hs - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -444,7 +444,6 @@ generateGhcPlatformH = do , "#endif /* __GHCPLATFORM_H__ */" ] --- See Note [tooldir: How GHC finds mingw on Windows] generateSettings :: Expr String generateSettings = do ctx <- getContext @@ -533,6 +532,8 @@ generateSettings = do -- Like @'queryTarget'@ specialized to String, but replace occurrences of -- @topDirectory inplace/mingw@ with @$$tooldir/mingw@ in the resulting string + -- + -- See Note [How we configure the bundled windows toolchain] queryTarget' :: (Toolchain.Target -> String) -> Expr String queryTarget' f = do topdir <- expr $ topDirectory ===================================== m4/fp_settings.m4 ===================================== @@ -1,11 +1,48 @@ +dnl Note [How we configure the bundled windows toolchain] +dnl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +dnl As per Note [tooldir: How GHC finds mingw on Windows], when using the +dnl bundled windows toolchain, the GHC settings file must refer to the +dnl toolchain through a path relative to $$tooldir (binary distributions on +dnl Windows should work without configure, so the paths must be relative to the +dnl installation). However, hadrian expects the configured toolchain to use +dnl full paths to the executable. +dnl +dnl This is how the bundled windows toolchain is configured, to define the +dnl toolchain with paths to the executables, while still writing into GHC +dnl settings the paths relative to $$tooldir: +dnl +dnl * If using the bundled toolchain, FP_SETUP_WINDOWS_TOOLCHAIN will be invoked +dnl +dnl * FP_SETUP_WINDOWS_TOOLCHAIN will set the toolchain variables to paths +dnl to the bundled toolchain (e.g. CFLAGS=/full/path/to/mingw/bin/gcc) +dnl +dnl * Later on, in FP_SETTINGS, we substitute occurrences of the path to the +dnl mingw tooldir by $$tooldir (see SUBST_TOOLDIR). +dnl The reason is the Settings* variants of toolchain variables are used by the bindist configure to +dnl create the settings file, which needs the windows bundled toolchain to be relative to $$tooldir. +dnl +dnl * Finally, hadrian will also substitute the mingw prefix by $$tooldir before writing the toolchain to the settings file (see generateSettings) +dnl +dnl The ghc-toolchain program isn't concerned with any of these complications: +dnl it is passed either the full paths to the toolchain executables, or the bundled +dnl mingw path is set first on $PATH before invoking it. And ghc-toolchain +dnl will, as always, output target files with full paths to the executables. +dnl +dnl Hadrian accounts for this as it does for the toolchain executables +dnl configured by configure -- in fact, hadrian doesn't need to know whether +dnl the toolchain description file was generated by configure or by +dnl ghc-toolchain. + # SUBST_TOOLDIR # ---------------------------------- # $1 - the variable where to search for occurrences of the path to the # distributed mingw, and update by substituting said occurrences by # the literal '$$tooldir/mingw' +# +# See Note [How we configure the bundled windows toolchain] AC_DEFUN([SUBST_TOOLDIR], [ - dnl See Note [tooldir: How GHC finds mingw on Windows] + dnl and Note [How we configure the bundled windows toolchain] $1=`echo $$1 | sed 's%'"$mingwpath"'%$$tooldir/mingw%'` ]) ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -65,7 +65,8 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ fi } - # See Note [tooldir: How GHC finds mingw on Windows] + # See Note [How we configure the bundled windows toolchain] + # and Note [tooldir: How GHC finds mingw on Windows] test -d inplace || mkdir inplace # NB. Download and extract the MingW-w64 distribution if required View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c80799d4dc32bd8235268e3b2c762e34e6e4d284 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c80799d4dc32bd8235268e3b2c762e34e6e4d284 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 10:58:45 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 17 Jul 2023 06:58:45 -0400 Subject: [Git][ghc/ghc][wip/test-primops] 2 commits: ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Message-ID: <64b51ee518460_3e28d53d4b58245432b@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: cbea9320 by Matthew Pickering at 2023-07-17T11:39:55+01:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 3188635d by Matthew Pickering at 2023-07-17T11:57:06+01:00 Add zstd suffix to jobs which rely on zstd This was causing some confusion as the job was named simply "x86_64-linux-deb10-validate", which implies a standard configuration rather than any dependency on libzstd. - - - - - 8 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - hadrian/ghci-cabal.in - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -364,6 +364,7 @@ hadrian-ghc-in-ghci: - sudo chown ghc:ghc -R . variables: GHC_FLAGS: -Werror + CABFLAGS: --ghc-option=-Werror tags: - x86_64-linux script: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -325,6 +325,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["int_" ++ bignumString (bignumBackend bc) | bignumBackend bc /= Gmp] ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] + ++ ["zstd" | withZstd bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] ===================================== .gitlab/jobs.yaml ===================================== @@ -4467,7 +4467,7 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, - "x86_64-linux-deb10-validate": { + "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4478,7 +4478,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate.tar.xz", + "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4504,7 +4504,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4521,14 +4521,14 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", + "BUILD_FLAVOUR": "validate+debug_info", + "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate" + "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, - "x86_64-linux-deb10-validate+debug_info": { + "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4539,7 +4539,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4565,7 +4565,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4582,14 +4582,14 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", - "BUILD_FLAVOUR": "validate+debug_info", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", + "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" + "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, - "x86_64-linux-deb10-validate+llvm": { + "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4600,7 +4600,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4626,8 +4626,9 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" + "allow_failure": true, + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "manual" } ], "script": [ @@ -4643,14 +4644,16 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", - "BUILD_FLAVOUR": "validate+llvm", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", + "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", + "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+llvm" + "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", + "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, - "x86_64-linux-deb10-validate+thread_sanitizer": { + "x86_64-linux-deb10-zstd-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4661,7 +4664,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4687,9 +4690,8 @@ ], "rules": [ { - "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "manual" + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "when": "on_success" } ], "script": [ @@ -4705,13 +4707,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", - "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", - "HADRIAN_ARGS": "--docs=none", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", - "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + "TEST_ENV": "x86_64-linux-deb10-zstd-validate" } }, "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { ===================================== hadrian/ghci-cabal.in ===================================== @@ -5,6 +5,6 @@ set -e export TOOL_OUTPUT=.hadrian_ghci/ghci_args # Replace newlines with spaces, as these otherwise break the ghci invocation on windows. -CABFLAGS=-v0 "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS +CABFLAGS="-v0 $CABFLAGS" "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')" @WithGhc@ --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m ===================================== hadrian/src/Context.hs ===================================== @@ -95,7 +95,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile context at Context {..} = do +pkgHaddockFile Context {..} = do root <- buildRoot version <- pkgUnitId stage package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" @@ -136,7 +136,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile context at Context {..} = do +pkgConfFile Context {..} = do pid <- pkgUnitId stage package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Flavour.hs ===================================== @@ -37,7 +37,6 @@ import Text.Parsec.Combinator as P import Text.Parsec.Char as P import Control.Monad.Except import UserSettings -import Oracles.Flag flavourTransformers :: Map String (Flavour -> Flavour) ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -31,7 +31,6 @@ import Way import Packages import Development.Shake.Classes import Control.Monad -import Utilities import Base import Context import System.Directory.Extra (listFilesRecursive) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -57,7 +57,6 @@ commonReinstallCabalArgs :: Args commonReinstallCabalArgs = do top <- expr topDirectory root <- getBuildRoot - threads <- shakeThreads <$> expr getShakeOptions _pkg <- getPackage compiler <- expr $ programPath =<< programContext Stage1 ghc mconcat [ arg "--project-file" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b0d2cead1368a1d2fe85e57c9ac608c9c4a4a06...3188635db979164f21080b0e939484a729f9f493 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b0d2cead1368a1d2fe85e57c9ac608c9c4a4a06...3188635db979164f21080b0e939484a729f9f493 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 11:01:57 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 17 Jul 2023 07:01:57 -0400 Subject: [Git][ghc/ghc][wip/test-primops] Fix deb10 Message-ID: <64b51fa5b11d8_3e28d5b51805533b5@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 7f5307ff by Matthew Pickering at 2023-07-17T12:00:54+01:00 Fix deb10 - - - - - 1 changed file: - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -998,8 +998,8 @@ platform_mapping :: Map String (JobGroup BindistInfo) platform_mapping = Map.map go combined_result where whitelist = [ "x86_64-linux-alpine3_12-validate" - , "x86_64-linux-deb10-validate" , "x86_64-linux-deb11-validate" + , "x86_64-linux-deb10-validate+debug_info" , "x86_64-linux-fedora33-release" , "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" , "x86_64-windows-validate" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f5307ffaeaf5c93d7d380d1735a9368003e91df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f5307ffaeaf5c93d7d380d1735a9368003e91df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 11:02:18 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 17 Jul 2023 07:02:18 -0400 Subject: [Git][ghc/ghc][wip/sized-literals-deriving] Use extended literals when deriving Show Message-ID: <64b51fba8247d_3e28d53d49905c5538ba@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/sized-literals-deriving at Glasgow Haskell Compiler / GHC Commits: 00a8d3fb by Krzysztof Gogolewski at 2023-07-17T13:02:05+02:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 4 changed files: - compiler/GHC/Tc/Deriv/Generate.hs - docs/users_guide/9.8.1-notes.rst - testsuite/tests/primops/should_run/ShowPrim.hs - testsuite/tests/primops/should_run/ShowPrim.stdout Changes: ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1282,8 +1282,7 @@ gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon show_arg b arg_ty | isUnliftedType arg_ty -- See Note [Deriving and unboxed types] in GHC.Tc.Deriv.Infer - = with_conv $ - nlHsApps compose_RDR + = nlHsApps compose_RDR [mk_shows_app boxed_arg, mk_showString_app postfixMod] | otherwise = mk_showsPrec_app arg_prec arg @@ -1291,14 +1290,6 @@ gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon arg = nlHsVar b boxed_arg = box "Show" arg arg_ty postfixMod = assoc_ty_id "Show" postfixModTbl arg_ty - with_conv expr - | (Just conv) <- assoc_ty_id_maybe primConvTbl arg_ty = - nested_compose_Expr - [ mk_showString_app ("(" ++ conv ++ " ") - , expr - , mk_showString_app ")" - ] - | otherwise = expr -- Fixity stuff is_infix = dataConIsInfix data_con @@ -1514,9 +1505,8 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstrTag_RDR, eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR , eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR , eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR, - word8ToWord_RDR , int8ToInt_RDR , - word16ToWord_RDR, int16ToInt_RDR, - word32ToWord_RDR, int32ToInt_RDR + int8DataCon_RDR, int16DataCon_RDR, int32DataCon_RDR, int64DataCon_RDR, + word8DataCon_RDR, word16DataCon_RDR, word32DataCon_RDR, word64DataCon_RDR :: RdrName gfoldl_RDR = varQual_RDR gENERICS (fsLit "gfoldl") gunfold_RDR = varQual_RDR gENERICS (fsLit "gunfold") @@ -1619,15 +1609,14 @@ leDouble_RDR = varQual_RDR gHC_PRIM (fsLit "<=##") gtDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">##" ) geDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">=##") -word8ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word8ToWord#") -int8ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int8ToInt#") - -word16ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word16ToWord#") -int16ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int16ToInt#") - -word32ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word32ToWord#") -int32ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int32ToInt#") - +int8DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I8#") +int16DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I16#") +int32DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I32#") +int64DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I64#") +word8DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W8#") +word16DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W16#") +word32DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W32#") +word64DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W64#") {- ************************************************************************ * * @@ -2416,7 +2405,6 @@ ordOpTbl -- A mapping from a primitive type to a function that constructs its boxed -- version. --- NOTE: Int8#/Word8# will become Int/Word. boxConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] boxConTbl = [ (charPrimTy , nlHsApp (nlHsVar $ getRdrName charDataCon)) @@ -2424,28 +2412,20 @@ boxConTbl = , (wordPrimTy , nlHsApp (nlHsVar $ getRdrName wordDataCon )) , (floatPrimTy , nlHsApp (nlHsVar $ getRdrName floatDataCon )) , (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon)) - , (int8PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int8ToInt_RDR)) - , (word8PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word8ToWord_RDR)) - , (int16PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int16ToInt_RDR)) - , (word16PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word16ToWord_RDR)) - , (int32PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int32ToInt_RDR)) - , (word32PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word32ToWord_RDR)) + , (int8PrimTy, nlHsApp (nlHsVar int8DataCon_RDR)) + , (word8PrimTy, nlHsApp (nlHsVar word8DataCon_RDR)) + , (int16PrimTy, nlHsApp (nlHsVar int16DataCon_RDR)) + , (word16PrimTy, nlHsApp (nlHsVar word16DataCon_RDR)) + , (int32PrimTy, nlHsApp (nlHsVar int32DataCon_RDR)) + , (word32PrimTy, nlHsApp (nlHsVar word32DataCon_RDR)) + , (int64PrimTy, nlHsApp (nlHsVar int64DataCon_RDR)) + , (word64PrimTy, nlHsApp (nlHsVar word64DataCon_RDR)) ] -- | A table of postfix modifiers for unboxed values. +-- Following https://github.com/ghc-proposals/ghc-proposals/pull/596, +-- we use the ExtendedLiterals syntax for sized literals. postfixModTbl :: [(Type, String)] postfixModTbl = [(charPrimTy , "#" ) @@ -2453,22 +2433,14 @@ postfixModTbl ,(wordPrimTy , "##") ,(floatPrimTy , "#" ) ,(doublePrimTy, "##") - ,(int8PrimTy, "#") - ,(word8PrimTy, "##") - ,(int16PrimTy, "#") - ,(word16PrimTy, "##") - ,(int32PrimTy, "#") - ,(word32PrimTy, "##") - ] - -primConvTbl :: [(Type, String)] -primConvTbl = - [ (int8PrimTy, "intToInt8#") - , (word8PrimTy, "wordToWord8#") - , (int16PrimTy, "intToInt16#") - , (word16PrimTy, "wordToWord16#") - , (int32PrimTy, "intToInt32#") - , (word32PrimTy, "wordToWord32#") + ,(int8PrimTy , "#Int8") + ,(word8PrimTy , "#Word8") + ,(int16PrimTy , "#Int16") + ,(word16PrimTy, "#Word16") + ,(int32PrimTy , "#Int32") + ,(word32PrimTy, "#Word32") + ,(int64PrimTy , "#Int64") + ,(word64PrimTy, "#Word64") ] litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -9,6 +9,10 @@ Language - There is a new extension :extension:`ExtendedLiterals`, which enables sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. See the GHC proposal `#451 `_. + Derived ``Show`` instances for datatypes containing sized literals (``Int8#``, ``Word8#``, ``Int16#`` etc.) + now use the extended literal syntax, per GHC proposal `#596 `_. + Furthermore, it is now possible to derive ``Show`` for datatypes containing + fields of types ``Int64#`` and ``Word64#``. - GHC Proposal `#425 `_ ===================================== testsuite/tests/primops/should_run/ShowPrim.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MagicHash, ExtendedLiterals #-} module Main where @@ -13,17 +13,24 @@ data Test2 = Test2 Int16# Word16# data Test3 = Test3 Int32# Word32# deriving (Show) +data Test4 = Test4 Int64# Word64# + deriving (Show) + test1 :: Test1 -test1 = Test1 (intToInt8# 1#) (wordToWord8# 2##) +test1 = Test1 1#Int8 2#Word8 test2 :: Test2 -test2 = Test2 (intToInt16# 1#) (wordToWord16# 2##) +test2 = Test2 1#Int16 2#Word16 test3 :: Test3 -test3 = Test3 (intToInt32# 1#) (wordToWord32# 2##) +test3 = Test3 1#Int32 2#Word32 + +test4 :: Test4 +test4 = Test4 -9223372036854775808#Int64 18446744073709551610#Word64 main :: IO () main = do print test1 print test2 print test3 + print test4 ===================================== testsuite/tests/primops/should_run/ShowPrim.stdout ===================================== @@ -1,3 +1,4 @@ -Test1 (intToInt8# 1#) (wordToWord8# 2##) -Test2 (intToInt16# 1#) (wordToWord16# 2##) -Test3 (intToInt32# 1#) (wordToWord32# 2##) +Test1 1#Int8 2#Word8 +Test2 1#Int16 2#Word16 +Test3 1#Int32 2#Word32 +Test4 -9223372036854775808#Int64 18446744073709551610#Word64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00a8d3fb7839ba9f922c04653d39e3dcc9337919 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00a8d3fb7839ba9f922c04653d39e3dcc9337919 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 11:06:32 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 07:06:32 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Add Note [ghc-toolchain consistency checking] Message-ID: <64b520b8c0c69_3e28d53d46e1685575a4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 78de5dae by Rodrigo Mesquita at 2023-07-17T12:06:25+01:00 Add Note [ghc-toolchain consistency checking] - - - - - 2 changed files: - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 Changes: ===================================== m4/ghc_toolchain.m4 ===================================== @@ -116,6 +116,22 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ]) +dnl Note [ghc-toolchain consistency checking] +dnl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +dnl ghc-toolchain is the brand new way (2023) to configure toolchains for GHC, +dnl but this novelty musn't break user's installations, so we still +dnl conservatively use the toolchains configured by configure (see also m4/prep_target_file.m4). +dnl +dnl However, we already ship and run ghc-toolchain at configure time to /validate/ ghc-toolchain: +dnl * PREP_TARGET_FILE substitutes the toolchain into default.target.in and default.host.target.in +dnl * FIND_GHC_TOOLCHAIN generates a target description file through ghc-toolchain +dnl * VALIDATE_GHC_TOOLCHAIN compares the output of the two, warning about the differences. +dnl +dnl This is crucial to validate ghc-toolchain and preemptively fix bugs before it is the default. +dnl +dnl (And the configure flag --enable-ghc-toolchain makes hadrian use the target +dnl files generated by ghc-toolchain instead). + dnl $1 like "default.target" dnl $2 like "default.target.ghc-toolchain" AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ ===================================== m4/prep_target_file.m4 ===================================== @@ -6,6 +6,9 @@ # Since we substitute in those files with configured variables, we have to # preparate them as Haskell values, for example, turning YES/NO into # True,False, or empty variables into Nothing or Just something otherwise. +# +# This toolchain will additionally be used to validate the one generated by +# ghc-toolchain. See Note [ghc-toolchain consistency checking]. # PREP_MAYBE_SIMPLE_PROGRAM # ========================= View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78de5dae63c77ef4c317e4b47beab12527908a7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78de5dae63c77ef4c317e4b47beab12527908a7a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 12:45:08 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 17 Jul 2023 08:45:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23662 Message-ID: <64b537d4dba04_3e28d5b5180608242@gitlab.mail> Jaro Reinders pushed new branch wip/T23662 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23662 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 13:32:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 09:32:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64b542f79dba1_3e28d53d4b51586341e7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f0750ce4 by sheaf at 2023-07-17T09:32:30-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 38f8b466 by sheaf at 2023-07-17T09:32:30-04:00 exactprint: silence incomplete record update warnings - - - - - 4d53d069 by sheaf at 2023-07-17T09:32:30-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 9c8e92e8 by sheaf at 2023-07-17T09:32:30-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - e6658960 by sheaf at 2023-07-17T09:32:30-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - 4514c8e5 by Rodrigo Mesquita at 2023-07-17T09:32:31-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - d0946293 by Sylvain Henry at 2023-07-17T09:32:34-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Basic.hs - compiler/Language/Haskell/Syntax/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bc23213d2a981fe2b1655c30b47c9817502a8c4...d094629327b827718cfdfd1336f1f1e24aee2973 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1bc23213d2a981fe2b1655c30b47c9817502a8c4...d094629327b827718cfdfd1336f1f1e24aee2973 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 13:52:16 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 17 Jul 2023 09:52:16 -0400 Subject: [Git][ghc/ghc][wip/T17521] 2 commits: Add exception to letrect invariant Message-ID: <64b5479045c88_3e28d53d4b57e8651078@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 44bd7b2f by Jaro Reinders at 2023-07-17T15:51:38+02:00 Add exception to letrect invariant - - - - - df499b72 by Jaro Reinders at 2023-07-17T15:52:02+02:00 Add stg rewrites test - - - - - 4 changed files: - compiler/GHC/Core.hs - + testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewrite.hs - + testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewritea.hs - testsuite/tests/unlifted-datatypes/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -377,13 +377,13 @@ for the meaning of "lifted" vs. "unlifted". For the non-top-level, non-recursive case see Note [Core let-can-float invariant]. -At top level, however, there are two exceptions to this rule: +At top level, however, there are three exceptions to this rule: (TL1) A top-level binding is allowed to bind primitive string literal, (which is unlifted). See Note [Core top-level string literals]. (TL2) In Core, we generate a top-level binding for every non-newtype data -constructor worker or wrapper + constructor worker or wrapper e.g. data T = MkT Int we generate MkT :: Int -> T @@ -399,6 +399,12 @@ constructor worker or wrapper S1 = S1 We allow this top-level unlifted binding to exist. +(TL3) A boxed top-level binding is allowed to bind the application of a data + constructor worker to trivial arguments. These bindings are guaranteed + to not require any evaluation and can thus be compiled to static data. + Unboxed top-level bindings are still not allowed because references + to them might have to be pointers. + Note [Core let-can-float invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The let-can-float invariant: ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewrite.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -O #-} +{-# LANGUAGE UnliftedDatatypes #-} + +module TopLevelStgRewrite where + +import TopLevelStgRewritea +import GHC.Exts +import Data.Kind (Type) + +type Box :: UnliftedType -> Type +data Box a = Box a + +type B :: Type -> UnliftedType +data B a = B !a + +b :: Box (B Bool) +b = Box (B a) ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewritea.hs ===================================== @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -O0 #-} + +module TopLevelStgRewritea where + +a :: Bool +a = True ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -3,3 +3,4 @@ test('UnlDataPolySigs', normal, compile, ['']) test('UnlDataFams', normal, compile, ['']) test('UnlDataUsersGuide', normal, compile, ['']) test('TopLevel', normal, multimod_compile, ['TopLevel', '-O']) +test('TopLevelStgRewrite', normal, multimod_compile, ['TopLevelStgRewrite', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0891b558ad08124d8e1a53f14fd68805cb02e711...df499b7224175010b63e83a3eb4b0f4db41375f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0891b558ad08124d8e1a53f14fd68805cb02e711...df499b7224175010b63e83a3eb4b0f4db41375f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 13:55:51 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 17 Jul 2023 09:55:51 -0400 Subject: [Git][ghc/ghc][wip/T17521] 43 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) Message-ID: <64b54867343f1_3e28d53d46e168655439@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 5825a1d2 by Jaro Reinders at 2023-07-17T14:44:48+02:00 Add StgFromCore and StgCodeGen linting - - - - - 73bd40eb by Jaro Reinders at 2023-07-17T15:55:27+02:00 Allow unlifted trivial datacon applications - - - - - 5377f9ec by Jaro Reinders at 2023-07-17T15:55:27+02:00 Allow nested floating - - - - - f1094cd2 by Jaro Reinders at 2023-07-17T15:55:27+02:00 Fixes - - - - - 94066654 by Jaro Reinders at 2023-07-17T15:55:27+02:00 Fix doc - - - - - 7e513e8e by Jaro Reinders at 2023-07-17T15:55:27+02:00 Add test - - - - - de602ffa by Jaro Reinders at 2023-07-17T15:55:27+02:00 Better test - - - - - 3fc3eb7e by Jaro Reinders at 2023-07-17T15:55:27+02:00 Relax lint - - - - - 24916b55 by Jaro Reinders at 2023-07-17T15:55:27+02:00 Add exception to letrect invariant - - - - - 5e5fcbc6 by Jaro Reinders at 2023-07-17T15:55:28+02:00 Add stg rewrites test - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Config/StgToCmm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df499b7224175010b63e83a3eb4b0f4db41375f6...5e5fcbc66ca04865ded752fa44e307cc81025445 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df499b7224175010b63e83a3eb4b0f4db41375f6...5e5fcbc66ca04865ded752fa44e307cc81025445 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 14:23:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 17 Jul 2023 10:23:17 -0400 Subject: [Git][ghc/ghc][wip/test-primops] Revert "ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job" Message-ID: <64b54ed592b6f_3e28d53d5ed304664533@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: e44c3cb2 by Matthew Pickering at 2023-07-17T15:23:07+01:00 Revert "ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job" This reverts commit cbea9320ec9399daf9bb60d4e732dca408c05341. - - - - - 6 changed files: - .gitlab-ci.yml - hadrian/ghci-cabal.in - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -364,7 +364,6 @@ hadrian-ghc-in-ghci: - sudo chown ghc:ghc -R . variables: GHC_FLAGS: -Werror - CABFLAGS: --ghc-option=-Werror tags: - x86_64-linux script: ===================================== hadrian/ghci-cabal.in ===================================== @@ -5,6 +5,6 @@ set -e export TOOL_OUTPUT=.hadrian_ghci/ghci_args # Replace newlines with spaces, as these otherwise break the ghci invocation on windows. -CABFLAGS="-v0 $CABFLAGS" "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS +CABFLAGS=-v0 "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')" @WithGhc@ --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m ===================================== hadrian/src/Context.hs ===================================== @@ -95,7 +95,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile Context {..} = do +pkgHaddockFile context at Context {..} = do root <- buildRoot version <- pkgUnitId stage package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" @@ -136,7 +136,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do +pkgConfFile context at Context {..} = do pid <- pkgUnitId stage package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Flavour.hs ===================================== @@ -37,6 +37,7 @@ import Text.Parsec.Combinator as P import Text.Parsec.Char as P import Control.Monad.Except import UserSettings +import Oracles.Flag flavourTransformers :: Map String (Flavour -> Flavour) ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -31,6 +31,7 @@ import Way import Packages import Development.Shake.Classes import Control.Monad +import Utilities import Base import Context import System.Directory.Extra (listFilesRecursive) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -57,6 +57,7 @@ commonReinstallCabalArgs :: Args commonReinstallCabalArgs = do top <- expr topDirectory root <- getBuildRoot + threads <- shakeThreads <$> expr getShakeOptions _pkg <- getPackage compiler <- expr $ programPath =<< programContext Stage1 ghc mconcat [ arg "--project-file" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e44c3cb27f3e445416505956b18ef5cd04e42919 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e44c3cb27f3e445416505956b18ef5cd04e42919 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 15:38:53 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 17 Jul 2023 11:38:53 -0400 Subject: [Git][ghc/ghc][wip/T17521] Add hs-boot test Message-ID: <64b5608d7cf99_3e28d53d46e1687171f4@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 1a69abbb by Jaro Reinders at 2023-07-17T17:38:45+02:00 Add hs-boot test - - - - - 4 changed files: - + testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewriteBoot.hs - + testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewriteBoota.hs - + testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewriteBoota.hs-boot - testsuite/tests/unlifted-datatypes/should_compile/all.T Changes: ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewriteBoot.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE UnliftedDatatypes #-} + +module TopLevelStgRewriteBoot where + +import {-# SOURCE #-} TopLevelStgRewriteBoota +import GHC.Exts +import Data.Kind (Type) + +x :: Bool +x = True + +type Box :: UnliftedType -> Type +data Box a = Box a + +type B :: Type -> UnliftedType +data B a = B !a + +b :: Box (B Bool) +b = Box (B a) \ No newline at end of file ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewriteBoota.hs ===================================== @@ -0,0 +1,6 @@ +module TopLevelStgRewriteBoota where + +import TopLevelStgRewriteBoot (x) + +a :: Bool +a = not x ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevelStgRewriteBoota.hs-boot ===================================== @@ -0,0 +1,3 @@ +module TopLevelStgRewriteBoota where + +a :: Bool ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -4,3 +4,4 @@ test('UnlDataFams', normal, compile, ['']) test('UnlDataUsersGuide', normal, compile, ['']) test('TopLevel', normal, multimod_compile, ['TopLevel', '-O']) test('TopLevelStgRewrite', normal, multimod_compile, ['TopLevelStgRewrite', '-v0']) +test('TopLevelStgRewriteBoot', normal, multimod_compile, ['TopLevelStgRewriteBoot', '-O -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a69abbb77d9401098139c91eaa7d245b5149072 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1a69abbb77d9401098139c91eaa7d245b5149072 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 15:44:13 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 17 Jul 2023 11:44:13 -0400 Subject: [Git][ghc/ghc][wip/uniqset-fusion] 1020 commits: Revert "rts: Drop racy assertion" Message-ID: <64b561cdb7caf_3e28d53d4b5158722510@gitlab.mail> Sylvain Henry pushed to branch wip/uniqset-fusion at Glasgow Haskell Compiler / GHC Commits: db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 5a428e9e by Ben Gamari at 2023-07-17T17:43:11+02:00 Reg.Liveness: Strictness - - - - - 15b43865 by Ben Gamari at 2023-07-17T17:43:12+02:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - 2b0e0368 by Ben Gamari at 2023-07-17T17:43:20+02:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 - - - - - 18 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_jobs - .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/609312697cadddb370b87665e2d52bc014933477...2b0e0368a6d17100031d85718a29f4ce7ffd8c10 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/609312697cadddb370b87665e2d52bc014933477...2b0e0368a6d17100031d85718a29f4ce7ffd8c10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 15:45:52 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 17 Jul 2023 11:45:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23630 Message-ID: <64b56230cc026_3e28d53d49cc98724490@gitlab.mail> Matthew Pickering pushed new branch wip/t23630 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23630 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 16:53:44 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 17 Jul 2023 12:53:44 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Deleted 1 commit: Half way attempt at inlining join points Message-ID: <64b572184809e_23a43db5680101152@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: be385269 by Simon Peyton Jones at 2023-07-12T17:39:07+01:00 Half way attempt at inlining join points My idea here is to be more parsimonious about inlining join points. I was thinking that even join j x = I# x in case v of p1 -> j x1 p2 -> j x2 ... might not inline. Better for consumers. Also don't inline even in FinalPhase beause we want importing modules to see this. - - - - - 4 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/IfaceToCore.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -43,7 +43,8 @@ import GHC.Core.Opt.Arity ( ArityType, exprArity, arityTypeBotSigs_maybe , pushCoTyArg, pushCoValArg, exprIsDeadEnd , typeArity, arityTypeArity, etaExpandAT ) import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe ) -import GHC.Core.FVs ( mkRuleInfo, exprsFreeIds ) +-- import GHC.Core.FVs ( mkRuleInfo, exprsFreeIds ) +import GHC.Core.FVs ( mkRuleInfo ) import GHC.Core.Rules ( lookupRule, getRules ) import GHC.Core.Multiplicity @@ -58,12 +59,13 @@ import GHC.Types.Unique ( hasKey ) import GHC.Types.Basic import GHC.Types.Tickish import GHC.Types.Var ( isTyCoVar ) -import GHC.Types.Var.Set +-- import GHC.Types.Var.Set import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, isJust, orElse, mapMaybe ) +-- import GHC.Data.Maybe ( isNothing, isJust, orElse, mapMaybe ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -3952,16 +3954,12 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool -- See Note [Duplicating alternatives] -ok_to_dup_alt case_bndr alt_bndrs alt_rhs +ok_to_dup_alt _case_bndr _alt_bndrs alt_rhs | (Var v, args) <- collectArgs alt_rhs , all exprIsTrivial args - = if isJust (isDataConId_maybe v) - then exprsFreeIds args `subVarSet` bndr_set - else True + = isNothing (isDataConId_maybe v) | otherwise = False - where - bndr_set = mkVarSet (case_bndr : alt_bndrs) {- Note [Do not add unfoldings to join points at birth] @@ -4104,14 +4102,12 @@ To achieve this: phase. (The Final phase is still quite early, so we might consider delaying still more.) -2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for - all alternatives, except for exprIsTrival RHSs. Previously we used - exprIsDupable. This generates a lot more join points, but makes - them much more case-of-case friendly. +2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for all + alternatives, /unless/ the join point would be immediately inlined in the + following iteration: e.g. if its RHS is trivial. - It is definitely worth checking for exprIsTrivial, otherwise we get - an extra Simplifier iteration, because it is inlined in the next - round. + (Previously we used exprIsDupable.) This generates a lot more join points, + but makes them much more case-of-case friendly. 3. By the same token we want to use Plan B in Note [Duplicating StrictArg] when the RHS of the new join point @@ -4135,7 +4131,7 @@ the join point only when the RHS is * a constructor application? or * just non-trivial? Currently, a bit ad-hoc, but we definitely want to retain the join -point for data constructors in mkDupableALt (point 2); that is the +point for data constructors in mkDupableAlt (point 2); that is the whole point of #19996 described above. Historical Note [Case binders and join points] @@ -4424,19 +4420,14 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource -> InId -> OutExpr -> SimplM Unfolding mkLetUnfolding !uf_opts top_lvl src id new_rhs - = return (mkUnfolding uf_opts src is_top_lvl is_bottoming new_rhs Nothing) - -- We make an unfolding *even for loop-breakers*. - -- Reason: (a) It might be useful to know that they are WHNF - -- (b) In GHC.Iface.Tidy we currently assume that, if we want to - -- expose the unfolding then indeed we *have* an unfolding - -- to expose. (We could instead use the RHS, but currently - -- we don't.) The simple thing is always to have one. + = return (mkCoreUnfolding src is_top_lvl new_rhs Nothing guidance) where - -- Might as well force this, profiles indicate up to 0.5MB of thunks - -- just from this site. - !is_top_lvl = isTopLevel top_lvl - -- See Note [Force bottoming field] - !is_bottoming = isDeadEndId id + guidance = calcUnfoldingGuidance uf_opts (isJoinId id) is_top_bottoming new_rhs + + -- Strict binding; profiles indicate up to 0.5MB of thunks + -- just from this site. See Note [Force bottoming field] + !is_top_lvl = isTopLevel top_lvl + !is_top_bottoming =is_top_lvl && isDeadEndId id ------------------- simplStableUnfolding :: SimplEnv -> BindContext ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -256,17 +256,18 @@ inlineBoringOk e calcUnfoldingGuidance :: UnfoldingOpts + -> Bool -- This is a join point -> Bool -- Definitely a top-level, bottoming binding -> CoreExpr -- Expression to look at -> UnfoldingGuidance -calcUnfoldingGuidance opts is_top_bottoming (Tick t expr) +calcUnfoldingGuidance opts is_join is_top_bottoming (Tick t expr) | not (tickishIsCode t) -- non-code ticks don't matter for unfolding - = calcUnfoldingGuidance opts is_top_bottoming expr -calcUnfoldingGuidance opts is_top_bottoming expr + = calcUnfoldingGuidance opts is_join is_top_bottoming expr +calcUnfoldingGuidance opts is_join is_top_bottoming expr = case sizeExpr opts bOMB_OUT_SIZE val_bndrs body of TooBig -> UnfNever SizeIs size cased_bndrs scrut_discount - | uncondInline expr n_val_bndrs size + | uncondInline is_join expr n_val_bndrs size -> UnfWhen { ug_unsat_ok = unSaturatedOk , ug_boring_ok = boringCxtOk , ug_arity = n_val_bndrs } -- Note [INLINE for small functions] @@ -432,11 +433,12 @@ sharing the wrapper closure. The solution: don’t ignore coercion arguments after all. -} -uncondInline :: CoreExpr -> Arity -> Int -> Bool +uncondInline :: Bool -> CoreExpr -> Arity -> Int -> Bool -- Inline unconditionally if there no size increase -- Size of call is arity (+1 for the function) -- See Note [INLINE for small functions] -uncondInline rhs arity size +uncondInline is_join rhs arity size + | is_join = size < 10 | arity > 0 = size <= 10 * (arity + 1) -- See Note [INLINE for small functions] (1) | otherwise = exprIsTrivial rhs -- See Note [INLINE for small functions] (4) @@ -594,6 +596,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr DataConWorkId dc -> conSize dc (length val_args) PrimOpId op _ -> primOpSize op (length val_args) ClassOpId {} -> classOpSize opts top_args val_args + JoinId {} -> sizeZero -- See Note [Inlining join points] _ -> funSize opts top_args fun (length val_args) voids ------------ @@ -685,6 +688,7 @@ callSize n_val_args voids = 10 * (1 + n_val_args - voids) -- Add 1 for each non-trivial arg; -- the allocation cost, as in let(rec) +{- -- | The size of a jump to a join point jumpSize :: Int -- ^ number of value args @@ -695,6 +699,7 @@ jumpSize n_val_args voids = 2 * (1 + n_val_args - voids) -- bug #6048, but making them any more expensive loses a 21% improvement in -- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a -- better solution? +-} funSize :: UnfoldingOpts -> [Id] -> Id -> Int -> Int -> ExprSize -- Size for functions that are not constructors or primops @@ -705,9 +710,9 @@ funSize opts top_args fun n_val_args voids | otherwise = SizeIs size arg_discount res_discount where some_val_args = n_val_args > 0 - is_join = isJoinId fun +-- is_join = isJoinId fun - size | is_join = jumpSize n_val_args voids + size -- | is_join = jumpSize n_val_args voids | not some_val_args = 0 | otherwise = callSize n_val_args voids @@ -772,6 +777,21 @@ win", but its terribly dangerous because a function with many many case branches, each finishing with a constructor, can have an arbitrarily large discount. This led to terrible code bloat: see #6099. +Note [Inlining join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Suppose we have + join j1 a b c d = blah + join j2 x = j1 x v x w + in ...(jump j2 t).... + +Then j1 is just an indirection to j1 with a bit of argument shuffling. +We want to inline it even though it has more arguments: + join j1 a b c d = blah + in ...(jump j1 t v t w)... + +So we charge nothing for join-point calls; a bit like we make constructor +applications cheap (see Note [Constructor size and result discount]). + Note [Unboxed tuple size and result discount] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ However, unboxed tuples count as size zero. I found occasions where we had ===================================== compiler/GHC/Core/Unfold/Make.hs ===================================== @@ -117,7 +117,7 @@ mkWorkerUnfolding opts work_fn = mkCoreUnfolding src top_lvl new_tmpl Nothing guidance where new_tmpl = simpleOptExpr opts (work_fn tmpl) - guidance = calcUnfoldingGuidance (so_uf_opts opts) False new_tmpl + guidance = calcUnfoldingGuidance (so_uf_opts opts) False False new_tmpl mkWorkerUnfolding _ _ _ = noUnfolding @@ -328,7 +328,7 @@ mkUnfolding opts src top_lvl is_bottoming expr cache = mkCoreUnfolding src top_lvl expr cache guidance where is_top_bottoming = top_lvl && is_bottoming - guidance = calcUnfoldingGuidance opts is_top_bottoming expr + guidance = calcUnfoldingGuidance opts False is_top_bottoming expr -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))! -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression] ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1778,7 +1778,7 @@ tcUnfolding toplvl name _ info (IfCoreUnfold src cache if_guidance if_expr) ; expr <- tcUnfoldingRhs (isCompulsorySource src) toplvl name if_expr ; let guidance = case if_guidance of IfWhen arity unsat_ok boring_ok -> UnfWhen arity unsat_ok boring_ok - IfNoGuidance -> calcUnfoldingGuidance uf_opts is_top_bottoming expr + IfNoGuidance -> calcUnfoldingGuidance uf_opts False is_top_bottoming expr -- See Note [Tying the 'CoreUnfolding' knot] ; return $ mkCoreUnfolding src True expr (Just cache) guidance } where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be385269dafbad2d3af3347afac4690b4f9f4933 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be385269dafbad2d3af3347afac4690b4f9f4933 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 16:57:38 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 12:57:38 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ghc-toolchain: Toolchain Selection Message-ID: <64b573028d65f_23a43db5540108730@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 2fbbecc5 by Rodrigo Mesquita at 2023-07-17T17:56:34+01:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) Ticket: #19877 MR: !9263 --- ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain leftovers Delete a part Use ghc-platform instead of ghc-boot configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in Rename target files to hadrian/cfg (not on bindist) Add Note [How we configure the bundled windows toolchain] Add Note [ghc-toolchain consistency checking] Fix hadrian 99974tooldir substituttion - - - - - ddc899b3 by Rodrigo Mesquita at 2023-07-17T17:56:36+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - + TODO - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - + hadrian/cfg/default.host.target.in - + hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78de5dae63c77ef4c317e4b47beab12527908a7a...ddc899b34cd534f3e3af9e94f2fbbbf53c89aa4b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78de5dae63c77ef4c317e4b47beab12527908a7a...ddc899b34cd534f3e3af9e94f2fbbbf53c89aa4b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 16:57:45 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Mon, 17 Jul 2023 12:57:45 -0400 Subject: [Git][ghc/ghc][wip/az/epa-improve-getmonobind] 8 commits: Equality of forall-types is visibility aware Message-ID: <64b57309846fb_23a43db5658109271@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-improve-getmonobind at Glasgow Haskell Compiler / GHC Commits: cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - d328cb00 by Alan Zimmerman at 2023-07-17T17:55:25+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6acf2ec60675f9af7bddc457cfb3760143c62696...d328cb00d3938302b8ba32e7a07c0929f2bcdde2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6acf2ec60675f9af7bddc457cfb3760143c62696...d328cb00d3938302b8ba32e7a07c0929f2bcdde2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 17:03:43 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Mon, 17 Jul 2023 13:03:43 -0400 Subject: [Git][ghc/ghc][wip/az/epa-improve-sl1] 9 commits: Equality of forall-types is visibility aware Message-ID: <64b5746f3bde9_23a43db58881128a2@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-improve-sl1 at Glasgow Haskell Compiler / GHC Commits: cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - d328cb00 by Alan Zimmerman at 2023-07-17T17:55:25+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 0c4e5953 by Alan Zimmerman at 2023-07-17T18:03:17+01:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a94f64280a6f6a4e1beaf28fc65ce17250cf31e8...0c4e5953b2ed2e9001f2370e06a3238f7d2f453f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a94f64280a6f6a4e1beaf28fc65ce17250cf31e8...0c4e5953b2ed2e9001f2370e06a3238f7d2f453f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 17:13:02 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 13:13:02 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Apply 10 suggestion(s) to 4 file(s) Message-ID: <64b5769e3e87_23a43db56801227d9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9896d0a0 by Ben Gamari at 2023-07-17T17:12:59+00:00 Apply 10 suggestion(s) to 4 file(s) - - - - - 4 changed files: - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -180,7 +180,7 @@ options = ] tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple) "TRIPLE") "Target triple" - llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVMTRIPLE") "LLVM Target triple" + llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVM-TRIPLE") "LLVM Target triple" targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX") "A target prefix which will be added to all tool names when searching for toolchain components" @@ -299,8 +299,9 @@ determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for a pure True _ -> -- If don't have a native adjustor implementation we use libffi - pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we + pure (not . archHasNativeAdjustors $ archOS_arch archOs) +-- | Do we implement a native adjustor implementation (i.e. found in @rts/adjustors@) for this 'Arch'? archHasNativeAdjustors :: Arch -> Bool archHasNativeAdjustors = \case ArchX86 -> True @@ -333,7 +334,7 @@ mkTarget opts = do mergeObjs <- optional $ findMergeObjs (optMergeObjs opts) cc ccLink nm when (isNothing mergeObjs && not (arSupportsDashL ar)) $ - throwE "Neither a merge object tool nor an ar that supports -L is available" + throwE "Neither a object-merging tool (e.g. ld -r) nor an ar that supports -L is available" -- Windows-specific utilities windres <- ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -104,7 +104,7 @@ logMsg v msg = do readFile :: FilePath -> M String readFile path = liftIO $ T.unpack <$> T.readFile path -- Use T.readfile to read the file strictly, or otherwise run - -- into bugs (in practice on windows)! + -- into file locking bugs on Windows writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s @@ -121,8 +121,7 @@ appendFile path s = liftIO $ Prelude.appendFile path s createFile :: FilePath -> M () createFile path = writeFile path "" --- | Branch on whether we're cross-compiling, that is, if the Target we're --- producing differs from the platform we're producing it on. +-- | Branch on whether we can execute target code locally. ifCrossCompiling :: M a -- ^ what to do when cross-compiling -> M a -- ^ what to do otherwise ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -140,7 +140,7 @@ findProgram description userSpec candidates -- -- The compiler must -- * Take the program path as a positional argument --- * Accept -o to specify output path +-- * Accept @-o@ to specify output path compile :: FilePath -- ^ input extension -> [String] -- ^ extra flags @@ -155,14 +155,14 @@ compile ext extraFlags lens c outPath program = do callProgram (view lens c) $ extraFlags ++ ["-o", outPath, srcPath] expectFileExists outPath "compiler produced no output" --- Does compiler program support the --target= option? If so, we should +-- | Does compiler program support the @--target=@ option? If so, we should -- pass it whenever possible to avoid ambiguity and potential compile-time -- errors (e.g. see #20162). supportsTarget :: Lens compiler Program - -> (compiler -> M ()) -- ^ Action to check if compiler with --target flag works - -> String -- ^ The llvm target to use if Cc supports --target - -> compiler -- ^ The compiler to check --target support for - -> M compiler -- ^ Return compiler with --target flag if supported + -> (compiler -> M ()) -- ^ Action to check if compiler with @--target@ flag works + -> String -- ^ The LLVM target to use if @cc@ supports @--target@ + -> compiler -- ^ The compiler to check @--target@ support for + -> M compiler -- ^ Return compiler with @--target@ flag if supported supportsTarget lens checkWorks llvmTarget c -- TODO: #23603 | any ("--target=" `isPrefixOf`) (view (lens % _prgFlags) c) = return c ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -64,7 +64,7 @@ data Target = Target , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink , tgtAr :: Ar - , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it + , tgtRanlib :: Maybe Ranlib -- ^ N.B. Most @ar@ implementations will add an index by default without @ranlib@ so this is often optional , tgtNm :: Nm , tgtMergeObjs :: Maybe MergeObjs -- We don't need a merge objects tool if we @Ar@ supports @-L@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9896d0a081dc6b2e953765834233d645c885cad6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9896d0a081dc6b2e953765834233d645c885cad6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 17:31:21 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 13:31:21 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 17 commits: base: fix haddock syntax in GHC.Profiling Message-ID: <64b57ae974588_23a43db552c1306d6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 784159b3 by Rodrigo Mesquita at 2023-07-17T18:13:55+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - 8facf830 by Ben Gamari at 2023-07-17T18:13:55+01:00 ghc-toolchain: Initial commit - - - - - 81e2cfa4 by Rodrigo Mesquita at 2023-07-17T18:13:55+01:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) Ticket: #19877 MR: !9263 --- ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required Windows bundled toolchain, output path, etc Add windows bundled toolchain specific flags refactor on hadrian handling of toolchains Fixes to hadrian and ghc-toolchain Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now Don't crash on ghc-toolchain failure Mingw bundled toolchain leftovers Delete a part Use ghc-platform instead of ghc-boot configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in Rename target files to hadrian/cfg (not on bindist) Add Note [How we configure the bundled windows toolchain] Add Note [ghc-toolchain consistency checking] Fix hadrian 99974tooldir substituttion - - - - - e29d8286 by Rodrigo Mesquita at 2023-07-17T18:13:55+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 0261da57 by Rodrigo Mesquita at 2023-07-17T18:31:06+01:00 Address review Apply 10 suggestion(s) to 4 file(s) - - - - - 30 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - + TODO - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9896d0a081dc6b2e953765834233d645c885cad6...0261da573c13e6b7d371674b722b57fc89b3f926 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9896d0a081dc6b2e953765834233d645c885cad6...0261da573c13e6b7d371674b722b57fc89b3f926 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 17:53:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 13:53:04 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Address review Message-ID: <64b58000e1215_23a43db570c142614@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: b268686c by Rodrigo Mesquita at 2023-07-17T18:52:57+01:00 Address review - - - - - 3 changed files: - − TODO - hadrian/src/Rules/BinaryDist.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== TODO deleted ===================================== @@ -1,9 +0,0 @@ -Things that might get done on this or another MR -[ ] Guarantee flags passed to configure are eventually passed to ghc-toolchain (like CFLAGS=...) explicitly specified -[ ] Drop SettingsXXXX altogether, now we just have the toolchain (well, this goes with deleting a good part of configure) -[x] Readelf is only used to find cc link, that OK? -[-] In hadrian/src/Rules/Generate.hs, generateGhcPlatformH, factor out the query into an argument to chooseSetting, to deduplicate it -[ ] Get rid of all the ToolchainSettings in Hadrian still (e.g. settings-clang-command) -[ ] Write Note about dummy values in default.host.target -[x] Don't put default.*.targets on the root folder. -[x] The $$tooldir substitution didn't seem to be working when issued by hadrian. ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -216,7 +216,6 @@ bindistRules = do -- looking for the settings files. unless windowsHost $ removeFile (bindistFilesDir -/- "lib" -/- "settings") - removeFile (bindistFilesDir -/- "lib" -/- "settings") unless cross $ need ["docs"] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -54,7 +54,7 @@ data Target = Target -- GHC capabilities , tgtUnregisterised :: Bool , tgtTablesNextToCode :: Bool - -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping? + -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it -- C toolchain View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b268686c79b065d860651d2b0227e6e3c086ef62 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b268686c79b065d860651d2b0227e6e3c086ef62 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 18:04:49 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 17 Jul 2023 14:04:49 -0400 Subject: [Git][ghc/ghc][wip/int-index/release-notes-9.10] Initialize 9.10.1-notes.rst Message-ID: <64b582c176dcf_23a43db566c14904c@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/release-notes-9.10 at Glasgow Haskell Compiler / GHC Commits: 7603f6f4 by Vladislav Zavialov at 2023-07-17T20:04:26+02:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 2 changed files: - + docs/users_guide/9.10.1-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== docs/users_guide/9.10.1-notes.rst ===================================== @@ -0,0 +1,75 @@ +.. _release-9-10-1: + +Version 9.10.1 +============== + +Language +~~~~~~~~ + +Compiler +~~~~~~~~ + +GHCi +~~~~ + +Runtime system +~~~~~~~~~~~~~~ + +``base`` library +~~~~~~~~~~~~~~~~ + +``ghc-prim`` library +~~~~~~~~~~~~~~~~~~~~ + +``ghc`` library +~~~~~~~~~~~~~~~ + +``ghc-heap`` library +~~~~~~~~~~~~~~~~~~~~ + +``template-haskell`` library +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Included libraries +~~~~~~~~~~~~~~~~~~ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/release-notes.rst ===================================== @@ -4,4 +4,4 @@ Release notes .. toctree:: :maxdepth: 1 - 9.8.1-notes + 9.10.1-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7603f6f49a452aa8d274102e8ba7887f79a7563e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7603f6f49a452aa8d274102e8ba7887f79a7563e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 18:17:35 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 17 Jul 2023 14:17:35 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 31 commits: rnImports: var shouldn't import NoFldSelectors Message-ID: <64b585bf7d468_23a43db56f81730d1@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 68da029c by Apoorv Ingle at 2023-07-17T13:17:18-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 045558ac by Apoorv Ingle at 2023-07-17T13:17:18-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 566b1640 by Apoorv Ingle at 2023-07-17T13:17:18-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - 67ed415a by Apoorv Ingle at 2023-07-17T13:17:18-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - 84aa67eb by Apoorv Ingle at 2023-07-17T13:17:18-05:00 trying out changes to heralds - - - - - f3cda4d9 by Apoorv Ingle at 2023-07-17T13:17:18-05:00 add location information for last statements - - - - - 111ebde8 by Apoorv Ingle at 2023-07-17T13:17:19-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - 314f31e7 by Apoorv Ingle at 2023-07-17T13:17:19-05:00 adjusting the generated spans for proper error messages - - - - - 20983da6 by Apoorv Ingle at 2023-07-17T13:17:19-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - f0ede291 by Apoorv Ingle at 2023-07-17T13:17:19-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - a415cac3 by Apoorv Ingle at 2023-07-17T13:17:19-05:00 - addStmtCtxt to add the right statement context in the error contexts - expansion stmt to span over bind/>>= application and pattern rather than only the arguments - - - - - d7b33b6f by Apoorv Ingle at 2023-07-17T13:17:19-05:00 add stmt context in tcApp rather other places - - - - - 82eabd93 by Apoorv Ingle at 2023-07-17T13:17:19-05:00 add the correct expression context in tcApp - - - - - 47368958 by Apoorv Ingle at 2023-07-17T13:17:19-05:00 disable expansion if applicative do is enabled - - - - - 598b000f by Apoorv Ingle at 2023-07-17T13:17:19-05:00 handle a special in desugaring when a do block has only one statment, the ds location should be set to that of the last statement - - - - - 6f31c23a by Apoorv Ingle at 2023-07-17T13:17:19-05:00 do not add argument context if it is a do statement - - - - - f9a8dda2 by Apoorv Ingle at 2023-07-17T13:17:20-05:00 remove applicative do expansion - - - - - 21f16f38 by Apoorv Ingle at 2023-07-17T13:17:20-05:00 add context of first do statement in addArgCtxt, somehow it goes missing - - - - - c196f1e6 by Apoorv Ingle at 2023-07-17T13:17:20-05:00 add the argument location in error ctxt if it is the first argument of a >> or a >>= - - - - - 8173aafa by Apoorv Ingle at 2023-07-17T13:17:20-05:00 - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - - - - - 791e4d93 by Apoorv Ingle at 2023-07-17T13:17:20-05:00 some cleanup needed - - - - - a5f58560 by Apoorv Ingle at 2023-07-17T13:17:20-05:00 - VAExpansionStmt doesn't need srcloc - fix the ppr function for XExprs - - - - - 12419b76 by Apoorv Ingle at 2023-07-17T13:17:20-05:00 - Blame the binding body but keep the error context about the statement in addArgCtxt - - - - - 334a4f1c by Apoorv Ingle at 2023-07-17T13:17:20-05:00 - fix the location displayed for the errors that crop up during type checking LetStmt - - - - - 2eda971b by Apoorv Ingle at 2023-07-17T13:17:20-05:00 Add the statement context in addHeadCtxt - - - - - 3aeaa3f3 by Apoorv Ingle at 2023-07-17T13:17:20-05:00 make sure user >> and generated >> have appropriate error messages - - - - - 9c2243e8 by Apoorv Ingle at 2023-07-17T13:17:21-05:00 - aligning expand stmt context pushing on error stack. - - - - - 86a23730 by Apoorv Ingle at 2023-07-17T13:17:21-05:00 - handing type checking expanded let statements in do block - handling type checking last statements in do block - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9550f631dca4fd38643124de63cbbce820508788...86a237307a8801d46651f1c72363ff92a364b772 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9550f631dca4fd38643124de63cbbce820508788...86a237307a8801d46651f1c72363ff92a364b772 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 18:36:59 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 14:36:59 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Address review Message-ID: <64b58a4b225ef_23a43db552c1955c4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c1915aec by Rodrigo Mesquita at 2023-07-17T19:36:49+01:00 Address review - - - - - 3 changed files: - − TODO - hadrian/src/Rules/BinaryDist.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs Changes: ===================================== TODO deleted ===================================== @@ -1,9 +0,0 @@ -Things that might get done on this or another MR -[ ] Guarantee flags passed to configure are eventually passed to ghc-toolchain (like CFLAGS=...) explicitly specified -[ ] Drop SettingsXXXX altogether, now we just have the toolchain (well, this goes with deleting a good part of configure) -[x] Readelf is only used to find cc link, that OK? -[-] In hadrian/src/Rules/Generate.hs, generateGhcPlatformH, factor out the query into an argument to chooseSetting, to deduplicate it -[ ] Get rid of all the ToolchainSettings in Hadrian still (e.g. settings-clang-command) -[ ] Write Note about dummy values in default.host.target -[x] Don't put default.*.targets on the root folder. -[x] The $$tooldir substitution didn't seem to be working when issued by hadrian. ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -216,7 +216,6 @@ bindistRules = do -- looking for the settings files. unless windowsHost $ removeFile (bindistFilesDir -/- "lib" -/- "settings") - removeFile (bindistFilesDir -/- "lib" -/- "settings") unless cross $ need ["docs"] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -22,22 +22,20 @@ data WordSize = WS4 | WS8 data Endianness = LittleEndian | BigEndian deriving (Show, Read, Eq, Ord) --- ROMES:TODO: A target might also need --- * Llc command --- * Opt command --- * DistroMinGW? -- no, this should be configured with existing flags to point to the bindist mingw --- * Install_name_tool --- * Touch cmd +-- TODO(#23674): Move the remaining relevant `settings-xxx` to Target: +-- * llc command +-- * opt command +-- * install_name_tool -- * otool command -- --- Which are things that are put in GHC's settings, which might be different across targets +-- Those are all things that are put into GHC's settings, and that might be +-- different across targets -- | A 'Target' consists of: -- -- * a target architecture and operating system -- * various bits of information about the platform -- * various toolchain components targetting that platform --- data Target = Target { -- Platform tgtArchOs :: ArchOS @@ -54,8 +52,9 @@ data Target = Target -- GHC capabilities , tgtUnregisterised :: Bool , tgtTablesNextToCode :: Bool - -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping? - , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it + -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping + , tgtUseLibffiForAdjustors :: Bool + -- ^ We need to know whether or not to include libffi headers, and generate additional code for it -- C toolchain , tgtCCompiler :: Cc @@ -64,9 +63,11 @@ data Target = Target , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink , tgtAr :: Ar - , tgtRanlib :: Maybe Ranlib -- ^ N.B. Most @ar@ implementations will add an index by default without @ranlib@ so this is often optional + , tgtRanlib :: Maybe Ranlib + -- ^ N.B. Most @ar@ implementations will add an index by default without @ranlib@ so this is often optional , tgtNm :: Nm - , tgtMergeObjs :: Maybe MergeObjs -- We don't need a merge objects tool if we @Ar@ supports @-L@ + , tgtMergeObjs :: Maybe MergeObjs + -- ^ We don't need a merge objects tool if we @Ar@ supports @-L@ -- Windows-specific tools , tgtWindres :: Maybe Program View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1915aec7579eceee293e5b35dd7896bda982373 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1915aec7579eceee293e5b35dd7896bda982373 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 19:35:22 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 15:35:22 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Address review Message-ID: <64b597fa8785f_23a43db56f82255bc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5d6039a1 by Rodrigo Mesquita at 2023-07-17T20:34:34+01:00 Address review Apply 10 suggestion(s) to 4 file(s) Address review - - - - - 8 changed files: - − TODO - hadrian/src/Rules/Generate.hs - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== TODO deleted ===================================== @@ -1,9 +0,0 @@ -Things that might get done on this or another MR -[ ] Guarantee flags passed to configure are eventually passed to ghc-toolchain (like CFLAGS=...) explicitly specified -[ ] Drop SettingsXXXX altogether, now we just have the toolchain (well, this goes with deleting a good part of configure) -[x] Readelf is only used to find cc link, that OK? -[-] In hadrian/src/Rules/Generate.hs, generateGhcPlatformH, factor out the query into an argument to chooseSetting, to deduplicate it -[ ] Get rid of all the ToolchainSettings in Hadrian still (e.g. settings-clang-command) -[ ] Write Note about dummy values in default.host.target -[x] Don't put default.*.targets on the root folder. -[x] The $$tooldir substitution didn't seem to be working when issued by hadrian. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -532,7 +532,7 @@ generateSettings = do mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) . tgtMergeObjs -- Like @'queryTarget'@ specialized to String, but replace occurrences of - -- @topDirectory inplace/mingw@ with @$$tooldir/mingw@ in the resulting string + -- @topDirectory inplace/mingw@ with @$tooldir/mingw@ in the resulting string -- -- See Note [How we configure the bundled windows toolchain] queryTarget' :: (Toolchain.Target -> String) -> Expr String ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -76,7 +76,7 @@ emptyOpts = Opts , optUnregisterised = Nothing , optTablesNextToCode = Nothing , optUseLibFFIForAdjustors = Nothing - , optLdOverride = Nothing -- See comment in Link on 'enableOverride'. Shouldn't we set the default here? + , optLdOverride = Nothing , optVerbosity = 1 , optKeepTemp = False } @@ -180,7 +180,7 @@ options = ] tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple) "TRIPLE") "Target triple" - llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVMTRIPLE") "LLVM Target triple" + llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVM-TRIPLE") "LLVM Target triple" targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX") "A target prefix which will be added to all tool names when searching for toolchain components" @@ -299,8 +299,9 @@ determineUseLibFFIForAdjustors archOs mb = checking "whether to use libffi for a pure True _ -> -- If don't have a native adjustor implementation we use libffi - pure (not . archHasNativeAdjustors $ archOS_arch archOs) -- If we + pure (not . archHasNativeAdjustors $ archOS_arch archOs) +-- | Do we implement a native adjustor implementation (i.e. found in @rts/adjustors@) for this 'Arch'? archHasNativeAdjustors :: Arch -> Bool archHasNativeAdjustors = \case ArchX86 -> True @@ -319,7 +320,7 @@ mkTarget opts = do (archOs, tgtVendor) <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) - ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (optLdOverride opts) archOs cc readelf + ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (fromMaybe True (optLdOverride opts)) archOs cc readelf ar <- findAr tgtVendor (optAr opts) -- TODO: We could have @@ -333,7 +334,7 @@ mkTarget opts = do mergeObjs <- optional $ findMergeObjs (optMergeObjs opts) cc ccLink nm when (isNothing mergeObjs && not (arSupportsDashL ar)) $ - throwE "Neither a merge object tool nor an ar that supports -L is available" + throwE "Neither a object-merging tool (e.g. ld -r) nor an ar that supports -L is available" -- Windows-specific utilities windres <- @@ -377,9 +378,6 @@ mkTarget opts = do , tgtRanlib = ranlib , tgtNm = nm , tgtMergeObjs = mergeObjs - -- ROMES:TODO: Unfortunately these two don't yet mimic the - -- logic in m4/fp_settings.m4 for windows variables - -- In particular , tgtWindres = windres , tgtWordSize , tgtEndianness ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Monad.hs ===================================== @@ -85,7 +85,6 @@ checking what k = do logInfo $ "checking " ++ what ++ "..." r <- withLogContext ("checking " ++ what) k logInfo $ "found " ++ what ++ ": " ++ show r - -- ROMES:TODO: Otherwise print errors return r logDebug :: String -> M () @@ -104,7 +103,7 @@ logMsg v msg = do readFile :: FilePath -> M String readFile path = liftIO $ T.unpack <$> T.readFile path -- Use T.readfile to read the file strictly, or otherwise run - -- into bugs (in practice on windows)! + -- into file locking bugs on Windows writeFile :: FilePath -> String -> M () writeFile path s = liftIO $ Prelude.writeFile path s @@ -112,17 +111,11 @@ writeFile path s = liftIO $ Prelude.writeFile path s appendFile :: FilePath -> String -> M () appendFile path s = liftIO $ Prelude.appendFile path s --- copyFile :: FilePath -- ^ Source file --- -> FilePath -- ^ Destination file --- -> M () --- copyFile src dst = liftIO $ System.Directory.copyFile src dst - -- | Create an empty file. createFile :: FilePath -> M () createFile path = writeFile path "" --- | Branch on whether we're cross-compiling, that is, if the Target we're --- producing differs from the platform we're producing it on. +-- | Branch on whether we can execute target code locally. ifCrossCompiling :: M a -- ^ what to do when cross-compiling -> M a -- ^ what to do otherwise ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -71,7 +71,8 @@ readProgram prog args = do logExecute prog args liftIO $ readProcessWithExitCode (prgPath prog) (prgFlags prog ++ args) "" --- | Runs a program with a list of arguments and returns the stdout output +-- | Runs a program with a list of arguments and returns the stdout output, +-- ignoring the exit code. readProgramStdout :: Program -> [String] -> M String readProgramStdout prog args = do logExecute prog args @@ -140,7 +141,7 @@ findProgram description userSpec candidates -- -- The compiler must -- * Take the program path as a positional argument --- * Accept -o to specify output path +-- * Accept @-o@ to specify output path compile :: FilePath -- ^ input extension -> [String] -- ^ extra flags @@ -155,14 +156,14 @@ compile ext extraFlags lens c outPath program = do callProgram (view lens c) $ extraFlags ++ ["-o", outPath, srcPath] expectFileExists outPath "compiler produced no output" --- Does compiler program support the --target= option? If so, we should +-- | Does compiler program support the @--target=@ option? If so, we should -- pass it whenever possible to avoid ambiguity and potential compile-time -- errors (e.g. see #20162). supportsTarget :: Lens compiler Program - -> (compiler -> M ()) -- ^ Action to check if compiler with --target flag works - -> String -- ^ The llvm target to use if Cc supports --target - -> compiler -- ^ The compiler to check --target support for - -> M compiler -- ^ Return compiler with --target flag if supported + -> (compiler -> M ()) -- ^ Action to check if compiler with @--target@ flag works + -> String -- ^ The LLVM target to use if @cc@ supports @--target@ + -> compiler -- ^ The compiler to check @--target@ support for + -> M compiler -- ^ Return compiler with @--target@ flag if supported supportsTarget lens checkWorks llvmTarget c -- TODO: #23603 | any ("--target=" `isPrefixOf`) (view (lens % _prgFlags) c) = return c ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -22,22 +22,20 @@ data WordSize = WS4 | WS8 data Endianness = LittleEndian | BigEndian deriving (Show, Read, Eq, Ord) --- ROMES:TODO: A target might also need --- * Llc command --- * Opt command --- * DistroMinGW? -- no, this should be configured with existing flags to point to the bindist mingw --- * Install_name_tool --- * Touch cmd +-- TODO(#23674): Move the remaining relevant `settings-xxx` to Target: +-- * llc command +-- * opt command +-- * install_name_tool -- * otool command -- --- Which are things that are put in GHC's settings, which might be different across targets +-- Those are all things that are put into GHC's settings, and that might be +-- different across targets -- | A 'Target' consists of: -- -- * a target architecture and operating system -- * various bits of information about the platform -- * various toolchain components targetting that platform --- data Target = Target { -- Platform tgtArchOs :: ArchOS @@ -54,8 +52,9 @@ data Target = Target -- GHC capabilities , tgtUnregisterised :: Bool , tgtTablesNextToCode :: Bool - -- , tgtHasThreadedRts :: Bool -- Do we need this for each target? Or just when bootstrapping? - , tgtUseLibffiForAdjustors :: Bool -- We need to know whether or not to include libffi headers, and generate additional code for it + -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping + , tgtUseLibffiForAdjustors :: Bool + -- ^ We need to know whether or not to include libffi headers, and generate additional code for it -- C toolchain , tgtCCompiler :: Cc @@ -64,9 +63,11 @@ data Target = Target , tgtHsCPreprocessor :: HsCpp , tgtCCompilerLink :: CcLink , tgtAr :: Ar - , tgtRanlib :: Maybe Ranlib -- Most ar implementations do good things by default without ranlib so don't need it + , tgtRanlib :: Maybe Ranlib + -- ^ N.B. Most @ar@ implementations will add an index by default without @ranlib@ so this is often optional , tgtNm :: Nm - , tgtMergeObjs :: Maybe MergeObjs -- We don't need a merge objects tool if we @Ar@ supports @-L@ + , tgtMergeObjs :: Maybe MergeObjs + -- ^ We don't need a merge objects tool if we @Ar@ supports @-L@ -- Windows-specific tools , tgtWindres :: Maybe Program ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -39,8 +39,12 @@ findCc llvmTarget progOpt = checking "for C compiler" $ do -- there's a more optimal one ccProgram' <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] - -- we inline the is-windows check here because we need Cc to call parseTriple + -- FIXME: This is a dreadful hack! + -- In reality, configure should pass these options to ghc-toolchain when + -- using the bundled windows toolchain, and ghc-toolchain should drop this around. + -- See #23678 let ccProgram = if "mingw32" `isInfixOf` llvmTarget && takeBaseName (prgPath ccProgram') == "clang" + -- we inline the is-windows check here because we need Cc to call parseTriple then -- Signal that we are linking against UCRT with the _UCRT macro. This is -- necessary on windows clang to ensure correct behavior when ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -19,10 +19,10 @@ import GHC.Toolchain.Tools.Readelf -- | Configuration on how the C compiler can be used to link data CcLink = CcLink { ccLinkProgram :: Program - , ccLinkSupportsNoPie :: Bool -- Does have to be a separate settings. Sometimes we do want to use PIE - , ccLinkSupportsCompactUnwind :: Bool -- Argument to be made about this being part of the cclink flags - , ccLinkSupportsFilelist :: Bool -- This too - , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC + , ccLinkSupportsNoPie :: Bool -- See Note [No PIE when linking] in GHC.Driver.Session + , ccLinkSupportsCompactUnwind :: Bool + , ccLinkSupportsFilelist :: Bool + , ccLinkIsGnu :: Bool } deriving (Read, Eq, Ord) @@ -42,7 +42,9 @@ _ccLinkProgram :: Lens CcLink Program _ccLinkProgram = Lens ccLinkProgram (\x o -> o{ccLinkProgram=x}) findCcLink :: String -- ^ The llvm target to use if CcLink supports --target - -> ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink + -> ProgOpt + -> Bool -- ^ Whether we should search for a more efficient linker + -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do -- Use the specified linker or try to find one rawCcLink <- findProgram "C compiler for linking" progOpt [takeFileName $ prgPath $ ccProgram cc] @@ -68,8 +70,8 @@ findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compile -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ -findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program -findLinkFlags ldOverride cc ccLink +findLinkFlags :: Bool -> Cc -> Program -> M Program +findLinkFlags enableOverride cc ccLink | enableOverride && doLinkerSearch = oneOf "this can't happen" [ -- Annoyingly, gcc silently falls back to vanilla ld (typically bfd @@ -84,13 +86,6 @@ findLinkFlags ldOverride cc ccLink <|> (ccLink <$ checkLinkWorks cc ccLink) | otherwise = return ccLink - where - enableOverride = case ldOverride of - -- ROMES: We're basically defining the default value here, - -- wouldn't it be better to define the default on construction? - Nothing -> True - Just True -> True - Just False -> False linkSupportsTarget :: Cc -> String -> Program -> M Program linkSupportsTarget cc target link @@ -111,6 +106,7 @@ doLinkerSearch = True doLinkerSearch = False #endif +-- | See Note [No PIE when linking] in GHC.Driver.Session checkSupportsNoPie :: Program -> M Bool checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ withTempDir $ \dir -> do @@ -120,8 +116,8 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ let test = dir "test" -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. - (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - return (isSuccess code && not ("unrecognized" `isInfixOf` out)) + (code, out, err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] + return (isSuccess code && not ("unrecognized" `isInfixOf` out) && not ("unrecognized" `isInfixOf` err)) -- ROMES:TODO: This check is wrong here and in configure because with ld.gold parses "-n" "o_compact_unwind" -- TODO: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d6039a1170ce5889420b0f252153d87845cc862 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d6039a1170ce5889420b0f252153d87845cc862 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 19:45:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 15:45:43 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ghc-toolchain: Toolchain Selection Message-ID: <64b59a67652b3_23a43db5888231944@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 102316ef by Rodrigo Mesquita at 2023-07-17T20:43:52+01:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - 47576085 by Rodrigo Mesquita at 2023-07-17T20:45:32+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - + hadrian/cfg/default.host.target.in - + hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/Common.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d6039a1170ce5889420b0f252153d87845cc862...475760858e0eb932195bda495a285f40a6853153 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5d6039a1170ce5889420b0f252153d87845cc862...475760858e0eb932195bda495a285f40a6853153 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 20:01:36 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 16:01:36 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ghc-toolchain: Toolchain Selection Message-ID: <64b59e2065211_23a43db566c236258@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: e44f1758 by Rodrigo Mesquita at 2023-07-17T21:01:27+01:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - f565c8cf by Rodrigo Mesquita at 2023-07-17T21:01:27+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - + hadrian/cfg/default.host.target.in - + hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/Common.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/475760858e0eb932195bda495a285f40a6853153...f565c8cf86cb29c4c4c1072bbf6ff329f1a61f9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/475760858e0eb932195bda495a285f40a6853153...f565c8cf86cb29c4c4c1072bbf6ff329f1a61f9c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 20:30:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 16:30:48 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] The dreadful note I'll silently squash Message-ID: <64b5a4f7f1570_23a43db56f8247416@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 72c5977c by Rodrigo Mesquita at 2023-07-17T21:30:39+01:00 The dreadful note I'll silently squash - - - - - 2 changed files: - hadrian/src/Settings.hs - m4/ghc_toolchain.m4 Changes: ===================================== hadrian/src/Settings.hs ===================================== @@ -111,6 +111,10 @@ unsafeFindPackageByPath path = err $ find (\pkg -> pkgPath pkg == path) knownPac err = fromMaybe $ error ("findPackageByPath: No package for path " ++ path) -- * Combinators for querying configuration defined in the toolchain +-- +-- Be careful querying values from the HOST and BUILD targets until the targets +-- are only generated by ghc-toolchain: +-- See Note [The dummy values in the HOST target description] queryBuild, queryHost, queryTarget :: (Target -> a) -> Expr a queryBuild f = expr $ queryBuildTarget f queryHost f = expr $ queryHostTarget f ===================================== m4/ghc_toolchain.m4 ===================================== @@ -57,8 +57,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--cc-link=$CC_STAGE0" >> acargs echo "--ar=$AR_STAGE0" >> acargs dnl The remaining tools we don't configure for the host. - - echo "ACARGS-HOST" + dnl See Note [The dummy values in the HOST target description] INVOKE_GHC_TOOLCHAIN() @@ -95,22 +94,10 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) - echo "ACARGS-TARGET" - INVOKE_GHC_TOOLCHAIN() rm -Rf acargs acghc-toolchain actmp-ghc-toolchain - dnl ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) - dnl ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) - dnl ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) - dnl ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$CONF_CXX_OPTS_STAGE1]) - dnl ADD_GHC_TOOLCHAIN_ARG([ar-opt], [$ARFLAGS]) - dnl ADD_GHC_TOOLCHAIN_ARG([ranlib-opt], [$RANLIBFLAGS]) - dnl ADD_GHC_TOOLCHAIN_ARG([nm-opt], [$NMFLAGS]) - dnl ADD_GHC_TOOLCHAIN_ARG([readelf-opt], [$READELFFLAGS]) - dnl ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - dnl Note: if we weren't passing the paths to the programs explicitly, to make dnl ghc-toolchain use the bundled windows toolchain, simply add it to the search PATH ]) @@ -149,3 +136,22 @@ AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ ]) fi ]) + +dnl Note [The dummy values in the HOST target description] +dnl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +dnl In configure, we don't configure nearly as much tools for +dnl the HOST toolchain as we do for the TARGET toolchain. This is because +dnl Hadrian only depends on certain properties and tools of the HOST toolchain, +dnl and, ultimately, the shipped GHC has in `settings` the TARGET toolchain and +dnl properties. (In constrast, ghc-toolchain can as easily configure 1 +dnl toolchain as it can 100) +dnl +dnl Unfortunately, we need to produce a valid Target value to write to default.host.target. +dnl Since we don't configure the values required to substitute into the +dnl toolchain, we simply use /dummy/ values, as conservatively as possible. +dnl Regardless of the conservative values, we assume that hadrian will never +dnl look at these settings, as they previously didn't exist. +dnl +dnl In practice, Hadrian should only access the *_STAGE0 settings that were +dnl available before the ghc-toolchain: Toolchain Selection commit. + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72c5977cb53a2abc3f3440e78e6dc53daa98ca57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/72c5977cb53a2abc3f3440e78e6dc53daa98ca57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 20:34:14 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 16:34:14 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ghc-toolchain: Toolchain Selection Message-ID: <64b5a5c633b7c_23a43db58882500a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7f3b5987 by Rodrigo Mesquita at 2023-07-17T21:33:55+01:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - aebfe1bf by Rodrigo Mesquita at 2023-07-17T21:33:55+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - + hadrian/cfg/default.host.target.in - + hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/Common.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72c5977cb53a2abc3f3440e78e6dc53daa98ca57...aebfe1bf41d809b2cbc5d16d7a5053c818c6af41 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72c5977cb53a2abc3f3440e78e6dc53daa98ca57...aebfe1bf41d809b2cbc5d16d7a5053c818c6af41 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 21:32:55 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Mon, 17 Jul 2023 17:32:55 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 33 commits: Equality of forall-types is visibility aware Message-ID: <64b5b387eae39_23a43db55402508ab@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - d328cb00 by Alan Zimmerman at 2023-07-17T17:55:25+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 0c4e5953 by Alan Zimmerman at 2023-07-17T18:03:17+01:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - dc6127a5 by Alan Zimmerman at 2023-07-17T18:12:24+01:00 Summary: epa-improve-comb4-5 Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-27 23:08:05 +0100 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 885702cc by Alan Zimmerman at 2023-07-17T20:36:47+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - 5b7a0a1f by Alan Zimmerman at 2023-07-17T20:36:53+01:00 Summary: EPA make getLocA a synonym for getHasLoc Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-16 09:25:10 +0100 EPA make getLocA a synonym for getHasLoc - - - - - 266ed2b4 by Alan Zimmerman at 2023-07-17T20:46:35+01:00 EPA: Fix span for GRHS - - - - - 1846be0a by Alan Zimmerman at 2023-07-17T21:40:14+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 8fb7a663 by Alan Zimmerman at 2023-07-17T21:46:22+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 1a117f37 by Alan Zimmerman at 2023-07-17T21:46:29+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 235cb951 by Alan Zimmerman at 2023-07-17T21:46:29+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 7d8652dc by Alan Zimmerman at 2023-07-17T21:46:29+01:00 WIP - - - - - 99129e91 by Alan Zimmerman at 2023-07-17T21:46:29+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 5d6ff670 by Alan Zimmerman at 2023-07-17T21:46:29+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 50827219 by Alan Zimmerman at 2023-07-17T21:46:29+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] - - - - - 475ce32b by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 1c9c062f by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 0aa8a500 by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: More extending anchors to full span in Parser.y - - - - - 8fb7dad6 by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - ed88b0a1 by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: Fix simple tests - - - - - f9507c9d by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 56bb7f32 by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 92f2e12c by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: deal with fallout from getMonoBind - - - - - b732e004 by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA fix captureLineSpacing - - - - - f1811bdc by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA print any comments in the span before exiting it - - - - - a297a648 by Alan Zimmerman at 2023-07-17T21:46:30+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - c243e62e by Alan Zimmerman at 2023-07-17T22:31:13+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/220903519e0ab34b8903fc13039037e0b3721070...c243e62ebd1ac44f332d0538e3273cf2de8ae80c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/220903519e0ab34b8903fc13039037e0b3721070...c243e62ebd1ac44f332d0538e3273cf2de8ae80c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 23:29:33 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 17 Jul 2023 19:29:33 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/int-index/vdq-with-coercions Message-ID: <64b5cedd96dbb_23a43db55402636f6@gitlab.mail> Vladislav Zavialov deleted branch wip/int-index/vdq-with-coercions at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 17 23:29:41 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 17 Jul 2023 19:29:41 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/int-index/vis-flag-tests Message-ID: <64b5cee5c0732_23a43db56582638e6@gitlab.mail> Vladislav Zavialov deleted branch wip/int-index/vis-flag-tests at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 00:52:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 20:52:04 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable Message-ID: <64b5e234d368c_23a43db565828745e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: fcfa2444 by Rodrigo Mesquita at 2023-07-18T01:51:52+01:00 Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable - - - - - 3 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -1,8 +1,7 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} module GHC.Core.Equality where @@ -12,28 +11,24 @@ module GHC.Core.Equality where -- than this for equality. -- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) -import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude import GHC.Core import GHC.Core.TyCo.Rep import GHC.Core.Map.Type -import GHC.Core.Map.Expr import GHC.Types.Var import GHC.Types.Literal import GHC.Types.Tickish -import Unsafe.Coerce (unsafeCoerce) -import Control.Monad.Trans.State.Strict (state) import Data.Equality.Graph as EG import Data.Equality.Analysis import qualified Data.Equality.Graph.Monad as EGM -import Data.Equality.Utils (Fix(..)) - -import GHC.Utils.Misc (all2) import GHC.Utils.Outputable import GHC.Core.Coercion (coercionType) +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader + -- Important to note the binders are also represented by $a$ -- This is because in the e-graph we will represent binders with the -- equivalence class id of things equivalent to it. @@ -41,300 +36,386 @@ import GHC.Core.Coercion (coercionType) -- Unfortunately type binders are still not correctly accounted for. -- Perhaps it'd really be better to make DeBruijn work over these types -data AltF b a - = AltF AltCon [b] a - deriving (Functor, Foldable, Traversable) +-- In the pattern match checker, expressions will always be kind of shallow. +-- In practice, no-one writes gigantic lambda expressions + +data AltF a + = AltF AltCon [()] a + deriving (Functor, Foldable, Traversable, Eq, Ord) -data BindF b a - = NonRecF b a - | RecF [(b, a)] - deriving (Functor, Foldable, Traversable) +data BindF a + = NonRecF a + | RecF [a] + deriving (Functor, Foldable, Traversable, Eq, Ord, Show) -data ExprF b a - = VarF Id +type BoundVar = Int +data ExprF a + = VarF BoundVar + | FreeVarF Id | LitF Literal | AppF a a - | LamF b a - | LetF (BindF b a) a - | CaseF a b Type [AltF b a] - - | CastF a CoercionR - | TickF CoreTickish a - | TypeF Type - | CoercionF Coercion - deriving (Functor, Foldable, Traversable) + | LamF a + | LetF (BindF a) a + | CaseF a [AltF a] -- can we drop the case type for expr equality? we don't need them back, we just need to check equality. (perhaps this specialization makes this more suitable in the Pmc namespace) + + -- | CastF a (DeBruijn CoercionR) -- can we drop this + -- | TickF CoreTickish a -- this, when representing expressions for equality? + -- but it'll be pretty hard to trigger any bug related to equality matching wrt coercions and casts on view patterns solely + | TypeF DBType + | CoercionF DBCoercion + deriving (Functor, Foldable, Traversable, Eq, Ord) + +newtype DBType = DBT (DeBruijn Type) deriving Eq +instance Ord DBType where + compare (DBT dt) (DBT dt') = cmpDeBruijnType dt dt' +newtype DBCoercion = DBC (DeBruijn Coercion) deriving Eq +instance Ord DBCoercion where + compare (DBC dt) (DBC dt') = cmpDeBruijnCoercion dt dt' + + +-- this makes perfect sense, if we already have to represent this in the e-graph +-- we might as well make it a better suited representation for the e-graph... +-- keeping the on-fly debruijn makes no sense +representCoreExprEgr :: forall a + . Analysis a CoreExprF + => CoreExpr + -> EGraph a CoreExprF + -> (ClassId, EGraph a CoreExprF) +representCoreExprEgr expr egr = EGM.runEGraphM egr (runReaderT (go expr) emptyCME) where + go :: CoreExpr -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + go = \case + Var v -> do + env <- ask + case lookupCME env v of + Nothing -> addE (FreeVarF v) + Just i -> addE (VarF i) + Lit lit -> addE (LitF lit) + Type t -> addE (TypeF (DBT $ deBruijnize t)) + Coercion c -> addE (CoercionF (DBC $ deBruijnize c)) + Tick _ e -> go e -- bypass ticks! + Cast e _ -> go e -- bypass casts! ouch? + App f a -> do + f' <- go f + a' <- go a + addE (AppF f' a') + Lam b e -> do + e' <- local (`extendCME` b) $ go e + addE (LamF e') + Let (NonRec v r) e -> do + r' <- go r + e' <- local (`extendCME` v) $ go e + addE (LetF (NonRecF r') e') + Let (Rec (unzip -> (bs,rs))) e -> do + rs' <- traverse (local (`extendCMEs` bs) . go) rs + e' <- local (`extendCMEs` bs) $ go e + addE (LetF (RecF rs') e') + Case e b _t as -> do + e' <- go e + as' <- traverse (local (`extendCME` b) . goAlt) as + addE (CaseF e' as') + + goAlt :: CoreAlt -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) (CoreAltF ClassId) + goAlt (Alt c bs e) = do + e' <- local (`extendCMEs` bs) $ go e + return (AltF c (map (const ()) bs) e') + + addE :: Analysis a CoreExprF => CoreExprF ClassId -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + addE e = lift $ EGM.add $ Node e +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 type CoreExprF - = ExprF CoreBndr + = ExprF type CoreAltF - = AltF CoreBndr + = AltF type CoreBindF - = BindF CoreBndr - -newtype DeBruijnF f a = DF (DeBruijn (f a)) - deriving (Functor, Foldable, Traversable) - -eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool -eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where - go :: CoreExprF a -> CoreExprF a -> Bool - go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) - go (LitF lit1) (LitF lit2) = lit1 == lit2 - go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) - -- See Note [Alpha-equality for Coercion arguments] - go (CoercionF {}) (CoercionF {}) = True - go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 - go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 - go (TickF n1 e1) (TickF n2 e2) - = eqDeBruijnTickish (D env1 n1) (D env2 n2) - && e1 == e2 - - go (LamF b1 e1) (LamF b2 e2) - = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) - && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) - && e1 == e2 - - go (LetF abs e1) (LetF bbs e2) - = D env1 abs == D env2 bbs - && e1 == e2 - - go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) - | null a1 -- See Note [Empty case alternatives] - = null a2 && e1 == e2 && D env1 t1 == D env2 t2 - | otherwise - = e1 == e2 && D env1 a1 == D env2 a2 - - go _ _ = False - --- ROMES:TODO: This one can be derived automatically, but perhaps it's better --- to be explicit here? We don't even really require the DeBruijn context here -eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool -eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where - go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) - = rhs1 == rhs2 - go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) - = lit1 == lit2 && rhs1 == rhs2 - go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) - = dc1 == dc2 && - rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') - go _ _ = False - --- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. -fromCoreExpr :: CoreExpr -> Fix CoreExprF -fromCoreExpr = unsafeCoerce - -toCoreExpr :: CoreExpr -> Fix CoreExprF -toCoreExpr = unsafeCoerce - --- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented --- --- Always represent Ids, at least for now. We're seemingly using inexistent ids --- ROMES:TODO: do this all inside EGraphM instead -representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreExpr - -> EGraph a (DeBruijnF CoreExprF) - -> (ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBCoreExpr (D cmenv expr) eg0 = case expr of - Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 - Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 - Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 - Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 - Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (CastF eid co))) eg1 - App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 - (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 - in add (Node $ DF (D cmenv (AppF fid aid))) eg2 - Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (TickF n eid))) eg1 - Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 - in add (Node $ DF (D cmenv (LamF b eid))) eg1 - Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 - (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 - in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 - Let (Rec (unzip -> (bs,rs))) e -> - let cmenv' = extendCMEs cmenv bs - (bsids, eg1) = EGM.runEGraphM eg0 $ - traverse (state . representDBCoreExpr . D cmenv') rs - (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 - in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 - Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 - (as', eg2) = EGM.runEGraphM eg1 $ - traverse (state . representDBAltExpr . D (extendCME cmenv b)) as - in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 - -representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreAlt - -> EGraph a (DeBruijnF CoreExprF) - -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBAltExpr (D cm (Alt cons bs a)) eg0 = - let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 - in (AltF cons bs ai, eg1) - -instance Eq a => Eq (DeBruijn (CoreAltF a)) where - (==) = eqDeBruijnAltF - -instance Eq a => Eq (DeBruijn (CoreExprF a)) where - (==) = eqDeBruijnExprF - -instance Eq a => Eq (DeBruijnF CoreExprF a) where - (==) (DF a) (DF b) = eqDeBruijnExprF a b - -instance Eq a => Eq (DeBruijnF CoreAltF a) where - (==) (DF a) (DF b) = eqDeBruijnAltF a b - -deriving instance Ord a => Ord (DeBruijnF CoreExprF a) - -instance Ord a => Ord (DeBruijn (CoreExprF a)) where - -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. - -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? - -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. - -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? - -- So I think that just works... - -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... - compare a b - = case a of - D cma (VarF va) - -> case b of - D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) - _ -> LT - D _ (LitF la) - -> case b of - D _ VarF{} -> GT - D _ (LitF lb) -> la `compare` lb - _ -> LT - D _ (AppF af aarg) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 2#) then - LT - else - case b of - D _ (AppF bf barg) - -> case compare af bf of - LT -> LT - EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. - -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... - GT -> GT - _ -> GT - D _ (LamF _abind abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 3#) then - LT - else - case b of - D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') - -> compare abody bbody - _ -> GT - D cma (LetF as abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 4#) then - LT - else - case b of - D cmb (LetF bs bbody) - -> case compare (D cma as) (D cmb bs) of - LT -> LT - EQ -> compare abody bbody - GT -> GT - _ -> GT - D cma (CaseF cax _cabind catype caalt) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 5#) then - GT - else - case b of - D cmb (CaseF cbx _cbbind cbtype cbalt) - -> case compare cax cbx of - LT -> LT - -- ROMES:TODO: Consider changing order of comparisons to a more efficient one - EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of - LT -> LT - EQ -> D cma caalt `compare` D cmb cbalt - GT -> GT - GT -> GT - _ -> LT - D cma (CastF cax caco) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 6#) then - GT - else - case b of - D cmb (CastF cbx cbco) - -> case compare cax cbx of - LT -> LT - EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) - GT -> GT - _ -> LT - D cma (TickF tatickish tax) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 7#) then - GT - else - case b of - D cmb (TickF tbtickish tbx) - -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of - LT -> LT - EQ -> tax `compare` tbx - GT -> GT - _ -> LT - D cma (TypeF at) - -> case b of - D _ CoercionF{} -> LT - D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) - _ -> GT - D cma (CoercionF aco) - -> case b of - D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) - _ -> GT - -instance Eq a => Eq (DeBruijn (CoreBindF a)) where - D cma a == D cmb b = go a b where - go (NonRecF _v1 r1) (NonRecF _v2 r2) - = r1 == r2 -- See Note [Alpha-equality for let-bindings] - - go (RecF ps1) (RecF ps2) - = - -- See Note [Alpha-equality for let-bindings] - all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) - (D cmb (varType b2))) - bs1 bs2 - && rs1 == rs2 - where - (bs1,rs1) = unzip ps1 - (bs2,rs2) = unzip ps2 - - go _ _ = False - - -instance Ord a => Ord (DeBruijn (CoreBindF a)) where - compare a b - = case a of - D _cma (NonRecF _ab ax) - -> case b of - D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. - -> ax `compare` bx - _ -> LT - D _cma (RecF as) - -> case b of - D _cmb (RecF bs) -> compare (map snd as) (map snd bs) - _ -> GT - - -instance Ord a => Ord (DeBruijn (CoreAltF a)) where - compare a b - = case a of - D _cma (AltF ac _abs arhs) - -> case b of - D _cmb (AltF bc _bbs brhs) - -> case compare ac bc of - LT -> LT - EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. - arhs `compare` brhs - GT -> GT + = BindF + +--eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +--eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where +-- go :: CoreExprF a -> CoreExprF a -> Bool +-- go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) +-- go (LitF lit1) (LitF lit2) = lit1 == lit2 +-- go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) +-- -- See Note [Alpha-equality for Coercion arguments] +-- go (CoercionF {}) (CoercionF {}) = True +-- go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 +-- go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 +-- go (TickF n1 e1) (TickF n2 e2) +-- = eqDeBruijnTickish (D env1 n1) (D env2 n2) +-- && e1 == e2 + +-- go (LamF b1 e1) (LamF b2 e2) +-- = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) +-- && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) +-- && e1 == e2 + +-- go (LetF abs e1) (LetF bbs e2) +-- = D env1 abs == D env2 bbs +-- && e1 == e2 + +-- go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) +-- | null a1 -- See Note [Empty case alternatives] +-- = null a2 && e1 == e2 && D env1 t1 == D env2 t2 +-- | otherwise +-- = e1 == e2 && D env1 a1 == D env2 a2 + +-- go _ _ = False + +---- ROMES:TODO: This one can be derived automatically, but perhaps it's better +---- to be explicit here? We don't even really require the DeBruijn context here +--eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +--eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where +-- go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) +-- = rhs1 == rhs2 +-- go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) +-- = lit1 == lit2 && rhs1 == rhs2 +-- go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) +-- = dc1 == dc2 && +-- rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') +-- go _ _ = False + +---- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +--fromCoreExpr :: CoreExpr -> Fix CoreExprF +--fromCoreExpr = unsafeCoerce + +--toCoreExpr :: CoreExpr -> Fix CoreExprF +--toCoreExpr = unsafeCoerce + +---- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +---- +---- Always represent Ids, at least for now. We're seemingly using inexistent ids +---- ROMES:TODO: do this all inside EGraphM instead +--representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreExpr +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBCoreExpr (D cmenv expr) eg0 = case expr of +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 + +--representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreAlt +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBAltExpr (D cm (Alt cons bs a)) eg0 = +-- let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 +-- in (AltF cons bs ai, eg1) + +--instance Eq a => Eq (DeBruijn (CoreAltF a)) where +-- (==) = eqDeBruijnAltF + +--instance Eq a => Eq (DeBruijn (CoreExprF a)) where +-- (==) = eqDeBruijnExprF + +--instance Eq a => Eq (DeBruijnF CoreExprF a) where +-- (==) (DF a) (DF b) = eqDeBruijnExprF a b + +--instance Eq a => Eq (DeBruijnF CoreAltF a) where +-- (==) (DF a) (DF b) = eqDeBruijnAltF a b + +--deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +--instance Ord a => Ord (DeBruijn (CoreExprF a)) where +-- -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. +-- -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? +-- -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. +-- -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? +-- -- So I think that just works... +-- -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... +-- compare a b +-- = case a of +-- D cma (VarF va) +-- -> case b of +-- D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) +-- _ -> LT +-- D _ (LitF la) +-- -> case b of +-- D _ VarF{} -> GT +-- D _ (LitF lb) -> la `compare` lb +-- _ -> LT +-- D _ (AppF af aarg) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 2#) then +-- LT +-- else +-- case b of +-- D _ (AppF bf barg) +-- -> case compare af bf of +-- LT -> LT +-- EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. +-- -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... +-- GT -> GT +-- _ -> GT +-- D _ (LamF _abind abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 3#) then +-- LT +-- else +-- case b of +-- D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') +-- -> compare abody bbody +-- _ -> GT +-- D cma (LetF as abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 4#) then +-- LT +-- else +-- case b of +-- D cmb (LetF bs bbody) +-- -> case compare (D cma as) (D cmb bs) of +-- LT -> LT +-- EQ -> compare abody bbody +-- GT -> GT +-- _ -> GT +-- D cma (CaseF cax _cabind catype caalt) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 5#) then +-- GT +-- else +-- case b of +-- D cmb (CaseF cbx _cbbind cbtype cbalt) +-- -> case compare cax cbx of +-- LT -> LT +-- -- ROMES:TODO: Consider changing order of comparisons to a more efficient one +-- EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of +-- LT -> LT +-- EQ -> D cma caalt `compare` D cmb cbalt +-- GT -> GT +-- GT -> GT +-- _ -> LT +-- D cma (CastF cax caco) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 6#) then +-- GT +-- else +-- case b of +-- D cmb (CastF cbx cbco) +-- -> case compare cax cbx of +-- LT -> LT +-- EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) +-- GT -> GT +-- _ -> LT +-- D cma (TickF tatickish tax) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 7#) then +-- GT +-- else +-- case b of +-- D cmb (TickF tbtickish tbx) +-- -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of +-- LT -> LT +-- EQ -> tax `compare` tbx +-- GT -> GT +-- _ -> LT +-- D cma (TypeF at) +-- -> case b of +-- D _ CoercionF{} -> LT +-- D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) +-- _ -> GT +-- D cma (CoercionF aco) +-- -> case b of +-- D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) +-- _ -> GT + +--instance Eq a => Eq (DeBruijn (CoreBindF a)) where +-- D cma a == D cmb b = go a b where +-- go (NonRecF _v1 r1) (NonRecF _v2 r2) +-- = r1 == r2 -- See Note [Alpha-equality for let-bindings] + +-- go (RecF ps1) (RecF ps2) +-- = +-- -- See Note [Alpha-equality for let-bindings] +-- all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) +-- (D cmb (varType b2))) +-- bs1 bs2 +-- && rs1 == rs2 +-- where +-- (bs1,rs1) = unzip ps1 +-- (bs2,rs2) = unzip ps2 + +-- go _ _ = False + + +--instance Ord a => Ord (DeBruijn (CoreBindF a)) where +-- compare a b +-- = case a of +-- D _cma (NonRecF _ab ax) +-- -> case b of +-- D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. +-- -> ax `compare` bx +-- _ -> LT +-- D _cma (RecF as) +-- -> case b of +-- D _cmb (RecF bs) -> compare (map snd as) (map snd bs) +-- _ -> GT + + +--instance Ord a => Ord (DeBruijn (CoreAltF a)) where +-- compare a b +-- = case a of +-- D _cma (AltF ac _abs arhs) +-- -> case b of +-- D _cmb (AltF bc _bbs brhs) +-- -> case compare ac bc of +-- LT -> LT +-- EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. +-- arhs `compare` brhs +-- GT -> GT cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where @@ -359,26 +440,21 @@ cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering cmpDeBruijnCoercion (D env1 co1) (D env2 co2) = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) --- instances for debugging purposes -instance Show a => Show (DeBruijnF CoreExprF a) where - show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id - show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit - show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b - show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a - show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a - show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts - - show (DF (D _ (CastF _a _cor) )) = "CastF" - show (DF (D _ (TickF _cotick _a))) = "Tick" - show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t) - show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co - - -instance Show a => Show (BindF CoreBndr a) where - show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a - show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs) - -instance Show a => Show (AltF CoreBndr a) where +-- -- instances for debugging purposes +instance Show a => Show (CoreExprF a) where + show (VarF id) = showPprUnsafe $ text "VarF" <+> ppr id + show (FreeVarF id) = showPprUnsafe $ ppr id + show (LitF lit) = showPprUnsafe $ text "LitF" <+> ppr lit + show (AppF a b) = "AppF " ++ show a ++ " " ++ show b + show (LamF a) = "LamF " ++ show a + show (LetF b a) = "LetF " ++ show b ++ " " ++ show a + show (CaseF a alts) = "CaseF " ++ show a ++ show alts + + -- show (CastF _a _cor) = "CastF" + -- show (TickF _cotick _a) = "Tick" + show (TypeF (DBT (D _ t))) = "TypeF " ++ showPprUnsafe (ppr t) + show (CoercionF (DBC (D _ co))) = "CoercionF " ++ showPprUnsafe co + +instance Show a => Show (AltF a) where show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a - ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -738,7 +738,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} pure $ markDirty yid - $ nabla{nabla_tm_st = ts{ ts_facts = env & _class yid . _data .~ vi'}} + $ nabla{nabla_tm_st = ts{ ts_facts = env & _class yid . _data .~ Just vi'}} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -1022,7 +1022,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = - second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + second (\g -> nabla{nabla_tm_st = ts{ts_facts = EG.rebuild g}}) $ representCoreExprEgr (makeDictsCoherent e) egraph -- Use a key in which dictionaries for the same type become equal. -- See Note [Unique dictionaries in the TmOracle CoreMap] ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -173,7 +173,7 @@ data TmState lookupMatchIdMap :: Id -> Nabla -> Maybe ClassId lookupMatchIdMap id (MkNabla _ TmSt{ts_reps}) = lookupVarEnv ts_reps id --- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, +-- | Information about a match id. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set -- ('vi_rcm'). @@ -187,6 +187,9 @@ data VarInfo -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) + -- , vi_ty :: !Type + -- ^ The type of the match-id + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested @@ -333,8 +336,10 @@ emptyVarInfo x -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? lookupVarInfo :: TmState -> ClassId -> VarInfo lookupVarInfo (TmSt eg _ _) x +-- We used to only create an emptyVarInfo when we looked up that id. Now we do it always, even if we never query the Id back T_T -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. - = eg ^._class x._data + = undefined -- TODO: eg ^._class x._data + -- can we somehow here construct the var info? -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -359,7 +364,7 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of go _ = Nothing -- romes: We could probably inline this -trvVarInfo :: forall f a. Functor f => (VarInfo -> f (a,VarInfo)) -> Nabla -> ClassId -> f (a,Nabla) +trvVarInfo :: forall f a. Functor f => (Maybe VarInfo -> f (a,Maybe VarInfo)) -> Nabla -> ClassId -> f (a,Nabla) trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x = second (\g -> nabla{nabla_tm_st = ts{ts_facts=g}}) <$> updateAccum (_class x._data) f env where @@ -841,7 +846,7 @@ instance Outputable PmEquality where -- * E-graphs to represent normalised refinment types -- -type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) +type TmEGraph = EGraph (Maybe VarInfo) (DeBruijnF CoreExprF) -- TODO delete orphans for showing TmEGraph for debugging reasons instance Show VarInfo where show = showPprUnsafe . ppr @@ -858,13 +863,14 @@ representIdsNablas xs = execState (mapM (\x -> state (((),) . representIdNablas representId :: Id -> Nabla -> (ClassId, Nabla) representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) = case lookupVarEnv idmp x of - -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representDBCoreExpr' + -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representCoreExprEgr' -- In particular, if we represent "reverse @a xs" in the e-graph, the -- node in which "xs" will be represented won't match the e-class id -- representing "xs", because that class doesn't contain "VarF xs" + -- (but at least we can still mkMatchIds without storing the VarF for that one) -- Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of Nothing -> case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=EG.rebuild eg1, ts_reps=extendVarEnv idmp x xid}) Just xid -> (xid, MkNabla tyst tmst) representIds :: [Id] -> Nabla -> ([ClassId], Nabla) @@ -874,7 +880,7 @@ representIds xs = runState (mapM (state . representId) xs) -- There ought to be a better way. instance Eq VarInfo where (==) a b = vi_id a == vi_id b -instance Analysis VarInfo (DeBruijnF CoreExprF) where +instance Analysis (Maybe VarInfo) (DeBruijnF CoreExprF) where {-# INLINE makeA #-} {-# INLINE joinA #-} @@ -886,11 +892,9 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- Also, the Eq instance for DeBruijn Vars will ensure that two free -- variables with the same Id are equal and so they will be represented in -- the same e-class - makeA (DF (D _ (VarF x))) = emptyVarInfo x - makeA _ = emptyVarInfo unitDataConId -- ROMES:TODO: this is dummy information which should never be used, this is quite wrong :) - -- I think the reason we end up in this - -- situation is bc we first represent an expression and only then merge it with some Id. - -- we'd need a way to represent directly into an e-class then, to not trigger the new e-class. + -- makeA (DF (D _ (VarF x))) = emptyVarInfo x + makeA _ = Nothing + -- Always start with Nothing, and add things as we go? -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble @@ -904,7 +908,11 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- since it can fail when it is conflicting -- and that would allow us to do the merge procedure correcly here instead of in addVarCt -- we may be able to have Analysis (Effect VarInfo) (...) - joinA a b = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b + joinA Nothing Nothing = Nothing + joinA Nothing (Just b) = Just b + joinA (Just a) Nothing = Just a + joinA (Just a) (Just b) + = Just b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b , vi_pos = case (vi_pos a, vi_pos b) of ([], []) -> [] ([], x) -> x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcfa2444bdc2088f2201b3ba0fa1c37bb6d7f857 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcfa2444bdc2088f2201b3ba0fa1c37bb6d7f857 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:03:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 21:03:48 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable Message-ID: <64b5e4f45426a_23a43db58882880b3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 88771783 by Rodrigo Mesquita at 2023-07-18T02:03:34+01:00 Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable - - - - - 3 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -1,8 +1,7 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} module GHC.Core.Equality where @@ -12,28 +11,24 @@ module GHC.Core.Equality where -- than this for equality. -- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) -import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude import GHC.Core import GHC.Core.TyCo.Rep import GHC.Core.Map.Type -import GHC.Core.Map.Expr import GHC.Types.Var import GHC.Types.Literal import GHC.Types.Tickish -import Unsafe.Coerce (unsafeCoerce) -import Control.Monad.Trans.State.Strict (state) import Data.Equality.Graph as EG import Data.Equality.Analysis import qualified Data.Equality.Graph.Monad as EGM -import Data.Equality.Utils (Fix(..)) - -import GHC.Utils.Misc (all2) import GHC.Utils.Outputable import GHC.Core.Coercion (coercionType) +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader + -- Important to note the binders are also represented by $a$ -- This is because in the e-graph we will represent binders with the -- equivalence class id of things equivalent to it. @@ -41,300 +36,386 @@ import GHC.Core.Coercion (coercionType) -- Unfortunately type binders are still not correctly accounted for. -- Perhaps it'd really be better to make DeBruijn work over these types -data AltF b a - = AltF AltCon [b] a - deriving (Functor, Foldable, Traversable) +-- In the pattern match checker, expressions will always be kind of shallow. +-- In practice, no-one writes gigantic lambda expressions + +data AltF a + = AltF AltCon [()] a + deriving (Functor, Foldable, Traversable, Eq, Ord) -data BindF b a - = NonRecF b a - | RecF [(b, a)] - deriving (Functor, Foldable, Traversable) +data BindF a + = NonRecF a + | RecF [a] + deriving (Functor, Foldable, Traversable, Eq, Ord, Show) -data ExprF b a - = VarF Id +type BoundVar = Int +data ExprF a + = VarF BoundVar + | FreeVarF Id | LitF Literal | AppF a a - | LamF b a - | LetF (BindF b a) a - | CaseF a b Type [AltF b a] - - | CastF a CoercionR - | TickF CoreTickish a - | TypeF Type - | CoercionF Coercion - deriving (Functor, Foldable, Traversable) + | LamF a + | LetF (BindF a) a + | CaseF a [AltF a] -- can we drop the case type for expr equality? we don't need them back, we just need to check equality. (perhaps this specialization makes this more suitable in the Pmc namespace) + + -- | CastF a (DeBruijn CoercionR) -- can we drop this + -- | TickF CoreTickish a -- this, when representing expressions for equality? + -- but it'll be pretty hard to trigger any bug related to equality matching wrt coercions and casts on view patterns solely + | TypeF DBType + | CoercionF DBCoercion + deriving (Functor, Foldable, Traversable, Eq, Ord) + +newtype DBType = DBT (DeBruijn Type) deriving Eq +instance Ord DBType where + compare (DBT dt) (DBT dt') = cmpDeBruijnType dt dt' +newtype DBCoercion = DBC (DeBruijn Coercion) deriving Eq +instance Ord DBCoercion where + compare (DBC dt) (DBC dt') = cmpDeBruijnCoercion dt dt' + + +-- this makes perfect sense, if we already have to represent this in the e-graph +-- we might as well make it a better suited representation for the e-graph... +-- keeping the on-fly debruijn makes no sense +representCoreExprEgr :: forall a + . Analysis a CoreExprF + => CoreExpr + -> EGraph a CoreExprF + -> (ClassId, EGraph a CoreExprF) +representCoreExprEgr expr egr = EGM.runEGraphM egr (runReaderT (go expr) emptyCME) where + go :: CoreExpr -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + go = \case + Var v -> do + env <- ask + case lookupCME env v of + Nothing -> addE (FreeVarF v) + Just i -> addE (VarF i) + Lit lit -> addE (LitF lit) + Type t -> addE (TypeF (DBT $ deBruijnize t)) + Coercion c -> addE (CoercionF (DBC $ deBruijnize c)) + Tick _ e -> go e -- bypass ticks! + Cast e _ -> go e -- bypass casts! ouch? + App f a -> do + f' <- go f + a' <- go a + addE (AppF f' a') + Lam b e -> do + e' <- local (`extendCME` b) $ go e + addE (LamF e') + Let (NonRec v r) e -> do + r' <- go r + e' <- local (`extendCME` v) $ go e + addE (LetF (NonRecF r') e') + Let (Rec (unzip -> (bs,rs))) e -> do + rs' <- traverse (local (`extendCMEs` bs) . go) rs + e' <- local (`extendCMEs` bs) $ go e + addE (LetF (RecF rs') e') + Case e b _t as -> do + e' <- go e + as' <- traverse (local (`extendCME` b) . goAlt) as + addE (CaseF e' as') + + goAlt :: CoreAlt -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) (CoreAltF ClassId) + goAlt (Alt c bs e) = do + e' <- local (`extendCMEs` bs) $ go e + return (AltF c (map (const ()) bs) e') + + addE :: Analysis a CoreExprF => CoreExprF ClassId -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + addE e = lift $ EGM.add $ Node e +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 type CoreExprF - = ExprF CoreBndr + = ExprF type CoreAltF - = AltF CoreBndr + = AltF type CoreBindF - = BindF CoreBndr - -newtype DeBruijnF f a = DF (DeBruijn (f a)) - deriving (Functor, Foldable, Traversable) - -eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool -eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where - go :: CoreExprF a -> CoreExprF a -> Bool - go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) - go (LitF lit1) (LitF lit2) = lit1 == lit2 - go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) - -- See Note [Alpha-equality for Coercion arguments] - go (CoercionF {}) (CoercionF {}) = True - go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 - go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 - go (TickF n1 e1) (TickF n2 e2) - = eqDeBruijnTickish (D env1 n1) (D env2 n2) - && e1 == e2 - - go (LamF b1 e1) (LamF b2 e2) - = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) - && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) - && e1 == e2 - - go (LetF abs e1) (LetF bbs e2) - = D env1 abs == D env2 bbs - && e1 == e2 - - go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) - | null a1 -- See Note [Empty case alternatives] - = null a2 && e1 == e2 && D env1 t1 == D env2 t2 - | otherwise - = e1 == e2 && D env1 a1 == D env2 a2 - - go _ _ = False - --- ROMES:TODO: This one can be derived automatically, but perhaps it's better --- to be explicit here? We don't even really require the DeBruijn context here -eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool -eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where - go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) - = rhs1 == rhs2 - go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) - = lit1 == lit2 && rhs1 == rhs2 - go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) - = dc1 == dc2 && - rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') - go _ _ = False - --- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. -fromCoreExpr :: CoreExpr -> Fix CoreExprF -fromCoreExpr = unsafeCoerce - -toCoreExpr :: CoreExpr -> Fix CoreExprF -toCoreExpr = unsafeCoerce - --- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented --- --- Always represent Ids, at least for now. We're seemingly using inexistent ids --- ROMES:TODO: do this all inside EGraphM instead -representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreExpr - -> EGraph a (DeBruijnF CoreExprF) - -> (ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBCoreExpr (D cmenv expr) eg0 = case expr of - Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 - Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 - Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 - Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 - Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (CastF eid co))) eg1 - App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 - (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 - in add (Node $ DF (D cmenv (AppF fid aid))) eg2 - Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (TickF n eid))) eg1 - Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 - in add (Node $ DF (D cmenv (LamF b eid))) eg1 - Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 - (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 - in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 - Let (Rec (unzip -> (bs,rs))) e -> - let cmenv' = extendCMEs cmenv bs - (bsids, eg1) = EGM.runEGraphM eg0 $ - traverse (state . representDBCoreExpr . D cmenv') rs - (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 - in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 - Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 - (as', eg2) = EGM.runEGraphM eg1 $ - traverse (state . representDBAltExpr . D (extendCME cmenv b)) as - in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 - -representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreAlt - -> EGraph a (DeBruijnF CoreExprF) - -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBAltExpr (D cm (Alt cons bs a)) eg0 = - let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 - in (AltF cons bs ai, eg1) - -instance Eq a => Eq (DeBruijn (CoreAltF a)) where - (==) = eqDeBruijnAltF - -instance Eq a => Eq (DeBruijn (CoreExprF a)) where - (==) = eqDeBruijnExprF - -instance Eq a => Eq (DeBruijnF CoreExprF a) where - (==) (DF a) (DF b) = eqDeBruijnExprF a b - -instance Eq a => Eq (DeBruijnF CoreAltF a) where - (==) (DF a) (DF b) = eqDeBruijnAltF a b - -deriving instance Ord a => Ord (DeBruijnF CoreExprF a) - -instance Ord a => Ord (DeBruijn (CoreExprF a)) where - -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. - -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? - -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. - -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? - -- So I think that just works... - -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... - compare a b - = case a of - D cma (VarF va) - -> case b of - D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) - _ -> LT - D _ (LitF la) - -> case b of - D _ VarF{} -> GT - D _ (LitF lb) -> la `compare` lb - _ -> LT - D _ (AppF af aarg) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 2#) then - LT - else - case b of - D _ (AppF bf barg) - -> case compare af bf of - LT -> LT - EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. - -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... - GT -> GT - _ -> GT - D _ (LamF _abind abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 3#) then - LT - else - case b of - D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') - -> compare abody bbody - _ -> GT - D cma (LetF as abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 4#) then - LT - else - case b of - D cmb (LetF bs bbody) - -> case compare (D cma as) (D cmb bs) of - LT -> LT - EQ -> compare abody bbody - GT -> GT - _ -> GT - D cma (CaseF cax _cabind catype caalt) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 5#) then - GT - else - case b of - D cmb (CaseF cbx _cbbind cbtype cbalt) - -> case compare cax cbx of - LT -> LT - -- ROMES:TODO: Consider changing order of comparisons to a more efficient one - EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of - LT -> LT - EQ -> D cma caalt `compare` D cmb cbalt - GT -> GT - GT -> GT - _ -> LT - D cma (CastF cax caco) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 6#) then - GT - else - case b of - D cmb (CastF cbx cbco) - -> case compare cax cbx of - LT -> LT - EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) - GT -> GT - _ -> LT - D cma (TickF tatickish tax) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 7#) then - GT - else - case b of - D cmb (TickF tbtickish tbx) - -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of - LT -> LT - EQ -> tax `compare` tbx - GT -> GT - _ -> LT - D cma (TypeF at) - -> case b of - D _ CoercionF{} -> LT - D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) - _ -> GT - D cma (CoercionF aco) - -> case b of - D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) - _ -> GT - -instance Eq a => Eq (DeBruijn (CoreBindF a)) where - D cma a == D cmb b = go a b where - go (NonRecF _v1 r1) (NonRecF _v2 r2) - = r1 == r2 -- See Note [Alpha-equality for let-bindings] - - go (RecF ps1) (RecF ps2) - = - -- See Note [Alpha-equality for let-bindings] - all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) - (D cmb (varType b2))) - bs1 bs2 - && rs1 == rs2 - where - (bs1,rs1) = unzip ps1 - (bs2,rs2) = unzip ps2 - - go _ _ = False - - -instance Ord a => Ord (DeBruijn (CoreBindF a)) where - compare a b - = case a of - D _cma (NonRecF _ab ax) - -> case b of - D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. - -> ax `compare` bx - _ -> LT - D _cma (RecF as) - -> case b of - D _cmb (RecF bs) -> compare (map snd as) (map snd bs) - _ -> GT - - -instance Ord a => Ord (DeBruijn (CoreAltF a)) where - compare a b - = case a of - D _cma (AltF ac _abs arhs) - -> case b of - D _cmb (AltF bc _bbs brhs) - -> case compare ac bc of - LT -> LT - EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. - arhs `compare` brhs - GT -> GT + = BindF + +--eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +--eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where +-- go :: CoreExprF a -> CoreExprF a -> Bool +-- go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) +-- go (LitF lit1) (LitF lit2) = lit1 == lit2 +-- go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) +-- -- See Note [Alpha-equality for Coercion arguments] +-- go (CoercionF {}) (CoercionF {}) = True +-- go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 +-- go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 +-- go (TickF n1 e1) (TickF n2 e2) +-- = eqDeBruijnTickish (D env1 n1) (D env2 n2) +-- && e1 == e2 + +-- go (LamF b1 e1) (LamF b2 e2) +-- = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) +-- && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) +-- && e1 == e2 + +-- go (LetF abs e1) (LetF bbs e2) +-- = D env1 abs == D env2 bbs +-- && e1 == e2 + +-- go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) +-- | null a1 -- See Note [Empty case alternatives] +-- = null a2 && e1 == e2 && D env1 t1 == D env2 t2 +-- | otherwise +-- = e1 == e2 && D env1 a1 == D env2 a2 + +-- go _ _ = False + +---- ROMES:TODO: This one can be derived automatically, but perhaps it's better +---- to be explicit here? We don't even really require the DeBruijn context here +--eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +--eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where +-- go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) +-- = rhs1 == rhs2 +-- go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) +-- = lit1 == lit2 && rhs1 == rhs2 +-- go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) +-- = dc1 == dc2 && +-- rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') +-- go _ _ = False + +---- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +--fromCoreExpr :: CoreExpr -> Fix CoreExprF +--fromCoreExpr = unsafeCoerce + +--toCoreExpr :: CoreExpr -> Fix CoreExprF +--toCoreExpr = unsafeCoerce + +---- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +---- +---- Always represent Ids, at least for now. We're seemingly using inexistent ids +---- ROMES:TODO: do this all inside EGraphM instead +--representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreExpr +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBCoreExpr (D cmenv expr) eg0 = case expr of +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 + +--representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreAlt +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBAltExpr (D cm (Alt cons bs a)) eg0 = +-- let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 +-- in (AltF cons bs ai, eg1) + +--instance Eq a => Eq (DeBruijn (CoreAltF a)) where +-- (==) = eqDeBruijnAltF + +--instance Eq a => Eq (DeBruijn (CoreExprF a)) where +-- (==) = eqDeBruijnExprF + +--instance Eq a => Eq (DeBruijnF CoreExprF a) where +-- (==) (DF a) (DF b) = eqDeBruijnExprF a b + +--instance Eq a => Eq (DeBruijnF CoreAltF a) where +-- (==) (DF a) (DF b) = eqDeBruijnAltF a b + +--deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +--instance Ord a => Ord (DeBruijn (CoreExprF a)) where +-- -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. +-- -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? +-- -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. +-- -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? +-- -- So I think that just works... +-- -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... +-- compare a b +-- = case a of +-- D cma (VarF va) +-- -> case b of +-- D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) +-- _ -> LT +-- D _ (LitF la) +-- -> case b of +-- D _ VarF{} -> GT +-- D _ (LitF lb) -> la `compare` lb +-- _ -> LT +-- D _ (AppF af aarg) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 2#) then +-- LT +-- else +-- case b of +-- D _ (AppF bf barg) +-- -> case compare af bf of +-- LT -> LT +-- EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. +-- -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... +-- GT -> GT +-- _ -> GT +-- D _ (LamF _abind abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 3#) then +-- LT +-- else +-- case b of +-- D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') +-- -> compare abody bbody +-- _ -> GT +-- D cma (LetF as abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 4#) then +-- LT +-- else +-- case b of +-- D cmb (LetF bs bbody) +-- -> case compare (D cma as) (D cmb bs) of +-- LT -> LT +-- EQ -> compare abody bbody +-- GT -> GT +-- _ -> GT +-- D cma (CaseF cax _cabind catype caalt) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 5#) then +-- GT +-- else +-- case b of +-- D cmb (CaseF cbx _cbbind cbtype cbalt) +-- -> case compare cax cbx of +-- LT -> LT +-- -- ROMES:TODO: Consider changing order of comparisons to a more efficient one +-- EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of +-- LT -> LT +-- EQ -> D cma caalt `compare` D cmb cbalt +-- GT -> GT +-- GT -> GT +-- _ -> LT +-- D cma (CastF cax caco) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 6#) then +-- GT +-- else +-- case b of +-- D cmb (CastF cbx cbco) +-- -> case compare cax cbx of +-- LT -> LT +-- EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) +-- GT -> GT +-- _ -> LT +-- D cma (TickF tatickish tax) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 7#) then +-- GT +-- else +-- case b of +-- D cmb (TickF tbtickish tbx) +-- -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of +-- LT -> LT +-- EQ -> tax `compare` tbx +-- GT -> GT +-- _ -> LT +-- D cma (TypeF at) +-- -> case b of +-- D _ CoercionF{} -> LT +-- D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) +-- _ -> GT +-- D cma (CoercionF aco) +-- -> case b of +-- D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) +-- _ -> GT + +--instance Eq a => Eq (DeBruijn (CoreBindF a)) where +-- D cma a == D cmb b = go a b where +-- go (NonRecF _v1 r1) (NonRecF _v2 r2) +-- = r1 == r2 -- See Note [Alpha-equality for let-bindings] + +-- go (RecF ps1) (RecF ps2) +-- = +-- -- See Note [Alpha-equality for let-bindings] +-- all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) +-- (D cmb (varType b2))) +-- bs1 bs2 +-- && rs1 == rs2 +-- where +-- (bs1,rs1) = unzip ps1 +-- (bs2,rs2) = unzip ps2 + +-- go _ _ = False + + +--instance Ord a => Ord (DeBruijn (CoreBindF a)) where +-- compare a b +-- = case a of +-- D _cma (NonRecF _ab ax) +-- -> case b of +-- D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. +-- -> ax `compare` bx +-- _ -> LT +-- D _cma (RecF as) +-- -> case b of +-- D _cmb (RecF bs) -> compare (map snd as) (map snd bs) +-- _ -> GT + + +--instance Ord a => Ord (DeBruijn (CoreAltF a)) where +-- compare a b +-- = case a of +-- D _cma (AltF ac _abs arhs) +-- -> case b of +-- D _cmb (AltF bc _bbs brhs) +-- -> case compare ac bc of +-- LT -> LT +-- EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. +-- arhs `compare` brhs +-- GT -> GT cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where @@ -359,26 +440,21 @@ cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering cmpDeBruijnCoercion (D env1 co1) (D env2 co2) = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) --- instances for debugging purposes -instance Show a => Show (DeBruijnF CoreExprF a) where - show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id - show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit - show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b - show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a - show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a - show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts - - show (DF (D _ (CastF _a _cor) )) = "CastF" - show (DF (D _ (TickF _cotick _a))) = "Tick" - show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t) - show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co - - -instance Show a => Show (BindF CoreBndr a) where - show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a - show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs) - -instance Show a => Show (AltF CoreBndr a) where +-- -- instances for debugging purposes +instance Show a => Show (CoreExprF a) where + show (VarF id) = showPprUnsafe $ text "VarF" <+> ppr id + show (FreeVarF id) = showPprUnsafe $ ppr id + show (LitF lit) = showPprUnsafe $ text "LitF" <+> ppr lit + show (AppF a b) = "AppF " ++ show a ++ " " ++ show b + show (LamF a) = "LamF " ++ show a + show (LetF b a) = "LetF " ++ show b ++ " " ++ show a + show (CaseF a alts) = "CaseF " ++ show a ++ show alts + + -- show (CastF _a _cor) = "CastF" + -- show (TickF _cotick _a) = "Tick" + show (TypeF (DBT (D _ t))) = "TypeF " ++ showPprUnsafe (ppr t) + show (CoercionF (DBC (D _ co))) = "CoercionF " ++ showPprUnsafe co + +instance Show a => Show (AltF a) where show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a - ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -64,7 +64,6 @@ import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Type import GHC.Core.Equality import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) @@ -1022,7 +1021,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = - second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + second (\g -> nabla{nabla_tm_st = ts{ts_facts = EG.rebuild g}}) $ representCoreExprEgr (makeDictsCoherent e) egraph -- Use a key in which dictionaries for the same type become equal. -- See Note [Unique dictionaries in the TmOracle CoreMap] ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -67,7 +67,6 @@ import GHC.Core.TyCon import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -173,7 +172,7 @@ data TmState lookupMatchIdMap :: Id -> Nabla -> Maybe ClassId lookupMatchIdMap id (MkNabla _ TmSt{ts_reps}) = lookupVarEnv ts_reps id --- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, +-- | Information about a match id. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set -- ('vi_rcm'). @@ -187,6 +186,9 @@ data VarInfo -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) + -- , vi_ty :: !Type + -- ^ The type of the match-id + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested @@ -333,6 +335,7 @@ emptyVarInfo x -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? lookupVarInfo :: TmState -> ClassId -> VarInfo lookupVarInfo (TmSt eg _ _) x +-- We used to only create an emptyVarInfo when we looked up that id. Now we do it always, even if we never query the Id back T_T -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. = eg ^._class x._data @@ -841,7 +844,7 @@ instance Outputable PmEquality where -- * E-graphs to represent normalised refinment types -- -type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) +type TmEGraph = EGraph VarInfo CoreExprF -- TODO delete orphans for showing TmEGraph for debugging reasons instance Show VarInfo where show = showPprUnsafe . ppr @@ -858,13 +861,14 @@ representIdsNablas xs = execState (mapM (\x -> state (((),) . representIdNablas representId :: Id -> Nabla -> (ClassId, Nabla) representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) = case lookupVarEnv idmp x of - -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representDBCoreExpr' + -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representCoreExprEgr' -- In particular, if we represent "reverse @a xs" in the e-graph, the -- node in which "xs" will be represented won't match the e-class id -- representing "xs", because that class doesn't contain "VarF xs" + -- (but at least we can still mkMatchIds without storing the VarF for that one) -- Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of - Nothing -> case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + Nothing -> case EG.add (EG.Node (FreeVarF x)) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=EG.rebuild eg1, ts_reps=extendVarEnv idmp x xid}) Just xid -> (xid, MkNabla tyst tmst) representIds :: [Id] -> Nabla -> ([ClassId], Nabla) @@ -874,7 +878,7 @@ representIds xs = runState (mapM (state . representId) xs) -- There ought to be a better way. instance Eq VarInfo where (==) a b = vi_id a == vi_id b -instance Analysis VarInfo (DeBruijnF CoreExprF) where +instance Analysis VarInfo CoreExprF where {-# INLINE makeA #-} {-# INLINE joinA #-} @@ -886,11 +890,10 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- Also, the Eq instance for DeBruijn Vars will ensure that two free -- variables with the same Id are equal and so they will be represented in -- the same e-class - makeA (DF (D _ (VarF x))) = emptyVarInfo x - makeA _ = emptyVarInfo unitDataConId -- ROMES:TODO: this is dummy information which should never be used, this is quite wrong :) - -- I think the reason we end up in this - -- situation is bc we first represent an expression and only then merge it with some Id. - -- we'd need a way to represent directly into an e-class then, to not trigger the new e-class. + makeA (FreeVarF x) = emptyVarInfo x + makeA _ = emptyVarInfo unitDataConId + -- makeA _ = Nothing + -- Always start with Nothing, and add things as we go? -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble @@ -904,7 +907,12 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- since it can fail when it is conflicting -- and that would allow us to do the merge procedure correcly here instead of in addVarCt -- we may be able to have Analysis (Effect VarInfo) (...) - joinA a b = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b + -- joinA Nothing Nothing = Nothing + -- joinA Nothing (Just b) = Just b + -- joinA (Just a) Nothing = Just a + -- joinA (Just a) (Just b) + joinA a b + = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b , vi_pos = case (vi_pos a, vi_pos b) of ([], []) -> [] ([], x) -> x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88771783a25b48d40bf82b3c4aee1383bff6fc64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88771783a25b48d40bf82b3c4aee1383bff6fc64 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:09:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 21:09:49 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable Message-ID: <64b5e65d39233_23a43db56f8288831@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 8adaad48 by Rodrigo Mesquita at 2023-07-18T02:09:34+01:00 Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable - - - - - 3 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -1,8 +1,7 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} module GHC.Core.Equality where @@ -12,28 +11,24 @@ module GHC.Core.Equality where -- than this for equality. -- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) -import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude import GHC.Core import GHC.Core.TyCo.Rep import GHC.Core.Map.Type -import GHC.Core.Map.Expr import GHC.Types.Var import GHC.Types.Literal import GHC.Types.Tickish -import Unsafe.Coerce (unsafeCoerce) -import Control.Monad.Trans.State.Strict (state) import Data.Equality.Graph as EG import Data.Equality.Analysis import qualified Data.Equality.Graph.Monad as EGM -import Data.Equality.Utils (Fix(..)) - -import GHC.Utils.Misc (all2) import GHC.Utils.Outputable import GHC.Core.Coercion (coercionType) +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader + -- Important to note the binders are also represented by $a$ -- This is because in the e-graph we will represent binders with the -- equivalence class id of things equivalent to it. @@ -41,300 +36,386 @@ import GHC.Core.Coercion (coercionType) -- Unfortunately type binders are still not correctly accounted for. -- Perhaps it'd really be better to make DeBruijn work over these types -data AltF b a - = AltF AltCon [b] a - deriving (Functor, Foldable, Traversable) +-- In the pattern match checker, expressions will always be kind of shallow. +-- In practice, no-one writes gigantic lambda expressions + +data AltF a + = AltF AltCon [()] a + deriving (Functor, Foldable, Traversable, Eq, Ord) -data BindF b a - = NonRecF b a - | RecF [(b, a)] - deriving (Functor, Foldable, Traversable) +data BindF a + = NonRecF a + | RecF [a] + deriving (Functor, Foldable, Traversable, Eq, Ord, Show) -data ExprF b a - = VarF Id +type BoundVar = Int +data ExprF a + = VarF BoundVar + | FreeVarF Id | LitF Literal | AppF a a - | LamF b a - | LetF (BindF b a) a - | CaseF a b Type [AltF b a] - - | CastF a CoercionR - | TickF CoreTickish a - | TypeF Type - | CoercionF Coercion - deriving (Functor, Foldable, Traversable) + | LamF a + | LetF (BindF a) a + | CaseF a [AltF a] -- can we drop the case type for expr equality? we don't need them back, we just need to check equality. (perhaps this specialization makes this more suitable in the Pmc namespace) + + -- | CastF a (DeBruijn CoercionR) -- can we drop this + -- | TickF CoreTickish a -- this, when representing expressions for equality? + -- but it'll be pretty hard to trigger any bug related to equality matching wrt coercions and casts on view patterns solely + | TypeF DBType + | CoercionF DBCoercion + deriving (Functor, Foldable, Traversable, Eq, Ord) + +newtype DBType = DBT (DeBruijn Type) deriving Eq +instance Ord DBType where + compare (DBT dt) (DBT dt') = cmpDeBruijnType dt dt' +newtype DBCoercion = DBC (DeBruijn Coercion) deriving Eq +instance Ord DBCoercion where + compare (DBC dt) (DBC dt') = cmpDeBruijnCoercion dt dt' + + +-- this makes perfect sense, if we already have to represent this in the e-graph +-- we might as well make it a better suited representation for the e-graph... +-- keeping the on-fly debruijn makes no sense +representCoreExprEgr :: forall a + . Analysis a CoreExprF + => CoreExpr + -> EGraph a CoreExprF + -> (ClassId, EGraph a CoreExprF) +representCoreExprEgr expr egr = EGM.runEGraphM egr (runReaderT (go expr) emptyCME) where + go :: CoreExpr -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + go = \case + Var v -> do + env <- ask + case lookupCME env v of + Nothing -> addE (FreeVarF v) + Just i -> addE (VarF i) + Lit lit -> addE (LitF lit) + Type t -> addE (TypeF (DBT $ deBruijnize t)) + Coercion c -> addE (CoercionF (DBC $ deBruijnize c)) + Tick _ e -> go e -- bypass ticks! + Cast e _ -> go e -- bypass casts! ouch? + App f a -> do + f' <- go f + a' <- go a + addE (AppF f' a') + Lam b e -> do + e' <- local (`extendCME` b) $ go e + addE (LamF e') + Let (NonRec v r) e -> do + r' <- go r + e' <- local (`extendCME` v) $ go e + addE (LetF (NonRecF r') e') + Let (Rec (unzip -> (bs,rs))) e -> do + rs' <- traverse (local (`extendCMEs` bs) . go) rs + e' <- local (`extendCMEs` bs) $ go e + addE (LetF (RecF rs') e') + Case e b _t as -> do + e' <- go e + as' <- traverse (local (`extendCME` b) . goAlt) as + addE (CaseF e' as') + + goAlt :: CoreAlt -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) (CoreAltF ClassId) + goAlt (Alt c bs e) = do + e' <- local (`extendCMEs` bs) $ go e + return (AltF c (map (const ()) bs) e') + + addE :: Analysis a CoreExprF => CoreExprF ClassId -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + addE e = lift $ EGM.add $ Node e +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 type CoreExprF - = ExprF CoreBndr + = ExprF type CoreAltF - = AltF CoreBndr + = AltF type CoreBindF - = BindF CoreBndr - -newtype DeBruijnF f a = DF (DeBruijn (f a)) - deriving (Functor, Foldable, Traversable) - -eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool -eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where - go :: CoreExprF a -> CoreExprF a -> Bool - go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) - go (LitF lit1) (LitF lit2) = lit1 == lit2 - go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) - -- See Note [Alpha-equality for Coercion arguments] - go (CoercionF {}) (CoercionF {}) = True - go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 - go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 - go (TickF n1 e1) (TickF n2 e2) - = eqDeBruijnTickish (D env1 n1) (D env2 n2) - && e1 == e2 - - go (LamF b1 e1) (LamF b2 e2) - = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) - && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) - && e1 == e2 - - go (LetF abs e1) (LetF bbs e2) - = D env1 abs == D env2 bbs - && e1 == e2 - - go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) - | null a1 -- See Note [Empty case alternatives] - = null a2 && e1 == e2 && D env1 t1 == D env2 t2 - | otherwise - = e1 == e2 && D env1 a1 == D env2 a2 - - go _ _ = False - --- ROMES:TODO: This one can be derived automatically, but perhaps it's better --- to be explicit here? We don't even really require the DeBruijn context here -eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool -eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where - go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) - = rhs1 == rhs2 - go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) - = lit1 == lit2 && rhs1 == rhs2 - go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) - = dc1 == dc2 && - rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') - go _ _ = False - --- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. -fromCoreExpr :: CoreExpr -> Fix CoreExprF -fromCoreExpr = unsafeCoerce - -toCoreExpr :: CoreExpr -> Fix CoreExprF -toCoreExpr = unsafeCoerce - --- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented --- --- Always represent Ids, at least for now. We're seemingly using inexistent ids --- ROMES:TODO: do this all inside EGraphM instead -representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreExpr - -> EGraph a (DeBruijnF CoreExprF) - -> (ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBCoreExpr (D cmenv expr) eg0 = case expr of - Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 - Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 - Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 - Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 - Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (CastF eid co))) eg1 - App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 - (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 - in add (Node $ DF (D cmenv (AppF fid aid))) eg2 - Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (TickF n eid))) eg1 - Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 - in add (Node $ DF (D cmenv (LamF b eid))) eg1 - Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 - (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 - in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 - Let (Rec (unzip -> (bs,rs))) e -> - let cmenv' = extendCMEs cmenv bs - (bsids, eg1) = EGM.runEGraphM eg0 $ - traverse (state . representDBCoreExpr . D cmenv') rs - (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 - in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 - Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 - (as', eg2) = EGM.runEGraphM eg1 $ - traverse (state . representDBAltExpr . D (extendCME cmenv b)) as - in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 - -representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreAlt - -> EGraph a (DeBruijnF CoreExprF) - -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBAltExpr (D cm (Alt cons bs a)) eg0 = - let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 - in (AltF cons bs ai, eg1) - -instance Eq a => Eq (DeBruijn (CoreAltF a)) where - (==) = eqDeBruijnAltF - -instance Eq a => Eq (DeBruijn (CoreExprF a)) where - (==) = eqDeBruijnExprF - -instance Eq a => Eq (DeBruijnF CoreExprF a) where - (==) (DF a) (DF b) = eqDeBruijnExprF a b - -instance Eq a => Eq (DeBruijnF CoreAltF a) where - (==) (DF a) (DF b) = eqDeBruijnAltF a b - -deriving instance Ord a => Ord (DeBruijnF CoreExprF a) - -instance Ord a => Ord (DeBruijn (CoreExprF a)) where - -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. - -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? - -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. - -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? - -- So I think that just works... - -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... - compare a b - = case a of - D cma (VarF va) - -> case b of - D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) - _ -> LT - D _ (LitF la) - -> case b of - D _ VarF{} -> GT - D _ (LitF lb) -> la `compare` lb - _ -> LT - D _ (AppF af aarg) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 2#) then - LT - else - case b of - D _ (AppF bf barg) - -> case compare af bf of - LT -> LT - EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. - -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... - GT -> GT - _ -> GT - D _ (LamF _abind abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 3#) then - LT - else - case b of - D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') - -> compare abody bbody - _ -> GT - D cma (LetF as abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 4#) then - LT - else - case b of - D cmb (LetF bs bbody) - -> case compare (D cma as) (D cmb bs) of - LT -> LT - EQ -> compare abody bbody - GT -> GT - _ -> GT - D cma (CaseF cax _cabind catype caalt) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 5#) then - GT - else - case b of - D cmb (CaseF cbx _cbbind cbtype cbalt) - -> case compare cax cbx of - LT -> LT - -- ROMES:TODO: Consider changing order of comparisons to a more efficient one - EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of - LT -> LT - EQ -> D cma caalt `compare` D cmb cbalt - GT -> GT - GT -> GT - _ -> LT - D cma (CastF cax caco) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 6#) then - GT - else - case b of - D cmb (CastF cbx cbco) - -> case compare cax cbx of - LT -> LT - EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) - GT -> GT - _ -> LT - D cma (TickF tatickish tax) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 7#) then - GT - else - case b of - D cmb (TickF tbtickish tbx) - -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of - LT -> LT - EQ -> tax `compare` tbx - GT -> GT - _ -> LT - D cma (TypeF at) - -> case b of - D _ CoercionF{} -> LT - D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) - _ -> GT - D cma (CoercionF aco) - -> case b of - D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) - _ -> GT - -instance Eq a => Eq (DeBruijn (CoreBindF a)) where - D cma a == D cmb b = go a b where - go (NonRecF _v1 r1) (NonRecF _v2 r2) - = r1 == r2 -- See Note [Alpha-equality for let-bindings] - - go (RecF ps1) (RecF ps2) - = - -- See Note [Alpha-equality for let-bindings] - all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) - (D cmb (varType b2))) - bs1 bs2 - && rs1 == rs2 - where - (bs1,rs1) = unzip ps1 - (bs2,rs2) = unzip ps2 - - go _ _ = False - - -instance Ord a => Ord (DeBruijn (CoreBindF a)) where - compare a b - = case a of - D _cma (NonRecF _ab ax) - -> case b of - D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. - -> ax `compare` bx - _ -> LT - D _cma (RecF as) - -> case b of - D _cmb (RecF bs) -> compare (map snd as) (map snd bs) - _ -> GT - - -instance Ord a => Ord (DeBruijn (CoreAltF a)) where - compare a b - = case a of - D _cma (AltF ac _abs arhs) - -> case b of - D _cmb (AltF bc _bbs brhs) - -> case compare ac bc of - LT -> LT - EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. - arhs `compare` brhs - GT -> GT + = BindF + +--eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +--eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where +-- go :: CoreExprF a -> CoreExprF a -> Bool +-- go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) +-- go (LitF lit1) (LitF lit2) = lit1 == lit2 +-- go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) +-- -- See Note [Alpha-equality for Coercion arguments] +-- go (CoercionF {}) (CoercionF {}) = True +-- go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 +-- go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 +-- go (TickF n1 e1) (TickF n2 e2) +-- = eqDeBruijnTickish (D env1 n1) (D env2 n2) +-- && e1 == e2 + +-- go (LamF b1 e1) (LamF b2 e2) +-- = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) +-- && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) +-- && e1 == e2 + +-- go (LetF abs e1) (LetF bbs e2) +-- = D env1 abs == D env2 bbs +-- && e1 == e2 + +-- go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) +-- | null a1 -- See Note [Empty case alternatives] +-- = null a2 && e1 == e2 && D env1 t1 == D env2 t2 +-- | otherwise +-- = e1 == e2 && D env1 a1 == D env2 a2 + +-- go _ _ = False + +---- ROMES:TODO: This one can be derived automatically, but perhaps it's better +---- to be explicit here? We don't even really require the DeBruijn context here +--eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +--eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where +-- go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) +-- = rhs1 == rhs2 +-- go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) +-- = lit1 == lit2 && rhs1 == rhs2 +-- go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) +-- = dc1 == dc2 && +-- rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') +-- go _ _ = False + +---- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +--fromCoreExpr :: CoreExpr -> Fix CoreExprF +--fromCoreExpr = unsafeCoerce + +--toCoreExpr :: CoreExpr -> Fix CoreExprF +--toCoreExpr = unsafeCoerce + +---- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +---- +---- Always represent Ids, at least for now. We're seemingly using inexistent ids +---- ROMES:TODO: do this all inside EGraphM instead +--representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreExpr +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBCoreExpr (D cmenv expr) eg0 = case expr of +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 + +--representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreAlt +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBAltExpr (D cm (Alt cons bs a)) eg0 = +-- let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 +-- in (AltF cons bs ai, eg1) + +--instance Eq a => Eq (DeBruijn (CoreAltF a)) where +-- (==) = eqDeBruijnAltF + +--instance Eq a => Eq (DeBruijn (CoreExprF a)) where +-- (==) = eqDeBruijnExprF + +--instance Eq a => Eq (DeBruijnF CoreExprF a) where +-- (==) (DF a) (DF b) = eqDeBruijnExprF a b + +--instance Eq a => Eq (DeBruijnF CoreAltF a) where +-- (==) (DF a) (DF b) = eqDeBruijnAltF a b + +--deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +--instance Ord a => Ord (DeBruijn (CoreExprF a)) where +-- -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. +-- -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? +-- -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. +-- -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? +-- -- So I think that just works... +-- -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... +-- compare a b +-- = case a of +-- D cma (VarF va) +-- -> case b of +-- D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) +-- _ -> LT +-- D _ (LitF la) +-- -> case b of +-- D _ VarF{} -> GT +-- D _ (LitF lb) -> la `compare` lb +-- _ -> LT +-- D _ (AppF af aarg) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 2#) then +-- LT +-- else +-- case b of +-- D _ (AppF bf barg) +-- -> case compare af bf of +-- LT -> LT +-- EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. +-- -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... +-- GT -> GT +-- _ -> GT +-- D _ (LamF _abind abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 3#) then +-- LT +-- else +-- case b of +-- D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') +-- -> compare abody bbody +-- _ -> GT +-- D cma (LetF as abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 4#) then +-- LT +-- else +-- case b of +-- D cmb (LetF bs bbody) +-- -> case compare (D cma as) (D cmb bs) of +-- LT -> LT +-- EQ -> compare abody bbody +-- GT -> GT +-- _ -> GT +-- D cma (CaseF cax _cabind catype caalt) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 5#) then +-- GT +-- else +-- case b of +-- D cmb (CaseF cbx _cbbind cbtype cbalt) +-- -> case compare cax cbx of +-- LT -> LT +-- -- ROMES:TODO: Consider changing order of comparisons to a more efficient one +-- EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of +-- LT -> LT +-- EQ -> D cma caalt `compare` D cmb cbalt +-- GT -> GT +-- GT -> GT +-- _ -> LT +-- D cma (CastF cax caco) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 6#) then +-- GT +-- else +-- case b of +-- D cmb (CastF cbx cbco) +-- -> case compare cax cbx of +-- LT -> LT +-- EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) +-- GT -> GT +-- _ -> LT +-- D cma (TickF tatickish tax) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 7#) then +-- GT +-- else +-- case b of +-- D cmb (TickF tbtickish tbx) +-- -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of +-- LT -> LT +-- EQ -> tax `compare` tbx +-- GT -> GT +-- _ -> LT +-- D cma (TypeF at) +-- -> case b of +-- D _ CoercionF{} -> LT +-- D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) +-- _ -> GT +-- D cma (CoercionF aco) +-- -> case b of +-- D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) +-- _ -> GT + +--instance Eq a => Eq (DeBruijn (CoreBindF a)) where +-- D cma a == D cmb b = go a b where +-- go (NonRecF _v1 r1) (NonRecF _v2 r2) +-- = r1 == r2 -- See Note [Alpha-equality for let-bindings] + +-- go (RecF ps1) (RecF ps2) +-- = +-- -- See Note [Alpha-equality for let-bindings] +-- all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) +-- (D cmb (varType b2))) +-- bs1 bs2 +-- && rs1 == rs2 +-- where +-- (bs1,rs1) = unzip ps1 +-- (bs2,rs2) = unzip ps2 + +-- go _ _ = False + + +--instance Ord a => Ord (DeBruijn (CoreBindF a)) where +-- compare a b +-- = case a of +-- D _cma (NonRecF _ab ax) +-- -> case b of +-- D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. +-- -> ax `compare` bx +-- _ -> LT +-- D _cma (RecF as) +-- -> case b of +-- D _cmb (RecF bs) -> compare (map snd as) (map snd bs) +-- _ -> GT + + +--instance Ord a => Ord (DeBruijn (CoreAltF a)) where +-- compare a b +-- = case a of +-- D _cma (AltF ac _abs arhs) +-- -> case b of +-- D _cmb (AltF bc _bbs brhs) +-- -> case compare ac bc of +-- LT -> LT +-- EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. +-- arhs `compare` brhs +-- GT -> GT cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where @@ -359,26 +440,21 @@ cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering cmpDeBruijnCoercion (D env1 co1) (D env2 co2) = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) --- instances for debugging purposes -instance Show a => Show (DeBruijnF CoreExprF a) where - show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id - show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit - show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b - show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a - show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a - show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts - - show (DF (D _ (CastF _a _cor) )) = "CastF" - show (DF (D _ (TickF _cotick _a))) = "Tick" - show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t) - show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co - - -instance Show a => Show (BindF CoreBndr a) where - show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a - show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs) - -instance Show a => Show (AltF CoreBndr a) where +-- -- instances for debugging purposes +instance Show a => Show (CoreExprF a) where + show (VarF id) = showPprUnsafe $ text "VarF" <+> ppr id + show (FreeVarF id) = showPprUnsafe $ ppr id + show (LitF lit) = showPprUnsafe $ text "LitF" <+> ppr lit + show (AppF a b) = "AppF " ++ show a ++ " " ++ show b + show (LamF a) = "LamF " ++ show a + show (LetF b a) = "LetF " ++ show b ++ " " ++ show a + show (CaseF a alts) = "CaseF " ++ show a ++ show alts + + -- show (CastF _a _cor) = "CastF" + -- show (TickF _cotick _a) = "Tick" + show (TypeF (DBT (D _ t))) = "TypeF " ++ showPprUnsafe (ppr t) + show (CoercionF (DBC (D _ co))) = "CoercionF " ++ showPprUnsafe co + +instance Show a => Show (AltF a) where show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a - ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -64,7 +64,6 @@ import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Type import GHC.Core.Equality import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) @@ -1022,7 +1021,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = - second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + second (\g -> nabla{nabla_tm_st = ts{ts_facts = EG.rebuild g}}) $ representCoreExprEgr (makeDictsCoherent e) egraph -- Use a key in which dictionaries for the same type become equal. -- See Note [Unique dictionaries in the TmOracle CoreMap] ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -67,7 +67,6 @@ import GHC.Core.TyCon import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -173,7 +172,7 @@ data TmState lookupMatchIdMap :: Id -> Nabla -> Maybe ClassId lookupMatchIdMap id (MkNabla _ TmSt{ts_reps}) = lookupVarEnv ts_reps id --- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, +-- | Information about a match id. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set -- ('vi_rcm'). @@ -187,6 +186,9 @@ data VarInfo -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) + -- , vi_ty :: !Type + -- ^ The type of the match-id + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested @@ -333,6 +335,7 @@ emptyVarInfo x -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? lookupVarInfo :: TmState -> ClassId -> VarInfo lookupVarInfo (TmSt eg _ _) x +-- We used to only create an emptyVarInfo when we looked up that id. Now we do it always, even if we never query the Id back T_T -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. = eg ^._class x._data @@ -841,7 +844,7 @@ instance Outputable PmEquality where -- * E-graphs to represent normalised refinment types -- -type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) +type TmEGraph = EGraph VarInfo CoreExprF -- TODO delete orphans for showing TmEGraph for debugging reasons instance Show VarInfo where show = showPprUnsafe . ppr @@ -858,13 +861,14 @@ representIdsNablas xs = execState (mapM (\x -> state (((),) . representIdNablas representId :: Id -> Nabla -> (ClassId, Nabla) representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) = case lookupVarEnv idmp x of - -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representDBCoreExpr' + -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representCoreExprEgr' -- In particular, if we represent "reverse @a xs" in the e-graph, the -- node in which "xs" will be represented won't match the e-class id -- representing "xs", because that class doesn't contain "VarF xs" + -- (but at least we can still mkMatchIds without storing the VarF for that one) -- Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of - Nothing -> case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + Nothing -> case EG.add (EG.Node (FreeVarF x)) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=EG.rebuild eg1, ts_reps=extendVarEnv idmp x xid}) Just xid -> (xid, MkNabla tyst tmst) representIds :: [Id] -> Nabla -> ([ClassId], Nabla) @@ -874,7 +878,7 @@ representIds xs = runState (mapM (state . representId) xs) -- There ought to be a better way. instance Eq VarInfo where (==) a b = vi_id a == vi_id b -instance Analysis VarInfo (DeBruijnF CoreExprF) where +instance Analysis VarInfo CoreExprF where {-# INLINE makeA #-} {-# INLINE joinA #-} @@ -886,11 +890,10 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- Also, the Eq instance for DeBruijn Vars will ensure that two free -- variables with the same Id are equal and so they will be represented in -- the same e-class - makeA (DF (D _ (VarF x))) = emptyVarInfo x - makeA _ = emptyVarInfo unitDataConId -- ROMES:TODO: this is dummy information which should never be used, this is quite wrong :) - -- I think the reason we end up in this - -- situation is bc we first represent an expression and only then merge it with some Id. - -- we'd need a way to represent directly into an e-class then, to not trigger the new e-class. + makeA (FreeVarF x) = emptyVarInfo x + makeA _ = emptyVarInfo unitDataConId + -- makeA _ = Nothing + -- Always start with Nothing, and add things as we go? -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble @@ -904,7 +907,12 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- since it can fail when it is conflicting -- and that would allow us to do the merge procedure correcly here instead of in addVarCt -- we may be able to have Analysis (Effect VarInfo) (...) - joinA a b = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b + -- joinA Nothing Nothing = Nothing + -- joinA Nothing (Just b) = Just b + -- joinA (Just a) Nothing = Just a + -- joinA (Just a) (Just b) + joinA a b + = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b , vi_pos = case (vi_pos a, vi_pos b) of ([], []) -> [] ([], x) -> x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8adaad4838a9f3ef3237d7132293c81759a160f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8adaad4838a9f3ef3237d7132293c81759a160f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:12:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 21:12:40 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable Message-ID: <64b5e7082049d_23a43db5680289441@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 43e1f5e5 by Rodrigo Mesquita at 2023-07-18T02:12:26+01:00 Imrove term representation in e-graph a lot... and code complexity too, it's almost reasonable - - - - - 3 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -1,8 +1,7 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} module GHC.Core.Equality where @@ -12,28 +11,24 @@ module GHC.Core.Equality where -- than this for equality. -- E.g. representation could transform the CoreExpr to an actual debruijnized one (with Ints for Vars) -import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude import GHC.Core import GHC.Core.TyCo.Rep import GHC.Core.Map.Type -import GHC.Core.Map.Expr import GHC.Types.Var import GHC.Types.Literal import GHC.Types.Tickish -import Unsafe.Coerce (unsafeCoerce) -import Control.Monad.Trans.State.Strict (state) import Data.Equality.Graph as EG import Data.Equality.Analysis import qualified Data.Equality.Graph.Monad as EGM -import Data.Equality.Utils (Fix(..)) - -import GHC.Utils.Misc (all2) import GHC.Utils.Outputable import GHC.Core.Coercion (coercionType) +import Control.Monad.Trans.Class +import Control.Monad.Trans.Reader + -- Important to note the binders are also represented by $a$ -- This is because in the e-graph we will represent binders with the -- equivalence class id of things equivalent to it. @@ -41,300 +36,386 @@ import GHC.Core.Coercion (coercionType) -- Unfortunately type binders are still not correctly accounted for. -- Perhaps it'd really be better to make DeBruijn work over these types -data AltF b a - = AltF AltCon [b] a - deriving (Functor, Foldable, Traversable) +-- In the pattern match checker, expressions will always be kind of shallow. +-- In practice, no-one writes gigantic lambda expressions + +data AltF a + = AltF AltCon [()] a + deriving (Functor, Foldable, Traversable, Eq, Ord) -data BindF b a - = NonRecF b a - | RecF [(b, a)] - deriving (Functor, Foldable, Traversable) +data BindF a + = NonRecF a + | RecF [a] + deriving (Functor, Foldable, Traversable, Eq, Ord, Show) -data ExprF b a - = VarF Id +type BoundVar = Int +data ExprF a + = VarF BoundVar + | FreeVarF Id | LitF Literal | AppF a a - | LamF b a - | LetF (BindF b a) a - | CaseF a b Type [AltF b a] - - | CastF a CoercionR - | TickF CoreTickish a - | TypeF Type - | CoercionF Coercion - deriving (Functor, Foldable, Traversable) + | LamF a + | LetF (BindF a) a + | CaseF a [AltF a] -- can we drop the case type for expr equality? we don't need them back, we just need to check equality. (perhaps this specialization makes this more suitable in the Pmc namespace) + + -- | CastF a (DeBruijn CoercionR) -- can we drop this + -- | TickF CoreTickish a -- this, when representing expressions for equality? + -- but it'll be pretty hard to trigger any bug related to equality matching wrt coercions and casts on view patterns solely + | TypeF DBType + | CoercionF DBCoercion + deriving (Functor, Foldable, Traversable, Eq, Ord) + +newtype DBType = DBT (DeBruijn Type) deriving Eq +instance Ord DBType where + compare (DBT dt) (DBT dt') = cmpDeBruijnType dt dt' +newtype DBCoercion = DBC (DeBruijn Coercion) deriving Eq +instance Ord DBCoercion where + compare (DBC dt) (DBC dt') = cmpDeBruijnCoercion dt dt' + + +-- this makes perfect sense, if we already have to represent this in the e-graph +-- we might as well make it a better suited representation for the e-graph... +-- keeping the on-fly debruijn makes no sense +representCoreExprEgr :: forall a + . Analysis a CoreExprF + => CoreExpr + -> EGraph a CoreExprF + -> (ClassId, EGraph a CoreExprF) +representCoreExprEgr expr egr = EGM.runEGraphM egr (runReaderT (go expr) emptyCME) where + go :: CoreExpr -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + go = \case + Var v -> do + env <- ask + case lookupCME env v of + Nothing -> addE (FreeVarF v) + Just i -> addE (VarF i) + Lit lit -> addE (LitF lit) + Type t -> addE (TypeF (DBT $ deBruijnize t)) + Coercion c -> addE (CoercionF (DBC $ deBruijnize c)) + Tick _ e -> go e -- bypass ticks! + Cast e _ -> go e -- bypass casts! ouch? + App f a -> do + f' <- go f + a' <- go a + addE (AppF f' a') + Lam b e -> do + e' <- local (`extendCME` b) $ go e + addE (LamF e') + Let (NonRec v r) e -> do + r' <- go r + e' <- local (`extendCME` v) $ go e + addE (LetF (NonRecF r') e') + Let (Rec (unzip -> (bs,rs))) e -> do + rs' <- traverse (local (`extendCMEs` bs) . go) rs + e' <- local (`extendCMEs` bs) $ go e + addE (LetF (RecF rs') e') + Case e b _t as -> do + e' <- go e + as' <- traverse (local (`extendCME` b) . goAlt) as + addE (CaseF e' as') + + goAlt :: CoreAlt -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) (CoreAltF ClassId) + goAlt (Alt c bs e) = do + e' <- local (`extendCMEs` bs) $ go e + return (AltF c (map (const ()) bs) e') + + addE :: Analysis a CoreExprF => CoreExprF ClassId -> ReaderT CmEnv (EGM.EGraphM a CoreExprF) ClassId + addE e = lift $ EGM.add $ Node e +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 type CoreExprF - = ExprF CoreBndr + = ExprF type CoreAltF - = AltF CoreBndr + = AltF type CoreBindF - = BindF CoreBndr - -newtype DeBruijnF f a = DF (DeBruijn (f a)) - deriving (Functor, Foldable, Traversable) - -eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool -eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where - go :: CoreExprF a -> CoreExprF a -> Bool - go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) - go (LitF lit1) (LitF lit2) = lit1 == lit2 - go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) - -- See Note [Alpha-equality for Coercion arguments] - go (CoercionF {}) (CoercionF {}) = True - go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 - go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 - go (TickF n1 e1) (TickF n2 e2) - = eqDeBruijnTickish (D env1 n1) (D env2 n2) - && e1 == e2 - - go (LamF b1 e1) (LamF b2 e2) - = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) - && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) - && e1 == e2 - - go (LetF abs e1) (LetF bbs e2) - = D env1 abs == D env2 bbs - && e1 == e2 - - go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) - | null a1 -- See Note [Empty case alternatives] - = null a2 && e1 == e2 && D env1 t1 == D env2 t2 - | otherwise - = e1 == e2 && D env1 a1 == D env2 a2 - - go _ _ = False - --- ROMES:TODO: This one can be derived automatically, but perhaps it's better --- to be explicit here? We don't even really require the DeBruijn context here -eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool -eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where - go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) - = rhs1 == rhs2 - go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) - = lit1 == lit2 && rhs1 == rhs2 - go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) - = dc1 == dc2 && - rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') - go _ _ = False - --- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. -fromCoreExpr :: CoreExpr -> Fix CoreExprF -fromCoreExpr = unsafeCoerce - -toCoreExpr :: CoreExpr -> Fix CoreExprF -toCoreExpr = unsafeCoerce - --- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented --- --- Always represent Ids, at least for now. We're seemingly using inexistent ids --- ROMES:TODO: do this all inside EGraphM instead -representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreExpr - -> EGraph a (DeBruijnF CoreExprF) - -> (ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBCoreExpr (D cmenv expr) eg0 = case expr of - Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 - Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 - Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 - Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 - Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (CastF eid co))) eg1 - App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 - (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 - in add (Node $ DF (D cmenv (AppF fid aid))) eg2 - Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 - in add (Node $ DF (D cmenv (TickF n eid))) eg1 - Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 - in add (Node $ DF (D cmenv (LamF b eid))) eg1 - Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 - (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 - in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 - Let (Rec (unzip -> (bs,rs))) e -> - let cmenv' = extendCMEs cmenv bs - (bsids, eg1) = EGM.runEGraphM eg0 $ - traverse (state . representDBCoreExpr . D cmenv') rs - (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 - in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 - Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 - (as', eg2) = EGM.runEGraphM eg1 $ - traverse (state . representDBAltExpr . D (extendCME cmenv b)) as - in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 - -representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) - => DeBruijn CoreAlt - -> EGraph a (DeBruijnF CoreExprF) - -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBAltExpr (D cm (Alt cons bs a)) eg0 = - let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 - in (AltF cons bs ai, eg1) - -instance Eq a => Eq (DeBruijn (CoreAltF a)) where - (==) = eqDeBruijnAltF - -instance Eq a => Eq (DeBruijn (CoreExprF a)) where - (==) = eqDeBruijnExprF - -instance Eq a => Eq (DeBruijnF CoreExprF a) where - (==) (DF a) (DF b) = eqDeBruijnExprF a b - -instance Eq a => Eq (DeBruijnF CoreAltF a) where - (==) (DF a) (DF b) = eqDeBruijnAltF a b - -deriving instance Ord a => Ord (DeBruijnF CoreExprF a) - -instance Ord a => Ord (DeBruijn (CoreExprF a)) where - -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. - -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? - -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. - -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? - -- So I think that just works... - -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... - compare a b - = case a of - D cma (VarF va) - -> case b of - D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) - _ -> LT - D _ (LitF la) - -> case b of - D _ VarF{} -> GT - D _ (LitF lb) -> la `compare` lb - _ -> LT - D _ (AppF af aarg) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 2#) then - LT - else - case b of - D _ (AppF bf barg) - -> case compare af bf of - LT -> LT - EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. - -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... - GT -> GT - _ -> GT - D _ (LamF _abind abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 3#) then - LT - else - case b of - D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') - -> compare abody bbody - _ -> GT - D cma (LetF as abody) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt ># 4#) then - LT - else - case b of - D cmb (LetF bs bbody) - -> case compare (D cma as) (D cmb bs) of - LT -> LT - EQ -> compare abody bbody - GT -> GT - _ -> GT - D cma (CaseF cax _cabind catype caalt) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 5#) then - GT - else - case b of - D cmb (CaseF cbx _cbbind cbtype cbalt) - -> case compare cax cbx of - LT -> LT - -- ROMES:TODO: Consider changing order of comparisons to a more efficient one - EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of - LT -> LT - EQ -> D cma caalt `compare` D cmb cbalt - GT -> GT - GT -> GT - _ -> LT - D cma (CastF cax caco) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 6#) then - GT - else - case b of - D cmb (CastF cbx cbco) - -> case compare cax cbx of - LT -> LT - EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) - GT -> GT - _ -> LT - D cma (TickF tatickish tax) - -> case dataToTag# b of - bt - -> if tagToEnum# (bt <# 7#) then - GT - else - case b of - D cmb (TickF tbtickish tbx) - -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of - LT -> LT - EQ -> tax `compare` tbx - GT -> GT - _ -> LT - D cma (TypeF at) - -> case b of - D _ CoercionF{} -> LT - D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) - _ -> GT - D cma (CoercionF aco) - -> case b of - D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) - _ -> GT - -instance Eq a => Eq (DeBruijn (CoreBindF a)) where - D cma a == D cmb b = go a b where - go (NonRecF _v1 r1) (NonRecF _v2 r2) - = r1 == r2 -- See Note [Alpha-equality for let-bindings] - - go (RecF ps1) (RecF ps2) - = - -- See Note [Alpha-equality for let-bindings] - all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) - (D cmb (varType b2))) - bs1 bs2 - && rs1 == rs2 - where - (bs1,rs1) = unzip ps1 - (bs2,rs2) = unzip ps2 - - go _ _ = False - - -instance Ord a => Ord (DeBruijn (CoreBindF a)) where - compare a b - = case a of - D _cma (NonRecF _ab ax) - -> case b of - D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. - -> ax `compare` bx - _ -> LT - D _cma (RecF as) - -> case b of - D _cmb (RecF bs) -> compare (map snd as) (map snd bs) - _ -> GT - - -instance Ord a => Ord (DeBruijn (CoreAltF a)) where - compare a b - = case a of - D _cma (AltF ac _abs arhs) - -> case b of - D _cmb (AltF bc _bbs brhs) - -> case compare ac bc of - LT -> LT - EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. - arhs `compare` brhs - GT -> GT + = BindF + +--eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +--eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where +-- go :: CoreExprF a -> CoreExprF a -> Bool +-- go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) +-- go (LitF lit1) (LitF lit2) = lit1 == lit2 +-- go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) +-- -- See Note [Alpha-equality for Coercion arguments] +-- go (CoercionF {}) (CoercionF {}) = True +-- go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 +-- go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 +-- go (TickF n1 e1) (TickF n2 e2) +-- = eqDeBruijnTickish (D env1 n1) (D env2 n2) +-- && e1 == e2 + +-- go (LamF b1 e1) (LamF b2 e2) +-- = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) +-- && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) +-- && e1 == e2 + +-- go (LetF abs e1) (LetF bbs e2) +-- = D env1 abs == D env2 bbs +-- && e1 == e2 + +-- go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) +-- | null a1 -- See Note [Empty case alternatives] +-- = null a2 && e1 == e2 && D env1 t1 == D env2 t2 +-- | otherwise +-- = e1 == e2 && D env1 a1 == D env2 a2 + +-- go _ _ = False + +---- ROMES:TODO: This one can be derived automatically, but perhaps it's better +---- to be explicit here? We don't even really require the DeBruijn context here +--eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +--eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where +-- go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) +-- = rhs1 == rhs2 +-- go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) +-- = lit1 == lit2 && rhs1 == rhs2 +-- go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) +-- = dc1 == dc2 && +-- rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') +-- go _ _ = False + +---- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +--fromCoreExpr :: CoreExpr -> Fix CoreExprF +--fromCoreExpr = unsafeCoerce + +--toCoreExpr :: CoreExpr -> Fix CoreExprF +--toCoreExpr = unsafeCoerce + +---- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +---- +---- Always represent Ids, at least for now. We're seemingly using inexistent ids +---- ROMES:TODO: do this all inside EGraphM instead +--representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreExpr +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBCoreExpr (D cmenv expr) eg0 = case expr of +-- Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 +-- Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 +-- Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 +-- Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 +-- Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (CastF eid co))) eg1 +-- App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 +-- (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 +-- in add (Node $ DF (D cmenv (AppF fid aid))) eg2 +-- Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 +-- in add (Node $ DF (D cmenv (TickF n eid))) eg1 +-- Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 +-- in add (Node $ DF (D cmenv (LamF b eid))) eg1 +-- Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 +-- (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 +-- in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 +-- Let (Rec (unzip -> (bs,rs))) e -> +-- let cmenv' = extendCMEs cmenv bs +-- (bsids, eg1) = EGM.runEGraphM eg0 $ +-- traverse (state . representDBCoreExpr . D cmenv') rs +-- (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 +-- in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 +-- Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 +-- (as', eg2) = EGM.runEGraphM eg1 $ +-- traverse (state . representDBAltExpr . D (extendCME cmenv b)) as +-- in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 + +--representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) +-- => DeBruijn CoreAlt +-- -> EGraph a (DeBruijnF CoreExprF) +-- -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +--representDBAltExpr (D cm (Alt cons bs a)) eg0 = +-- let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 +-- in (AltF cons bs ai, eg1) + +--instance Eq a => Eq (DeBruijn (CoreAltF a)) where +-- (==) = eqDeBruijnAltF + +--instance Eq a => Eq (DeBruijn (CoreExprF a)) where +-- (==) = eqDeBruijnExprF + +--instance Eq a => Eq (DeBruijnF CoreExprF a) where +-- (==) (DF a) (DF b) = eqDeBruijnExprF a b + +--instance Eq a => Eq (DeBruijnF CoreAltF a) where +-- (==) (DF a) (DF b) = eqDeBruijnAltF a b + +--deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +--instance Ord a => Ord (DeBruijn (CoreExprF a)) where +-- -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. +-- -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? +-- -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. +-- -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? +-- -- So I think that just works... +-- -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... +-- compare a b +-- = case a of +-- D cma (VarF va) +-- -> case b of +-- D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) +-- _ -> LT +-- D _ (LitF la) +-- -> case b of +-- D _ VarF{} -> GT +-- D _ (LitF lb) -> la `compare` lb +-- _ -> LT +-- D _ (AppF af aarg) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 2#) then +-- LT +-- else +-- case b of +-- D _ (AppF bf barg) +-- -> case compare af bf of +-- LT -> LT +-- EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. +-- -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... +-- GT -> GT +-- _ -> GT +-- D _ (LamF _abind abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 3#) then +-- LT +-- else +-- case b of +-- D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') +-- -> compare abody bbody +-- _ -> GT +-- D cma (LetF as abody) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt ># 4#) then +-- LT +-- else +-- case b of +-- D cmb (LetF bs bbody) +-- -> case compare (D cma as) (D cmb bs) of +-- LT -> LT +-- EQ -> compare abody bbody +-- GT -> GT +-- _ -> GT +-- D cma (CaseF cax _cabind catype caalt) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 5#) then +-- GT +-- else +-- case b of +-- D cmb (CaseF cbx _cbbind cbtype cbalt) +-- -> case compare cax cbx of +-- LT -> LT +-- -- ROMES:TODO: Consider changing order of comparisons to a more efficient one +-- EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of +-- LT -> LT +-- EQ -> D cma caalt `compare` D cmb cbalt +-- GT -> GT +-- GT -> GT +-- _ -> LT +-- D cma (CastF cax caco) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 6#) then +-- GT +-- else +-- case b of +-- D cmb (CastF cbx cbco) +-- -> case compare cax cbx of +-- LT -> LT +-- EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) +-- GT -> GT +-- _ -> LT +-- D cma (TickF tatickish tax) +-- -> case dataToTag# b of +-- bt +-- -> if tagToEnum# (bt <# 7#) then +-- GT +-- else +-- case b of +-- D cmb (TickF tbtickish tbx) +-- -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of +-- LT -> LT +-- EQ -> tax `compare` tbx +-- GT -> GT +-- _ -> LT +-- D cma (TypeF at) +-- -> case b of +-- D _ CoercionF{} -> LT +-- D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) +-- _ -> GT +-- D cma (CoercionF aco) +-- -> case b of +-- D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) +-- _ -> GT + +--instance Eq a => Eq (DeBruijn (CoreBindF a)) where +-- D cma a == D cmb b = go a b where +-- go (NonRecF _v1 r1) (NonRecF _v2 r2) +-- = r1 == r2 -- See Note [Alpha-equality for let-bindings] + +-- go (RecF ps1) (RecF ps2) +-- = +-- -- See Note [Alpha-equality for let-bindings] +-- all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) +-- (D cmb (varType b2))) +-- bs1 bs2 +-- && rs1 == rs2 +-- where +-- (bs1,rs1) = unzip ps1 +-- (bs2,rs2) = unzip ps2 + +-- go _ _ = False + + +--instance Ord a => Ord (DeBruijn (CoreBindF a)) where +-- compare a b +-- = case a of +-- D _cma (NonRecF _ab ax) +-- -> case b of +-- D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. +-- -> ax `compare` bx +-- _ -> LT +-- D _cma (RecF as) +-- -> case b of +-- D _cmb (RecF bs) -> compare (map snd as) (map snd bs) +-- _ -> GT + + +--instance Ord a => Ord (DeBruijn (CoreAltF a)) where +-- compare a b +-- = case a of +-- D _cma (AltF ac _abs arhs) +-- -> case b of +-- D _cmb (AltF bc _bbs brhs) +-- -> case compare ac bc of +-- LT -> LT +-- EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. +-- arhs `compare` brhs +-- GT -> GT cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where @@ -359,26 +440,21 @@ cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering cmpDeBruijnCoercion (D env1 co1) (D env2 co2) = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) --- instances for debugging purposes -instance Show a => Show (DeBruijnF CoreExprF a) where - show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id - show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit - show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b - show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a - show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a - show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts - - show (DF (D _ (CastF _a _cor) )) = "CastF" - show (DF (D _ (TickF _cotick _a))) = "Tick" - show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t) - show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co - - -instance Show a => Show (BindF CoreBndr a) where - show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a - show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs) - -instance Show a => Show (AltF CoreBndr a) where +-- -- instances for debugging purposes +instance Show a => Show (CoreExprF a) where + show (VarF id) = showPprUnsafe $ text "VarF" <+> ppr id + show (FreeVarF id) = showPprUnsafe $ ppr id + show (LitF lit) = showPprUnsafe $ text "LitF" <+> ppr lit + show (AppF a b) = "AppF " ++ show a ++ " " ++ show b + show (LamF a) = "LamF " ++ show a + show (LetF b a) = "LetF " ++ show b ++ " " ++ show a + show (CaseF a alts) = "CaseF " ++ show a ++ show alts + + -- show (CastF _a _cor) = "CastF" + -- show (TickF _cotick _a) = "Tick" + show (TypeF (DBT (D _ t))) = "TypeF " ++ showPprUnsafe (ppr t) + show (CoercionF (DBC (D _ co))) = "CoercionF " ++ showPprUnsafe co + +instance Show a => Show (AltF a) where show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a - ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -64,7 +64,6 @@ import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Type import GHC.Core.Equality import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) @@ -1022,7 +1021,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = - second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + second (\g -> nabla{nabla_tm_st = ts{ts_facts = EG.rebuild g}}) $ representCoreExprEgr (makeDictsCoherent e) egraph -- Use a key in which dictionaries for the same type become equal. -- See Note [Unique dictionaries in the TmOracle CoreMap] ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -67,7 +67,6 @@ import GHC.Core.TyCon import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -173,7 +172,7 @@ data TmState lookupMatchIdMap :: Id -> Nabla -> Maybe ClassId lookupMatchIdMap id (MkNabla _ TmSt{ts_reps}) = lookupVarEnv ts_reps id --- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, +-- | Information about a match id. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set -- ('vi_rcm'). @@ -187,6 +186,9 @@ data VarInfo -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) + -- , vi_ty :: !Type + -- The type of the match-id + , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all -- at the same time (i.e. conjunctive). We need a list because of nested @@ -333,6 +335,7 @@ emptyVarInfo x -- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? lookupVarInfo :: TmState -> ClassId -> VarInfo lookupVarInfo (TmSt eg _ _) x +-- We used to only create an emptyVarInfo when we looked up that id. Now we do it always, even if we never query the Id back T_T -- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. = eg ^._class x._data @@ -841,7 +844,7 @@ instance Outputable PmEquality where -- * E-graphs to represent normalised refinment types -- -type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) +type TmEGraph = EGraph VarInfo CoreExprF -- TODO delete orphans for showing TmEGraph for debugging reasons instance Show VarInfo where show = showPprUnsafe . ppr @@ -858,13 +861,14 @@ representIdsNablas xs = execState (mapM (\x -> state (((),) . representIdNablas representId :: Id -> Nabla -> (ClassId, Nabla) representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0, ts_reps=idmp}) = case lookupVarEnv idmp x of - -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representDBCoreExpr' + -- The reason why we can't use an empty new class is that we don't account for the IdMap in the 'representCoreExprEgr' -- In particular, if we represent "reverse @a xs" in the e-graph, the -- node in which "xs" will be represented won't match the e-class id -- representing "xs", because that class doesn't contain "VarF xs" + -- (but at least we can still mkMatchIds without storing the VarF for that one) -- Nothing -> case EG.newEClass (emptyVarInfo x) eg0 of - Nothing -> case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of - (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1, ts_reps=extendVarEnv idmp x xid}) + Nothing -> case EG.add (EG.Node (FreeVarF x)) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=EG.rebuild eg1, ts_reps=extendVarEnv idmp x xid}) Just xid -> (xid, MkNabla tyst tmst) representIds :: [Id] -> Nabla -> ([ClassId], Nabla) @@ -874,7 +878,7 @@ representIds xs = runState (mapM (state . representId) xs) -- There ought to be a better way. instance Eq VarInfo where (==) a b = vi_id a == vi_id b -instance Analysis VarInfo (DeBruijnF CoreExprF) where +instance Analysis VarInfo CoreExprF where {-# INLINE makeA #-} {-# INLINE joinA #-} @@ -886,11 +890,10 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- Also, the Eq instance for DeBruijn Vars will ensure that two free -- variables with the same Id are equal and so they will be represented in -- the same e-class - makeA (DF (D _ (VarF x))) = emptyVarInfo x - makeA _ = emptyVarInfo unitDataConId -- ROMES:TODO: this is dummy information which should never be used, this is quite wrong :) - -- I think the reason we end up in this - -- situation is bc we first represent an expression and only then merge it with some Id. - -- we'd need a way to represent directly into an e-class then, to not trigger the new e-class. + makeA (FreeVarF x) = emptyVarInfo x + makeA _ = emptyVarInfo unitDataConId + -- makeA _ = Nothing + -- Always start with Nothing, and add things as we go? -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble @@ -904,7 +907,12 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- since it can fail when it is conflicting -- and that would allow us to do the merge procedure correcly here instead of in addVarCt -- we may be able to have Analysis (Effect VarInfo) (...) - joinA a b = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b + -- joinA Nothing Nothing = Nothing + -- joinA Nothing (Just b) = Just b + -- joinA (Just a) Nothing = Just a + -- joinA (Just a) (Just b) + joinA a b + = b{ vi_id = if vi_id b == unitDataConId && vi_id a /= unitDataConId then vi_id a else vi_id b , vi_pos = case (vi_pos a, vi_pos b) of ([], []) -> [] ([], x) -> x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43e1f5e572605f8d58c7a1124207f95a0fb48bbc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43e1f5e572605f8d58c7a1124207f95a0fb48bbc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:13:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 21:13:32 -0400 Subject: [Git][ghc/ghc][master] 5 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64b5e73cd8e25_23a43db56f82971b1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Basic.hs - compiler/Language/Haskell/Syntax/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/654fdb989d44e9bdc961f9af7b8171c551b37151...bea0e323c09e9e4b841a37aacd6b67e87a85e7cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/654fdb989d44e9bdc961f9af7b8171c551b37151...bea0e323c09e9e4b841a37aacd6b67e87a85e7cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:13:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 21:13:56 -0400 Subject: [Git][ghc/ghc][master] Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Message-ID: <64b5e754369ac_23a43db552c300799@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - 8 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -84,6 +84,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,7 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` + package into this reinstallable standalone package which abides by the PVP, + in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.15.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== @@ -1,17 +1,19 @@ {-# LANGUAGE LambdaCase, ScopedTypeVariables #-} -- | Platform architecture and OS --- --- We need it in ghc-boot because ghc-pkg needs it. module GHC.Platform.ArchOS ( ArchOS(..) + + -- * Architectures , Arch(..) - , OS(..) , ArmISA(..) , ArmISAExt(..) , ArmABI(..) , PPC_64ABI(..) , stringEncodeArch + + -- * Operating systems + , OS(..) , stringEncodeOS ) where @@ -27,10 +29,6 @@ data ArchOS deriving (Read, Show, Eq, Ord) -- | Architectures --- --- TODO: It might be nice to extend these constructors with information about --- what instruction set extensions an architecture might support. --- data Arch = ArchUnknown | ArchX86 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddcdd88c2c95445a87ee028f215d1e876939a4d9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddcdd88c2c95445a87ee028f215d1e876939a4d9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:14:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 21:14:49 -0400 Subject: [Git][ghc/ghc][master] JS: better implementation for plusWord64 (#23597) Message-ID: <64b5e7895cf47_23a43db56803038ea@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 1 changed file: - rts/js/arith.js Changes: ===================================== rts/js/arith.js ===================================== @@ -60,11 +60,11 @@ function h$hs_minusWord64(h1,l1,h2,l2) { } function h$hs_plusWord64(h1,l1,h2,l2) { - var a = W64(h1,l1); - var b = W64(h2,l2); - var r = BigInt.asUintN(64, a + b); - TRACE_ARITH("Word64: " + a + " + " + b + " ==> " + r) - RETURN_W64(r); + var l = l1+l2; + var rl = l>>>0; + var rh = (h1+h2+(l!=rl?1:0))>>>0; + TRACE_ARITH("Word64: " + (h1,l1) + " + " + (h2,l2) + " ==> " + (rh,rl)) + RETURN_UBX_TUP2(rh,rl); } function h$hs_timesInt64(h1,l1,h2,l2) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b55a8ea70424032c19ef85ef95c5eee8b50d55c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b55a8ea70424032c19ef85ef95c5eee8b50d55c3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:18:23 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 17 Jul 2023 21:18:23 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 10 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64b5e85f7abdd_23a43db566c306315@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - c748d65b by Ben Gamari at 2023-07-18T02:14:56+01:00 ghc-toolchain: Initial commit - - - - - 1c139b5d by Rodrigo Mesquita at 2023-07-18T02:14:56+01:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - 4b8c0553 by Rodrigo Mesquita at 2023-07-18T02:14:56+01:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aebfe1bf41d809b2cbc5d16d7a5053c818c6af41...4b8c05537c789f50182799ee18394c3ba974a621 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aebfe1bf41d809b2cbc5d16d7a5053c818c6af41...4b8c05537c789f50182799ee18394c3ba974a621 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 01:46:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 17 Jul 2023 21:46:01 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64b5eed961c6d_23a43db56583137e0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - cc00f623 by sheaf at 2023-07-17T21:45:54-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 48dc6714 by Krzysztof Gogolewski at 2023-07-17T21:45:55-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - b763f2c1 by Jaro Reinders at 2023-07-17T21:45:56-04:00 Add StgFromCore and StgCodeGen linting - - - - - 30 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d094629327b827718cfdfd1336f1f1e24aee2973...b763f2c167af60f2c6a3b14343c7c7877b055c35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d094629327b827718cfdfd1336f1f1e24aee2973...b763f2c167af60f2c6a3b14343c7c7877b055c35 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 02:41:44 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 17 Jul 2023 22:41:44 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] 11 commits: rnImports: var shouldn't import NoFldSelectors Message-ID: <64b5fbe848681_23a43db58883273dd@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 643b1dae by Vladislav Zavialov at 2023-07-18T04:40:43+02:00 Visible forall in types of terms: Part 1 This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Unbound.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2237142e2d19299a9e42ddc6272bbac01b2e1865...643b1dae62f41280850855aaaf29d3742c648874 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2237142e2d19299a9e42ddc6272bbac01b2e1865...643b1dae62f41280850855aaaf29d3742c648874 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 06:57:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 18 Jul 2023 02:57:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Do primop rep-poly checks when instantiating Message-ID: <64b637d31a26f_23a43db55403697a1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 20cbac8c by sheaf at 2023-07-18T02:57:17-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - fa80e478 by Krzysztof Gogolewski at 2023-07-18T02:57:17-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 4c3466d1 by Krzysztof Gogolewski at 2023-07-18T02:57:18-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - ed41ef9d by Jaro Reinders at 2023-07-18T02:57:18-04:00 Add StgFromCore and StgCodeGen linting - - - - - 27 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/Instantiate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b763f2c167af60f2c6a3b14343c7c7877b055c35...ed41ef9d42a7a8a6adb1610840c2bb7aea53e282 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b763f2c167af60f2c6a3b14343c7c7877b055c35...ed41ef9d42a7a8a6adb1610840c2bb7aea53e282 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 07:37:42 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 18 Jul 2023 03:37:42 -0400 Subject: [Git][ghc/ghc][wip/uniqset-fusion] compiler/Types: Ensure that fromList-type operations can fuse Message-ID: <64b64146d90b1_23a43d199c0c3438499a@gitlab.mail> Sylvain Henry pushed to branch wip/uniqset-fusion at Glasgow Haskell Compiler / GHC Commits: 23a23c71 by Ben Gamari at 2023-07-18T09:36:53+02:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 3 changed files: - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs Changes: ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -212,13 +212,16 @@ addToUDFM_C f m k v = addToUDFM_C_Directly f m (getUnique k) v addListToUDFM :: Uniquable key => UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) +{-# INLINEABLE addListToUDFM #-} addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) +{-# INLINEABLE addListToUDFM_Directly #-} addListToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) +{-# INLINEABLE addListToUDFM_Directly_C #-} delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -139,9 +139,11 @@ zipToUFM ks vs = assert (length ks == length vs ) innerZip emptyUFM ks vs listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM +{-# INLINEABLE listToUFM #-} listToUFM_Directly :: [(Unique, elt)] -> UniqFM key elt listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM +{-# INLINEABLE listToUFM_Directly #-} listToIdentityUFM :: Uniquable key => [key] -> UniqFM key key listToIdentityUFM = foldl' (\m x -> addToUFM m x x) emptyUFM @@ -152,6 +154,7 @@ listToUFM_C -> [(key, elt)] -> UniqFM key elt listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM +{-# INLINEABLE listToUFM_C #-} addToUFM :: Uniquable key => UniqFM key elt -> key -> elt -> UniqFM key elt addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m) ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -74,12 +74,14 @@ unitUniqSet x = UniqSet $ unitUFM x x mkUniqSet :: Uniquable a => [a] -> UniqSet a mkUniqSet = foldl' addOneToUniqSet emptyUniqSet +{-# INLINEABLE mkUniqSet #-} addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x) addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a addListToUniqSet = foldl' addOneToUniqSet +{-# INLINEABLE addListToUniqSet #-} delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a) @@ -89,10 +91,12 @@ delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u) delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l) +{-# INLINEABLE delListFromUniqSet #-} delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a delListFromUniqSet_Directly (UniqSet s) l = UniqSet (delListFromUFM_Directly s l) +{-# INLINEABLE delListFromUniqSet_Directly #-} unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23a23c71b447549baad704790a5bda0ce13a1c3c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/23a23c71b447549baad704790a5bda0ce13a1c3c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 08:26:37 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 18 Jul 2023 04:26:37 -0400 Subject: [Git][ghc/ghc][wip/T17521] Better tests Message-ID: <64b64cbdd8314_23a43d199788e44021d2@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 410d3c72 by Jaro Reinders at 2023-07-18T10:26:29+02:00 Better tests - - - - - 4 changed files: - testsuite/tests/unlifted-datatypes/should_compile/TopLevel.stderr - + testsuite/tests/unlifted-datatypes/should_compile/TopLevelSGraf.hs - testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs - testsuite/tests/unlifted-datatypes/should_compile/all.T Changes: ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevel.stderr ===================================== @@ -1,18 +1,16 @@ -[1 of 3] Compiling TopLevela ( TopLevela.hs, TopLevela.o ) ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 12, types: 6, coercions: 0, joins: 0/0} + = {terms: 18, types: 8, coercions: 0, joins: 0/0} -x3 = USucc UZero +x5 = USucc UZero + +x4 = USucc x5 + +x3 = USucc x4 x2 = USucc x3 x1 = USucc x2 x = Box x1 - - - -[2 of 3] Compiling Main ( TopLevel.hs, TopLevel.o ) -[3 of 3] Linking TopLevel ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevelSGraf.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE UnliftedDatatypes #-} + +module TopLevelSGraf where + +import GHC.Exts +import Data.Kind + +type Box :: UnliftedType -> Type +data Box a = Box a +type UMaybe :: Type -> UnliftedType +data UMaybe a = UJust !a | UNothing + +y :: Int +y = sum [0..100] +{-# OPAQUE y #-} + +x :: Box (UMaybe Int) +x = Box (UJust y) +{-# OPAQUE x #-} + +main = case x of + Box (UJust n) -> print n ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs ===================================== @@ -11,4 +11,4 @@ data UNat = UZero | USucc UNat type Box :: UnliftedType -> Type data Box a = Box a -x = Box (USucc (USucc (USucc UZero))) +x = Box (USucc (USucc (USucc (USucc (USucc UZero))))) ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -2,6 +2,7 @@ test('UnlDataMonoSigs', normal, compile, ['']) test('UnlDataPolySigs', normal, compile, ['']) test('UnlDataFams', normal, compile, ['']) test('UnlDataUsersGuide', normal, compile, ['']) -test('TopLevel', normal, multimod_compile, ['TopLevel', '-O']) +test('TopLevel', normal, multimod_compile, ['TopLevel', '-O -v0']) test('TopLevelStgRewrite', normal, multimod_compile, ['TopLevelStgRewrite', '-v0']) test('TopLevelStgRewriteBoot', normal, multimod_compile, ['TopLevelStgRewriteBoot', '-O -v0']) +test('TopLevelSGraf', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/410d3c727482478a26280f0498379f4cc05650fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/410d3c727482478a26280f0498379f4cc05650fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 09:38:43 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 18 Jul 2023 05:38:43 -0400 Subject: [Git][ghc/ghc][wip/T17521] Fix lint Message-ID: <64b65da3eb3e0_23a43d199942c4430677@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 7b1725e2 by Jaro Reinders at 2023-07-18T11:38:36+02:00 Fix lint - - - - - 1 changed file: - compiler/GHC/Core/Lint.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -585,7 +585,7 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty || (isNonRec rec_flag && exprOkForSpeculation rhs) || isDataConWorkId binder || isDataConWrapId binder -- until #17521 is fixed || exprIsTickedString rhs - || isTopLevel top_lvl && isBoxedType rhs_ty && isJust (do (Var v, xs) <- pure (collectArgs rhs); pure (isDataConWorkId v && all exprIsTrivial xs))) + || isTopLevel top_lvl && isBoxedType rhs_ty && isJust (do (Var v, xs) <- pure (collectArgs rhs); guard (isDataConWorkId v && all exprIsTrivial xs))) (badBndrTyMsg binder (text "unlifted")) -- Check that if the binder is at the top level and has type Addr#, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b1725e2356d92088ebbc3e586dcbe64ae8e83b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7b1725e2356d92088ebbc3e586dcbe64ae8e83b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 09:38:58 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 18 Jul 2023 05:38:58 -0400 Subject: [Git][ghc/ghc][wip/T17521] Avoid banged fields Message-ID: <64b65db27cb9_23a43d199a45c043134a@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 9cad0331 by Jaro Reinders at 2023-07-18T11:38:49+02:00 Avoid banged fields - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2038,13 +2038,16 @@ exprIsTickedString = isJust . exprIsTickedString_maybe exprIsNestedTrivialConApp :: CoreExpr -> Bool exprIsNestedTrivialConApp x | (Var v, xs) <- collectArgs x - = isDataConWorkId v && all go xs + , Just dc <- isDataConWorkId_maybe v + = and (zipWith f (map isBanged (dataConImplBangs dc)) xs) where - go x - | exprIsTrivial x + f bang x + | not bang + , exprIsTrivial x = True | (Var v, xs) <- collectArgs x - = isDataConWorkId v && all go xs + , Just dc <- isDataConWorkId_maybe v + = and (zipWith f (map isBanged (dataConImplBangs dc)) xs) | otherwise = False exprIsNestedTrivialConApp _ = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cad0331a286d05703fcf031430070ca5e3912dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9cad0331a286d05703fcf031430070ca5e3912dc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 09:52:30 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 18 Jul 2023 05:52:30 -0400 Subject: [Git][ghc/ghc][wip/T17521] Fix whitespace Message-ID: <64b660decccd1_23a43d199c0c484422f9@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 2c675b03 by Jaro Reinders at 2023-07-18T11:52:25+02:00 Fix whitespace - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2047,7 +2047,7 @@ exprIsNestedTrivialConApp x = True | (Var v, xs) <- collectArgs x , Just dc <- isDataConWorkId_maybe v - = and (zipWith f (map isBanged (dataConImplBangs dc)) xs) + = and (zipWith f (map isBanged (dataConImplBangs dc)) xs) | otherwise = False exprIsNestedTrivialConApp _ = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c675b03bd7127c2e23f0966c2142a4eb446fd1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c675b03bd7127c2e23f0966c2142a4eb446fd1e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 10:19:24 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 18 Jul 2023 06:19:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fc-hook Message-ID: <64b6672cf3494_23a43d199a47c8451042@gitlab.mail> Zubin pushed new branch wip/fc-hook at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fc-hook You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 10:37:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 18 Jul 2023 06:37:58 -0400 Subject: [Git][ghc/ghc][master] Do primop rep-poly checks when instantiating Message-ID: <64b66b867bdf3_23a43d199788a8462591@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 27 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Types/Origin.hs-boot - compiler/GHC/Tc/Utils/Concrete.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/TcType.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/889c2bbb06e8bd9193a4f5fbe8633593405b52d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/889c2bbb06e8bd9193a4f5fbe8633593405b52d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 10:38:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 18 Jul 2023 06:38:32 -0400 Subject: [Git][ghc/ghc][master] Core Lint: distinguish let and letrec in locations Message-ID: <64b66ba897685_23a43d199942c4466140@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 3 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Stg/Lint.hs - testsuite/tests/corelint/T21115b.stderr Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -565,9 +565,9 @@ lintRecBindings top_lvl pairs thing_inside ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty ; return ue } -lintLetBody :: [LintedId] -> CoreExpr -> LintM (LintedType, UsageEnv) -lintLetBody bndrs body - = do { (body_ty, body_ue) <- addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) +lintLetBody :: LintLocInfo -> [LintedId] -> CoreExpr -> LintM (LintedType, UsageEnv) +lintLetBody loc bndrs body + = do { (body_ty, body_ue) <- addLoc loc (lintCoreExpr body) ; mapM_ (lintJoinBndrType body_ty) bndrs ; return (body_ty, body_ue) } @@ -900,7 +900,7 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) -- Now extend the substitution so we -- take advantage of it in the body ; extendTvSubstL tv ty' $ - addLoc (BodyOfLetRec [tv]) $ + addLoc (BodyOfLet tv) $ lintCoreExpr body } } lintCoreExpr (Let (NonRec bndr rhs) body) @@ -912,7 +912,7 @@ lintCoreExpr (Let (NonRec bndr rhs) body) -- Now lint the binder ; lintBinder LetBind bndr $ \bndr' -> do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty - ; addAliasUE bndr let_ue (lintLetBody [bndr'] body) } } + ; addAliasUE bndr let_ue (lintLetBody (BodyOfLet bndr') [bndr'] body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate @@ -932,7 +932,7 @@ lintCoreExpr e@(Let (Rec pairs) body) -- See Note [Multiplicity of let binders] in Var ; ((body_type, body_ue), ues) <- lintRecBindings NotTopLevel pairs $ \ bndrs' -> - lintLetBody bndrs' body + lintLetBody (BodyOfLetRec bndrs') bndrs' body ; return (body_type, body_ue `addUE` scaleUE ManyTy (foldr1 addUE ues)) } where bndrs = map fst pairs @@ -3177,7 +3177,8 @@ data LintLocInfo | LambdaBodyOf Id -- The lambda-binder | RuleOf Id -- Rules attached to a binder | UnfoldingOf Id -- Unfolding of a binder - | BodyOfLetRec [Id] -- One of the binders + | BodyOfLet Id -- The let-bound variable + | BodyOfLetRec [Id] -- The binders of the let | CaseAlt CoreAlt -- Case alternative | CasePat CoreAlt -- The *pattern* of the case alternative | CaseTy CoreExpr -- The type field of a case expression @@ -3467,11 +3468,14 @@ dumpLoc (RuleOf b) dumpLoc (UnfoldingOf b) = (getSrcLoc b, text "In the unfolding of" <+> pp_binder b) +dumpLoc (BodyOfLet b) + = (noSrcLoc, text "In the body of a let with binder" <+> pp_binder b) + dumpLoc (BodyOfLetRec []) = (noSrcLoc, text "In body of a letrec with no binders") dumpLoc (BodyOfLetRec bs@(b:_)) - = ( getSrcLoc b, text "In the body of letrec with binders" <+> pp_binders bs) + = ( getSrcLoc b, text "In the body of a letrec with binders" <+> pp_binders bs) dumpLoc (AnExpr e) = (noSrcLoc, text "In the expression:" <+> ppr e) ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -283,13 +283,13 @@ lintStgExpr (StgOpApp _ args _) = lintStgExpr (StgLet _ binds body) = do binders <- lintStgBinds NotTopLevel binds - addLoc (BodyOfLetRec binders) $ + addLoc (BodyOfLet binders) $ addInScopeVars binders $ lintStgExpr body lintStgExpr (StgLetNoEscape _ binds body) = do binders <- lintStgBinds NotTopLevel binds - addLoc (BodyOfLetRec binders) $ + addLoc (BodyOfLet binders) $ addInScopeVars binders $ lintStgExpr body @@ -446,7 +446,7 @@ data LintFlags = LintFlags { lf_unarised :: !Bool data LintLocInfo = RhsOf Id -- The variable bound | LambdaBodyOf [Id] -- The lambda-binder - | BodyOfLetRec [Id] -- One of the binders + | BodyOfLet [Id] -- The binders of the let dumpLoc :: LintLocInfo -> (SrcSpan, SDoc) dumpLoc (RhsOf v) = @@ -454,8 +454,8 @@ dumpLoc (RhsOf v) = dumpLoc (LambdaBodyOf bs) = (srcLocSpan (getSrcLoc (head bs)), text " [in body of lambda with binders " <> pp_binders bs <> char ']' ) -dumpLoc (BodyOfLetRec bs) = - (srcLocSpan (getSrcLoc (head bs)), text " [in body of letrec with binders " <> pp_binders bs <> char ']' ) +dumpLoc (BodyOfLet bs) = + (srcLocSpan (getSrcLoc (head bs)), text " [in body of let with binders " <> pp_binders bs <> char ']' ) pp_binders :: [Id] -> SDoc ===================================== testsuite/tests/corelint/T21115b.stderr ===================================== @@ -4,8 +4,8 @@ T21115b.hs:9:1: warning: scrut ds In the RHS of foo :: Double# -> Int# In the body of lambda with binder ds :: Double# - In the body of letrec with binders fail :: (# #) -> Int# - In the body of letrec with binders fail :: (# #) -> Int# + In the body of a let with binder fail :: (# #) -> Int# + In the body of a let with binder fail :: (# #) -> Int# Substitution: From gitlab at gitlab.haskell.org Tue Jul 18 10:39:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 18 Jul 2023 06:39:25 -0400 Subject: [Git][ghc/ghc][master] Use extended literals when deriving Show Message-ID: <64b66bddd43ec_23a43d199788a8469857@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 4 changed files: - compiler/GHC/Tc/Deriv/Generate.hs - docs/users_guide/9.8.1-notes.rst - testsuite/tests/primops/should_run/ShowPrim.hs - testsuite/tests/primops/should_run/ShowPrim.stdout Changes: ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1282,8 +1282,7 @@ gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon show_arg b arg_ty | isUnliftedType arg_ty -- See Note [Deriving and unboxed types] in GHC.Tc.Deriv.Infer - = with_conv $ - nlHsApps compose_RDR + = nlHsApps compose_RDR [mk_shows_app boxed_arg, mk_showString_app postfixMod] | otherwise = mk_showsPrec_app arg_prec arg @@ -1291,14 +1290,6 @@ gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon arg = nlHsVar b boxed_arg = box "Show" arg arg_ty postfixMod = assoc_ty_id "Show" postfixModTbl arg_ty - with_conv expr - | (Just conv) <- assoc_ty_id_maybe primConvTbl arg_ty = - nested_compose_Expr - [ mk_showString_app ("(" ++ conv ++ " ") - , expr - , mk_showString_app ")" - ] - | otherwise = expr -- Fixity stuff is_infix = dataConIsInfix data_con @@ -1514,9 +1505,8 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstrTag_RDR, eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR , eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR , eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR, - word8ToWord_RDR , int8ToInt_RDR , - word16ToWord_RDR, int16ToInt_RDR, - word32ToWord_RDR, int32ToInt_RDR + int8DataCon_RDR, int16DataCon_RDR, int32DataCon_RDR, int64DataCon_RDR, + word8DataCon_RDR, word16DataCon_RDR, word32DataCon_RDR, word64DataCon_RDR :: RdrName gfoldl_RDR = varQual_RDR gENERICS (fsLit "gfoldl") gunfold_RDR = varQual_RDR gENERICS (fsLit "gunfold") @@ -1619,15 +1609,14 @@ leDouble_RDR = varQual_RDR gHC_PRIM (fsLit "<=##") gtDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">##" ) geDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">=##") -word8ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word8ToWord#") -int8ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int8ToInt#") - -word16ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word16ToWord#") -int16ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int16ToInt#") - -word32ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word32ToWord#") -int32ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int32ToInt#") - +int8DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I8#") +int16DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I16#") +int32DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I32#") +int64DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I64#") +word8DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W8#") +word16DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W16#") +word32DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W32#") +word64DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W64#") {- ************************************************************************ * * @@ -2416,7 +2405,6 @@ ordOpTbl -- A mapping from a primitive type to a function that constructs its boxed -- version. --- NOTE: Int8#/Word8# will become Int/Word. boxConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] boxConTbl = [ (charPrimTy , nlHsApp (nlHsVar $ getRdrName charDataCon)) @@ -2424,28 +2412,20 @@ boxConTbl = , (wordPrimTy , nlHsApp (nlHsVar $ getRdrName wordDataCon )) , (floatPrimTy , nlHsApp (nlHsVar $ getRdrName floatDataCon )) , (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon)) - , (int8PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int8ToInt_RDR)) - , (word8PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word8ToWord_RDR)) - , (int16PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int16ToInt_RDR)) - , (word16PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word16ToWord_RDR)) - , (int32PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int32ToInt_RDR)) - , (word32PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word32ToWord_RDR)) + , (int8PrimTy, nlHsApp (nlHsVar int8DataCon_RDR)) + , (word8PrimTy, nlHsApp (nlHsVar word8DataCon_RDR)) + , (int16PrimTy, nlHsApp (nlHsVar int16DataCon_RDR)) + , (word16PrimTy, nlHsApp (nlHsVar word16DataCon_RDR)) + , (int32PrimTy, nlHsApp (nlHsVar int32DataCon_RDR)) + , (word32PrimTy, nlHsApp (nlHsVar word32DataCon_RDR)) + , (int64PrimTy, nlHsApp (nlHsVar int64DataCon_RDR)) + , (word64PrimTy, nlHsApp (nlHsVar word64DataCon_RDR)) ] -- | A table of postfix modifiers for unboxed values. +-- Following https://github.com/ghc-proposals/ghc-proposals/pull/596, +-- we use the ExtendedLiterals syntax for sized literals. postfixModTbl :: [(Type, String)] postfixModTbl = [(charPrimTy , "#" ) @@ -2453,22 +2433,14 @@ postfixModTbl ,(wordPrimTy , "##") ,(floatPrimTy , "#" ) ,(doublePrimTy, "##") - ,(int8PrimTy, "#") - ,(word8PrimTy, "##") - ,(int16PrimTy, "#") - ,(word16PrimTy, "##") - ,(int32PrimTy, "#") - ,(word32PrimTy, "##") - ] - -primConvTbl :: [(Type, String)] -primConvTbl = - [ (int8PrimTy, "intToInt8#") - , (word8PrimTy, "wordToWord8#") - , (int16PrimTy, "intToInt16#") - , (word16PrimTy, "wordToWord16#") - , (int32PrimTy, "intToInt32#") - , (word32PrimTy, "wordToWord32#") + ,(int8PrimTy , "#Int8") + ,(word8PrimTy , "#Word8") + ,(int16PrimTy , "#Int16") + ,(word16PrimTy, "#Word16") + ,(int32PrimTy , "#Int32") + ,(word32PrimTy, "#Word32") + ,(int64PrimTy , "#Int64") + ,(word64PrimTy, "#Word64") ] litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -9,6 +9,10 @@ Language - There is a new extension :extension:`ExtendedLiterals`, which enables sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. See the GHC proposal `#451 `_. + Derived ``Show`` instances for datatypes containing sized literals (``Int8#``, ``Word8#``, ``Int16#`` etc.) + now use the extended literal syntax, per GHC proposal `#596 `_. + Furthermore, it is now possible to derive ``Show`` for datatypes containing + fields of types ``Int64#`` and ``Word64#``. - GHC Proposal `#425 `_ ===================================== testsuite/tests/primops/should_run/ShowPrim.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MagicHash, ExtendedLiterals #-} module Main where @@ -13,17 +13,24 @@ data Test2 = Test2 Int16# Word16# data Test3 = Test3 Int32# Word32# deriving (Show) +data Test4 = Test4 Int64# Word64# + deriving (Show) + test1 :: Test1 -test1 = Test1 (intToInt8# 1#) (wordToWord8# 2##) +test1 = Test1 1#Int8 2#Word8 test2 :: Test2 -test2 = Test2 (intToInt16# 1#) (wordToWord16# 2##) +test2 = Test2 1#Int16 2#Word16 test3 :: Test3 -test3 = Test3 (intToInt32# 1#) (wordToWord32# 2##) +test3 = Test3 1#Int32 2#Word32 + +test4 :: Test4 +test4 = Test4 -9223372036854775808#Int64 18446744073709551610#Word64 main :: IO () main = do print test1 print test2 print test3 + print test4 ===================================== testsuite/tests/primops/should_run/ShowPrim.stdout ===================================== @@ -1,3 +1,4 @@ -Test1 (intToInt8# 1#) (wordToWord8# 2##) -Test2 (intToInt16# 1#) (wordToWord16# 2##) -Test3 (intToInt32# 1#) (wordToWord32# 2##) +Test1 1#Int8 2#Word8 +Test2 1#Int16 2#Word16 +Test3 1#Int32 2#Word32 +Test4 -9223372036854775808#Int64 18446744073709551610#Word64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/787bae96f77562e603b6e9ebb86139cc5d120b8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/787bae96f77562e603b6e9ebb86139cc5d120b8d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 10:40:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 18 Jul 2023 06:40:08 -0400 Subject: [Git][ghc/ghc][master] Add StgFromCore and StgCodeGen linting Message-ID: <64b66c082cbf_23a43d199c0c34473343@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 1 changed file: - compiler/GHC/Stg/Pipeline.hs Changes: ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -74,6 +74,7 @@ stg2stg :: Logger -> IO ([(CgStgTopBinding,IdSet)], StgCgInfos) -- output program stg2stg logger extra_vars opts this_mod binds = do { dump_when Opt_D_dump_stg_from_core "Initial STG:" binds + ; stg_linter False "StgFromCore" binds ; showPass logger "Stg2Stg" -- Do the main business! ; binds' <- runStgM 'g' $ @@ -92,10 +93,12 @@ stg2stg logger extra_vars opts this_mod binds ; let (binds_sorted_with_fvs, imp_fvs) = unzip (depSortWithAnnotStgPgm this_mod binds') -- See Note [Tag inference for interactive contexts] ; (cg_binds, cg_infos) <- inferTags (stgPipeline_pprOpts opts) (stgPipeline_forBytecode opts) logger this_mod binds_sorted_with_fvs + ; stg_linter False "StgCodeGen" cg_binds ; pure (zip cg_binds imp_fvs, cg_infos) } where + stg_linter :: (BinderP a ~ Id, OutputablePass a) => Bool -> String -> [GenStgTopBinding a] -> IO () stg_linter unarised | Just diag_opts <- stgPipeline_lint opts = lintStgTopBindings View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/257f1567395be441ebf7ada996e4edf36abbe7e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/257f1567395be441ebf7ada996e4edf36abbe7e9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 11:04:53 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 18 Jul 2023 07:04:53 -0400 Subject: [Git][ghc/ghc][wip/T17521] More and better tests Message-ID: <64b671d5da1fd_23a43d199942c44783be@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 63ca8a46 by Jaro Reinders at 2023-07-18T13:04:43+02:00 More and better tests - - - - - 4 changed files: - testsuite/tests/unlifted-datatypes/should_compile/TopLevel.hs - testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.hs - + testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.stderr - testsuite/tests/unlifted-datatypes/should_compile/all.T Changes: ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevel.hs ===================================== @@ -1,7 +1,14 @@ -import TopLevela +{-# OPTIONS_GHC -ddump-simpl -ddump-simpl -dsuppress-all -dno-typeable-binds -dsuppress-uniques #-} +{-# LANGUAGE UnliftedDatatypes #-} +module TopLevel where -toInt UZero = 0 -toInt (USucc x) = 1 + toInt x +import GHC.Exts (UnliftedType) +import Data.Kind (Type) -main = case x of - Box y -> print (toInt y) +type UNat :: UnliftedType +data UNat = UZero | USucc UNat + +type Box :: UnliftedType -> Type +data Box a = Box a + +x = Box (USucc (USucc (USucc (USucc (USucc UZero))))) ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevela.hs → testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.hs ===================================== @@ -1,14 +1,20 @@ {-# OPTIONS_GHC -ddump-simpl -ddump-simpl -dsuppress-all -dno-typeable-binds -dsuppress-uniques #-} {-# LANGUAGE UnliftedDatatypes #-} -module TopLevela where +module TopLevelMixBangs where import GHC.Exts (UnliftedType) import Data.Kind (Type) type UNat :: UnliftedType -data UNat = UZero | USucc UNat +data UNat = UZero | USucc !LNat + +data LNat = LZero | LSucc UNat type Box :: UnliftedType -> Type data Box a = Box a -x = Box (USucc (USucc (USucc (USucc (USucc UZero))))) +x = Box (USucc xa) +xa = LSucc (USucc xb) +xb = LSucc (USucc xc) +xc = LSucc (USucc xd) +xd = LZero ===================================== testsuite/tests/unlifted-datatypes/should_compile/TopLevelMixBangs.stderr ===================================== @@ -0,0 +1,28 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 33, types: 15, coercions: 0, joins: 0/0} + +$WUSucc + = \ conrep -> case conrep of conrep1 { __DEFAULT -> USucc conrep1 } + +xd = LZero + +xc1 = USucc LZero + +xc = LSucc xc1 + +xb1 = USucc xc + +xb = LSucc xb1 + +xa1 = USucc xb + +xa = LSucc xa1 + +x1 = USucc xa + +x = Box x1 + + + ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -2,7 +2,8 @@ test('UnlDataMonoSigs', normal, compile, ['']) test('UnlDataPolySigs', normal, compile, ['']) test('UnlDataFams', normal, compile, ['']) test('UnlDataUsersGuide', normal, compile, ['']) -test('TopLevel', normal, multimod_compile, ['TopLevel', '-O -v0']) +test('TopLevel', normal, compile, ['-O -v0']) +test('TopLevelMixBangs', normal, compile, ['-O -v0']) test('TopLevelStgRewrite', normal, multimod_compile, ['TopLevelStgRewrite', '-v0']) test('TopLevelStgRewriteBoot', normal, multimod_compile, ['TopLevelStgRewriteBoot', '-O -v0']) test('TopLevelSGraf', normal, compile, ['-O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63ca8a4683069a84f6177b56c1ac2d78e410f976 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63ca8a4683069a84f6177b56c1ac2d78e410f976 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 11:53:25 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 18 Jul 2023 07:53:25 -0400 Subject: [Git][ghc/ghc][wip/T17521] Use RepStrictness instead of ImplBang Message-ID: <64b67d354fae_3b5ddb740854562@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 596ecdf0 by Jaro Reinders at 2023-07-18T13:53:16+02:00 Use RepStrictness instead of ImplBang - - - - - 1 changed file: - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -2039,15 +2039,15 @@ exprIsNestedTrivialConApp :: CoreExpr -> Bool exprIsNestedTrivialConApp x | (Var v, xs) <- collectArgs x , Just dc <- isDataConWorkId_maybe v - = and (zipWith f (map isBanged (dataConImplBangs dc)) xs) + = and (zipWith field_ok (map isMarkedStrict (dataConRepStrictness dc)) xs) where - f bang x - | not bang + field_ok strict x + | not strict , exprIsTrivial x = True | (Var v, xs) <- collectArgs x , Just dc <- isDataConWorkId_maybe v - = and (zipWith f (map isBanged (dataConImplBangs dc)) xs) + = and (zipWith field_ok (map isMarkedStrict (dataConRepStrictness dc)) xs) | otherwise = False exprIsNestedTrivialConApp _ = False View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/596ecdf04203dd163bc5812c242a4bc098480e45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/596ecdf04203dd163bc5812c242a4bc098480e45 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 12:23:39 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 18 Jul 2023 08:23:39 -0400 Subject: [Git][ghc/ghc][wip/T17521] 27 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64b6844b5f6fe_3b5ddb744459615@gitlab.mail> Jaro Reinders pushed to branch wip/T17521 at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 45a85deb by Jaro Reinders at 2023-07-18T14:23:10+02:00 Allow unlifted trivial datacon applications - - - - - c9393225 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Allow nested floating - - - - - b4b7f9ad by Jaro Reinders at 2023-07-18T14:23:10+02:00 Fixes - - - - - 8fc02d54 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Fix doc - - - - - 64909fb8 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Add test - - - - - 2b220bc2 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Better test - - - - - 3d83b61b by Jaro Reinders at 2023-07-18T14:23:10+02:00 Relax lint - - - - - 7c9be26f by Jaro Reinders at 2023-07-18T14:23:10+02:00 Add exception to letrect invariant - - - - - 59d536ef by Jaro Reinders at 2023-07-18T14:23:10+02:00 Add stg rewrites test - - - - - b1008671 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Add hs-boot test - - - - - 001b5a67 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Better tests - - - - - 1f242469 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Fix lint - - - - - 27795260 by Jaro Reinders at 2023-07-18T14:23:10+02:00 Avoid banged fields - - - - - a05ebeb7 by Jaro Reinders at 2023-07-18T14:23:11+02:00 Fix whitespace - - - - - 7104a2c7 by Jaro Reinders at 2023-07-18T14:23:11+02:00 More and better tests - - - - - be5b1dda by Jaro Reinders at 2023-07-18T14:23:11+02:00 Use RepStrictness instead of ImplBang - - - - - 30 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/596ecdf04203dd163bc5812c242a4bc098480e45...be5b1dda18ae86b5c1a40c2944f75caeec250933 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/596ecdf04203dd163bc5812c242a4bc098480e45...be5b1dda18ae86b5c1a40c2944f75caeec250933 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 12:57:24 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Tue, 18 Jul 2023 08:57:24 -0400 Subject: [Git][ghc/ghc][wip/fc-hook] compiler: Turn `FinderCache` into a record of operations so that GHC API clients can Message-ID: <64b68c348b4a9_3b5ddb73f4944a5@gitlab.mail> Zubin pushed to branch wip/fc-hook at Glasgow Haskell Compiler / GHC Commits: 94ab8c96 by Zubin Duggal at 2023-07-18T18:27:01+05:30 compiler: Turn `FinderCache` into a record of operations so that GHC API clients can have full control over how its state is managed by overriding `hsc_FC`. Also removes the `uncacheModule` function as this wasn't being used by anything since 1893ba12fe1fa2ade35a62c336594afcd569736e Fixes #23604 - - - - - 2 changed files: - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -5,15 +5,15 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} -- | Module finder module GHC.Unit.Finder ( FindResult(..), InstalledFindResult(..), FinderOpts(..), - FinderCache, + FinderCache(..), initFinderCache, - flushFinderCaches, findImportedModule, findPluginModule, findExactModule, @@ -26,14 +26,10 @@ module GHC.Unit.Finder ( mkObjPath, addModuleToFinder, addHomeModuleToFinder, - uncacheModule, mkStubPaths, findObjectLinkableMaybe, findObjectLinkable, - - -- Hash cache - lookupFileCache ) where import GHC.Prelude @@ -89,41 +85,35 @@ type BaseName = String -- Basename of file initFinderCache :: IO FinderCache -initFinderCache = FinderCache <$> newIORef emptyInstalledModuleEnv - <*> newIORef M.empty - --- remove all the home modules from the cache; package modules are --- assumed to not move around during a session; also flush the file hash --- cache -flushFinderCaches :: FinderCache -> UnitEnv -> IO () -flushFinderCaches (FinderCache ref file_ref) ue = do - atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ()) - atomicModifyIORef' file_ref $ \_ -> (M.empty, ()) - where - is_ext mod _ = not (isUnitEnvInstalledModule ue mod) - -addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO () -addToFinderCache (FinderCache ref _) key val = - atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ()) - -removeFromFinderCache :: FinderCache -> InstalledModule -> IO () -removeFromFinderCache (FinderCache ref _) key = - atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ()) - -lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult) -lookupFinderCache (FinderCache ref _) key = do - c <- readIORef ref - return $! lookupInstalledModuleEnv c key - -lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint -lookupFileCache (FinderCache _ ref) key = do - c <- readIORef ref - case M.lookup key c of - Nothing -> do - hash <- getFileHash key - atomicModifyIORef' ref $ \c -> (M.insert key hash c, ()) - return hash - Just fp -> return fp +initFinderCache = do + mod_cache <- newIORef emptyInstalledModuleEnv + file_cache <- newIORef M.empty + let flushFinderCaches :: UnitEnv -> IO () + flushFinderCaches ue = do + atomicModifyIORef' mod_cache $ \fm -> (filterInstalledModuleEnv is_ext fm, ()) + atomicModifyIORef' file_cache $ \_ -> (M.empty, ()) + where + is_ext mod _ = not (isUnitEnvInstalledModule ue mod) + + addToFinderCache :: InstalledModule -> InstalledFindResult -> IO () + addToFinderCache key val = + atomicModifyIORef' mod_cache $ \c -> (extendInstalledModuleEnv c key val, ()) + + lookupFinderCache :: InstalledModule -> IO (Maybe InstalledFindResult) + lookupFinderCache key = do + c <- readIORef mod_cache + return $! lookupInstalledModuleEnv c key + + lookupFileCache :: FilePath -> IO Fingerprint + lookupFileCache key = do + c <- readIORef file_cache + case M.lookup key c of + Nothing -> do + hash <- getFileHash key + atomicModifyIORef' file_cache $ \c -> (M.insert key hash c, ()) + return hash + Just fp -> return fp + return FinderCache{..} -- ----------------------------------------------------------------------------- -- The three external entry points @@ -341,11 +331,6 @@ addHomeModuleToFinder fc home_unit mod_name loc = do addToFinderCache fc mod (InstalledFound loc mod) return (mkHomeModule home_unit mod_name) -uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO () -uncacheModule fc home_unit mod_name = do - let mod = mkHomeInstalledModule home_unit mod_name - removeFromFinderCache fc mod - -- ----------------------------------------------------------------------------- -- The internal workers ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -1,6 +1,7 @@ module GHC.Unit.Finder.Types ( FinderCache (..) , FinderCacheState + , FileCacheState , FindResult (..) , InstalledFindResult (..) , FinderOpts(..) @@ -12,8 +13,8 @@ import GHC.Unit import qualified Data.Map as M import GHC.Fingerprint import GHC.Platform.Ways +import GHC.Unit.Env -import Data.IORef import GHC.Data.FastString import qualified Data.Set as Set @@ -24,8 +25,17 @@ import qualified Data.Set as Set -- type FinderCacheState = InstalledModuleEnv InstalledFindResult type FileCacheState = M.Map FilePath Fingerprint -data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState) - , fcFileCache :: (IORef FileCacheState) +data FinderCache = FinderCache { flushFinderCaches :: UnitEnv -> IO () + -- ^ remove all the home modules from the cache; package modules are + -- assumed to not move around during a session; also flush the file hash + -- cache. + , addToFinderCache :: InstalledModule -> InstalledFindResult -> IO () + -- ^ Add a found location to the cache for the module. + , lookupFinderCache :: InstalledModule -> IO (Maybe InstalledFindResult) + -- ^ Look for a location in the cache. + , lookupFileCache :: FilePath -> IO Fingerprint + -- ^ Look for the hash of a file in the cache. This should add it to the + -- cache. If the file doesn't exist, raise an IOException. } data InstalledFindResult View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94ab8c9683b58711c1abe981091b5bec8f27cadd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94ab8c9683b58711c1abe981091b5bec8f27cadd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 13:12:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 18 Jul 2023 09:12:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Do primop rep-poly checks when instantiating Message-ID: <64b68fa8afeff_3b5ddb7480107043@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - f1b032ef by Sven Tennie at 2023-07-18T09:11:58-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 829cab57 by Sven Tennie at 2023-07-18T09:11:58-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - 312ccda1 by Sven Tennie at 2023-07-18T09:11:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - b15c7f5f by Sven Tennie at 2023-07-18T09:11:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 914217e5 by Matthew Pickering at 2023-07-18T09:11:59-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 5dde7c86 by sheaf at 2023-07-18T09:12:02-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 3195da2d by Alan Zimmerman at 2023-07-18T09:12:03-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/HsToCore.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/TyCl/Build.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed41ef9d42a7a8a6adb1610840c2bb7aea53e282...3195da2d9794489becd627ccc5f4f6160d97cd7b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed41ef9d42a7a8a6adb1610840c2bb7aea53e282...3195da2d9794489becd627ccc5f4f6160d97cd7b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 14:02:56 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 18 Jul 2023 10:02:56 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] wip - add mov-imm use, remove comment Message-ID: <64b69b9095146_3a4b0fb7458303cc@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: 34a57e86 by Andreas Klebinger at 2023-07-18T16:05:06+02:00 wip - add mov-imm use, remove comment - - - - - 2 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -580,8 +580,13 @@ getRegister' config plat expr -- Those need the upper bits set. We'd either have to explicitly sign -- or figure out something smarter. Lowered to -- `MOV dst XZR` + CmmInt i w | i >= 0 + , Just imm_op <- getMovWideImm i -> do + return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) imm_op))) + CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger i))))) + CmmInt i w | isNbitEncodeable 32 i, i >= 0 -> do let half0 = fromIntegral (fromIntegral i :: Word16) half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16) ===================================== compiler/GHC/CmmToAsm/X86/Regs.hs ===================================== @@ -275,11 +275,6 @@ The fp registers are all Double registers; we don't have any RcFloat class regs. @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should never generate them. -esp, esi, edi and ebp are reserved for specific purporses o *generally* free to use because they are -reserved for reserved for - -eax ebx ecx edx - TODO: cleanup modelling float vs double registers and how they are the same class. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34a57e8600c54be93c9c2e6b7b0bfaeb5ba2dfc5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34a57e8600c54be93c9c2e6b7b0bfaeb5ba2dfc5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 14:05:17 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 18 Jul 2023 10:05:17 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] 62 commits: Drop circle-ci-job.sh Message-ID: <64b69c1da65fc_3a4b0fb74083107b@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 219bf64f by Andreas Klebinger at 2023-07-18T16:07:27+02:00 WIP: Better arm immediate handling wip wip wip w - - - - - 84c9c401 by Andreas Klebinger at 2023-07-18T16:07:27+02:00 Move adhoc reg format checks into a proper place - - - - - 068114b2 by Andreas Klebinger at 2023-07-18T16:07:27+02:00 wip - - - - - 7adfaaa6 by Andreas Klebinger at 2023-07-18T16:07:27+02:00 wip - add mov-imm use, remove comment - - - - - 16 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/Core.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34a57e8600c54be93c9c2e6b7b0bfaeb5ba2dfc5...7adfaaa6d784b834d1764b0c1a886e0e097d60f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34a57e8600c54be93c9c2e6b7b0bfaeb5ba2dfc5...7adfaaa6d784b834d1764b0c1a886e0e097d60f9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 14:29:25 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 18 Jul 2023 10:29:25 -0400 Subject: [Git][ghc/ghc][wip/bump-bytestring-0.11.5.0] 65 commits: JS: cleanup utils (#23314) Message-ID: <64b6a1c56b50b_3a4b0fb73cc569a@gitlab.mail> Matthew Pickering pushed to branch wip/bump-bytestring-0.11.5.0 at Glasgow Haskell Compiler / GHC Commits: 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 30888afc by Matthew Craven at 2023-07-18T14:28:58+00:00 Bump bytestring submodule to 0.11.5.0 - - - - - 15 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/013ac86fa19bdce2f5985b143624c5cab27b3c0f...30888afcba58d1193e620573e34618328350ecfa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/013ac86fa19bdce2f5985b143624c5cab27b3c0f...30888afcba58d1193e620573e34618328350ecfa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 14:50:02 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 18 Jul 2023 10:50:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23413 Message-ID: <64b6a69a35726_3a4b0fb740884586@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23413 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23413 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 16:03:26 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 18 Jul 2023 12:03:26 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] don't use mov alias with shifted imm Message-ID: <64b6b7ced2739_3a4b0fb743014068a@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: aab66d44 by Andreas Klebinger at 2023-07-18T18:05:46+02:00 don't use mov alias with shifted imm - - - - - 3 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -401,7 +401,6 @@ getMovWideImm n where sized_n = fromIntegral n :: Word64 trailing_zeros = countTrailingZeros sized_n --- getMovWideImm _ = Nothing -- | Arithmetic(immediate) -- Allows for 12bit immediates which can be shifted by 0 or 12 bits. @@ -582,7 +581,7 @@ getRegister' config plat expr -- `MOV dst XZR` CmmInt i w | i >= 0 , Just imm_op <- getMovWideImm i -> do - return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) imm_op))) + return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op))) CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger i))))) ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -110,6 +110,7 @@ regUsageOfInstr platform instr = case instr of LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) + MOVZ dst src -> usage (regOp src, regOp dst) MVN dst src -> usage (regOp src, regOp dst) ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -251,6 +252,7 @@ patchRegsOfInstr instr env = case instr of LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) + MOVZ o1 o2 -> MOVZ (patchOp o1) (patchOp o2) MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) @@ -616,7 +618,7 @@ data Instr | MOV Operand Operand -- rd = rn or rd = #i | MOVK Operand Operand -- | MOVN Operand Operand - -- | MOVZ Operand Operand + | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 | ORR Operand Operand Operand -- rd = rn | op2 @@ -705,6 +707,7 @@ instrCon i = LSR{} -> "LSR" MOV{} -> "MOV" MOVK{} -> "MOVK" + MOVZ{} -> "MOVZ" MVN{} -> "MVN" ORN{} -> "ORN" ORR{} -> "ORR" ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -417,6 +417,7 @@ pprInstr platform instr = case instr of | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 | otherwise -> op2 (text "\tmov") o1 o2 MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 + MOVZ o1 o2 -> op2 (text "\tmovz") o1 o2 MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aab66d446c101c6caf33522478a23fe5d743da14 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aab66d446c101c6caf33522478a23fe5d743da14 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 16:03:42 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 18 Jul 2023 12:03:42 -0400 Subject: [Git][ghc/ghc][wip/int-index/release-notes-9.10] 15 commits: rnImports: var shouldn't import NoFldSelectors Message-ID: <64b6b7de272bd_3a4b0fb73cc1417a@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/release-notes-9.10 at Glasgow Haskell Compiler / GHC Commits: c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - a2bfbbb0 by Vladislav Zavialov at 2023-07-18T16:03:32+00:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 30 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7603f6f49a452aa8d274102e8ba7887f79a7563e...a2bfbbb091739d4e4b21ec435565f957a6a838d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7603f6f49a452aa8d274102e8ba7887f79a7563e...a2bfbbb091739d4e4b21ec435565f957a6a838d3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 16:39:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 18 Jul 2023 12:39:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/enable-ghc-toolchain Message-ID: <64b6c0425d849_3a4b0fb749414932@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/enable-ghc-toolchain at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/enable-ghc-toolchain You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 16:40:15 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 18 Jul 2023 12:40:15 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] 5 commits: Do primop rep-poly checks when instantiating Message-ID: <64b6c06fb631b_3a4b0f406ce401495f4@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 2222f5f8 by Vladislav Zavialov at 2023-07-18T18:30:26+02:00 Visible forall in types of terms: Part 1 This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Stg/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/643b1dae62f41280850855aaaf29d3742c648874...2222f5f8f8f785f77ba9a179057d4603bc9530e5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/643b1dae62f41280850855aaaf29d3742c648874...2222f5f8f8f785f77ba9a179057d4603bc9530e5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 17:39:23 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 18 Jul 2023 13:39:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/pass-user-opts-ghc-toolchain Message-ID: <64b6ce4bb61ad_3a4b0fb746c167771@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/pass-user-opts-ghc-toolchain at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/pass-user-opts-ghc-toolchain You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 17:41:59 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 18 Jul 2023 13:41:59 -0400 Subject: [Git][ghc/ghc][wip/romes/enable-ghc-toolchain] 2 commits: Pass user-specified options to ghc-toolchain Message-ID: <64b6cee7a540f_3a4b0fb74801726ef@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/enable-ghc-toolchain at Glasgow Haskell Compiler / GHC Commits: eaa026a2 by Rodrigo Mesquita at 2023-07-18T18:32:34+01:00 Pass user-specified options to ghc-toolchain The current user interface to configuring target toolchains is `./configure`. In !9263 we added a new tool to configure target toolchains called `ghc-toolchain`, but the blessed way of creating these toolchains is still through configure. However, we were not passing the user-specified options given with the `./configure` invocation to the ghc-toolchain tool. This commit remedies that by storing the user options and environment variables in USER_* variables, which then get passed to GHC-toolchain. The exception to the rule is the windows bundled toolchain, which overrides the USER_* variables with whatever flags the windows bundled toolchain requires to work. We consider the bundled toolchain to be effectively the user specifying options, since the actual user delegated that configuration work. Closes #23678 - - - - - 695a74ab by Rodrigo Mesquita at 2023-07-18T18:41:45+01:00 Let's look at CI for #23681 - - - - - 6 changed files: - configure.ac - m4/fp_cpp_cmd_with_args.m4 - m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs Changes: ===================================== configure.ac ===================================== @@ -42,6 +42,15 @@ dnl works as expected, since we're slightly modifying how Autoconf dnl interprets build/host/target and how this interacts with $CC tests test -n "$target_alias" && ac_tool_prefix=$target_alias- +dnl ---------------------------------------------------------- +dnl ** Store USER specified environment variables to pass them on to +dnl ** ghc-toolchain (in m4/ghc-toolchain.m4) +USER_CFLAGS="$CFLAGS" +USER_LDFLAGS="$LDFLAGS" +USER_LIBS="$LIBS" +USER_CXXFLAGS="$CXXFLAGS" + + dnl ---------------------------------------------------------- dnl ** Find unixy sort and find commands, dnl ** which are needed by FP_SETUP_PROJECT_VERSION @@ -167,7 +176,7 @@ AC_ARG_ENABLE(ghc-toolchain, [AS_HELP_STRING([--enable-ghc-toolchain], [Whether to use the newer ghc-toolchain tool to configure ghc targets])], [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableGhcToolchain])], - [EnableGhcToolchain=NO] + [EnableGhcToolchain=YES] ) AC_SUBST([EnableGhcToolchain]) ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -45,6 +45,7 @@ AC_ARG_WITH(cpp-flags, # Use whatever flags were manually set, ignoring previously configured # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) CPP_ARGS="$CPP_ARGS $withval" + USER_CPP_ARGS="$withval" fi ], [ ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -39,6 +39,7 @@ AC_ARG_WITH(hs-cpp-flags, AC_MSG_WARN([Request to use $withval will be ignored]) else HS_CPP_ARGS=$withval + USER_HS_CPP_ARGS=$withval fi ], [ ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -127,4 +127,13 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ MergeObjsCmd="" MergeObjsArgs="" AC_PATH_PROG([Genlib],[genlib]) + + + dnl We override the USER_* flags here since the user delegated + dnl configuration to the bundled windows toolchain, and these are the + dnl options required by the bundled windows toolchain. + USER_CFLAGS="$CFLAGS" + USER_CXXFLAGS="$CXXFLAGS" + USER_HS_CPP_ARGS="$HaskellCPPArgs" + USER_LDFLAGS="$CONF_GCC_LINKER_OPTS_STAGE2" ]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -76,6 +76,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], # the usual system locations, including the PATH, we are just explicit when # calling it through configure. rm -f acargs + echo "--triple=$target" >> acargs echo "--output=$1/default.target.ghc-toolchain" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs @@ -90,9 +91,20 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs + ENABLE_GHC_TOOLCHAIN_NOT_ARG([locally-executable], [$CrossCompiling]) ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) + ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) + ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + + dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. + ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$USER_CFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LDFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LIBS]) + ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$USER_CXXFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$USER_CPP_ARGS]) + ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) INVOKE_GHC_TOOLCHAIN() ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -37,21 +37,7 @@ findCc :: String -- ^ The llvm target to use if Cc supports --target findCc llvmTarget progOpt = checking "for C compiler" $ do -- TODO: We keep the candidate order we had in configure, but perhaps -- there's a more optimal one - ccProgram' <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] - - -- FIXME: This is a dreadful hack! - -- In reality, configure should pass these options to ghc-toolchain when - -- using the bundled windows toolchain, and ghc-toolchain should drop this around. - -- See #23678 - let ccProgram = if "mingw32" `isInfixOf` llvmTarget && takeBaseName (prgPath ccProgram') == "clang" - -- we inline the is-windows check here because we need Cc to call parseTriple - then - -- Signal that we are linking against UCRT with the _UCRT macro. This is - -- necessary on windows clang to ensure correct behavior when - -- MinGW-w64 headers are in the header include path (#22159). - ccProgram' & _prgFlags %++ "--rtlib=compiler-rt -D_UCRT" - else - ccProgram' + ccProgram <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] cc' <- ignoreUnusedArgs $ Cc {ccProgram} cc <- ccSupportsTarget llvmTarget cc' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9a3ff5b995e39fe5b10139060954f7f8e36f2b6...695a74abbb0a6e55c4c2b01e7effff7c0ba5a768 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9a3ff5b995e39fe5b10139060954f7f8e36f2b6...695a74abbb0a6e55c4c2b01e7effff7c0ba5a768 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 18:26:19 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 18 Jul 2023 14:26:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23690 Message-ID: <64b6d94b1ade6_3a4b0fb73cc181739@gitlab.mail> Ben Gamari pushed new branch wip/T23690 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23690 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 18:28:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 18 Jul 2023 14:28:22 -0400 Subject: [Git][ghc/ghc][wip/T23690] 26 commits: Hadrian: enable GHCi support on riscv64 Message-ID: <64b6d9c6cee7f_3a4b0fb7458183741@gitlab.mail> Ben Gamari pushed to branch wip/T23690 at Glasgow Haskell Compiler / GHC Commits: dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - f97776c0 by Ben Gamari at 2023-07-18T14:28:15-04:00 hadrian: Allow multiple components per package Historically hadrian has supported only one component per `Package`. However, recently both `ghc-toolchain` and `hpc` have run into this limitation. Here we lift this limitation in a minimal manner, using the declared `PackageType` to choose between the components provided by the package. Fixes #23690. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56e273fe97bb4d18d132a09be1f23a64eb9ab831...f97776c0fbbabd9935020d0a87580418ee34b49e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56e273fe97bb4d18d132a09be1f23a64eb9ab831...f97776c0fbbabd9935020d0a87580418ee34b49e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 18:30:31 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 18 Jul 2023 14:30:31 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: hadrian: Allow multiple components per package Message-ID: <64b6da4786ccb_3a4b0fb745818414a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: a951af96 by Ben Gamari at 2023-07-18T19:30:21+01:00 hadrian: Allow multiple components per package Historically hadrian has supported only one component per `Package`. However, recently both `ghc-toolchain` and `hpc` have run into this limitation. Here we lift this limitation in a minimal manner, using the declared `PackageType` to choose between the components provided by the package. Fixes #23690. - - - - - 69674fb2 by Rodrigo Mesquita at 2023-07-18T19:30:21+01:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 6 changed files: - configure.ac - distrib/configure.ac.in - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - m4/ghc_toolchain.m4 Changes: ===================================== configure.ac ===================================== @@ -1177,7 +1177,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([hadrian/cfg]) +FIND_GHC_TOOLCHAIN([hadrian/cfg],[NO]) AC_CONFIG_FILES( [ mk/project.mk ===================================== distrib/configure.ac.in ===================================== @@ -312,7 +312,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([.]) +FIND_GHC_TOOLCHAIN([.],[YES]) VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -104,12 +104,15 @@ parsePackageData pkg = do parseCabalPkgId :: FilePath -> IO String parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file -biModules :: C.PackageDescription -> (C.BuildInfo, [C.ModuleName], Maybe [C.ModuleName], Maybe (C.ModuleName, String)) -biModules pd = go [ comp | comp@(bi,_,_,_) <- - (map libBiModules . maybeToList $ C.library pd) ++ - (map exeBiModules $ C.executables pd) - , C.buildable bi ] +biModules :: Package -> C.PackageDescription -> (C.BuildInfo, [C.ModuleName], Maybe [C.ModuleName], Maybe (C.ModuleName, String)) +biModules pkg pd = + go [ comp | comp@(bi,_,_,_) <- candidateComponents + , C.buildable bi ] where + candidateComponents + | isLibrary pkg = map libBiModules . maybeToList $ C.library pd + | otherwise = map exeBiModules $ C.executables pd + libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib, Just (map C.moduleReexportName (C.reexportedModules lib)), Nothing) exeBiModules exe = (C.buildInfo exe, -- If "main-is: ..." is not a .hs or .lhs file, do not @@ -246,7 +249,8 @@ resolveContextData context at Context {..} = do -- @library-dirs@ here. _ -> error "No (or multiple) GHC rts package is registered!" - (buildInfo, modules, rexport_modules, mainIs) = biModules (C.localPkgDescr lbi') + (buildInfo, modules, rexport_modules, mainIs) = + biModules package (C.localPkgDescr lbi') classifyMain :: FilePath -> MainSourceType classifyMain fp ===================================== hadrian/src/Packages.hs ===================================== @@ -5,7 +5,8 @@ module Packages ( checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, @@ -37,7 +38,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs + , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain + , haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml @@ -53,7 +55,8 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -93,6 +96,7 @@ ghciWrapper = prg "ghci-wrapper" `setPath` "driver/ghci" -- See Note [Hadrian's ghci-wrapper package] ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" +ghcToolchain = util "ghc-toolchain" haddock = util "haddock" haskeline = lib "haskeline" hsc2hs = util "hsc2hs" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -146,6 +146,7 @@ stage1Packages = do , semaphoreCompat , stm , unlit + , ghcToolchain , xhtml , if winTarget then win32 else unix ] ===================================== m4/ghc_toolchain.m4 ===================================== @@ -33,21 +33,38 @@ AC_DEFUN([INVOKE_GHC_TOOLCHAIN], while read -r arg; do set -- "[$]@" "$arg" done - # For now, we don't exit even if ghc-toolchain fails. We don't want to + # For now, we don't 'exit' even if ghc-toolchain fails. We don't want to # fail configure due to it, since the target file is still being generated by configure. - ./acghc-toolchain -v2 "[$]@" # || exit 1 - python3 -c 'import sys; print(sys.argv)' "[$]@" - ) From gitlab at gitlab.haskell.org Tue Jul 18 19:50:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 18 Jul 2023 15:50:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-9.8 Message-ID: <64b6ecfe5975_3a4b0f406ce40202940@gitlab.mail> Ben Gamari pushed new branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-9.8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 19:51:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 18 Jul 2023 15:51:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23691 Message-ID: <64b6ed44aeeae_3a4b0fb74802031ca@gitlab.mail> Ben Gamari pushed new branch wip/T23691 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23691 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 20:07:25 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 18 Jul 2023 16:07:25 -0400 Subject: [Git][ghc/ghc][wip/T22404] Remove the in-scope set from OccAnal Message-ID: <64b6f0fd63c12_3a4b0fb7408209054@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 49500bd2 by Simon Peyton Jones at 2023-07-18T21:06:22+01:00 Remove the in-scope set from OccAnal - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -666,7 +666,7 @@ Here are the consequences * In the tricky (P3) we'll get an `andUDs` of * OneOcc{occ_n_br=0} from the occurrences of `j`) * OneOcc{occ_n_br=1} from the (f v) - These are `andUDs` together, and hence `addOccInfo`, and hence + These are `andUDs` together in `addOccInfo`, and hence `v` gets ManyOccs, just as it should. Clever! There are a couple of tricky wrinkles @@ -2151,32 +2151,34 @@ occAnalLamTail env expr occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Does not markInsidLam etc for the outmost batch of lambdas occ_anal_lam_tail env (Lam bndr expr) - | isTyVar bndr - = addInScope env [bndr] $ \env -> - let !(WUD usage expr') = occ_anal_lam_tail env expr - in WUD usage (Lam bndr expr') - -- Important: Do not modify occ_encl, so that with a RHS like - -- \(@ x) -> K @x (f @x) - -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain - -- from inlining f. See the beginning of Note [Cascading inlines]. - - | otherwise -- So 'bndr' is an Id - = addInScope env [bndr] $ \env -> - let (env_one_shots', bndr1) - = case occ_one_shots env of - [] -> ([], bndr) - (os : oss) -> (oss, updOneShotInfo bndr os) - -- Use updOneShotInfo, not setOneShotInfo, as pre-existing - -- one-shot info might be better than what we can infer, e.g. - -- due to explicit use of the magic 'oneShot' function. - -- See Note [The oneShot function] - - env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - !(WUD usage expr') = occ_anal_lam_tail env1 expr - bndr2 = tagLamBinder usage bndr1 - usage1 = usage `addManyOccs` coVarsOfType (idType bndr) - -- usage1: see Note [Gather occurrences of coercion variables] - in WUD usage1 (Lam bndr2 expr') + = go env [bndr] expr + where + go :: OccEnv -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env rev_bndrs (Lam bndr expr) + | isTyVar bndr + = go env (bndr:rev_bndrs) expr + -- Important: Do not modify occ_encl, so that with a RHS like + -- \(@ x) -> K @x (f @x) + -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain + -- from inlining f. See the beginning of Note [Cascading inlines]. + + | otherwise + = let (env_one_shots', bndr1) + = case occ_one_shots env of + [] -> ([], bndr) + (os : oss) -> (oss, updOneShotInfo bndr os) + -- Use updOneShotInfo, not setOneShotInfo, as pre-existing + -- one-shot info might be better than what we can infer, e.g. + -- due to explicit use of the magic 'oneShot' function. + -- See Note [The oneShot function] + env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } + in go env1 (bndr1 : rev_bndrs) expr + + go env rev_bndrs expr + = addInScope env rev_bndrs $ \env -> + let !(WUD usage expr') = occ_anal_lam_tail env expr + in WUD (usage `addLamCoVarOccs` rev_bndrs) expr' + -- addLamCoVarOccs: see Note [Gather occurrences of coercion variables] -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] @@ -2785,8 +2787,6 @@ data OccEnv , occ_rule_act :: Activation -> Bool -- Which rules are active -- See Note [Finding rule RHS free vars] - , occ_in_scope :: VarSet -- Set of variables in scope - -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, -- then please replace x by (y |> mco) @@ -2834,8 +2834,7 @@ type OneShots = [OneShotInfo] initOccEnv :: OccEnv initOccEnv - = OccEnv { occ_in_scope = emptyVarSet - , occ_encl = OccVanilla + = OccEnv { occ_encl = OccVanilla , occ_one_shots = [] -- To be conservative, we say that all @@ -2911,40 +2910,58 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a -- Needed for all Vars not just Ids; a TyVar might have a CoVars in its kind -addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points }) +addInScope env@(OccEnv { occ_join_points = join_points }) bndrs thing_inside - | not (any (`elemVarSet` in_scope) bndrs) + | not bad_joins = -- No shadowing here; fast path for this common case - fix_up_uds (thing_inside env_w_bndrs) + del_bndrs_from_uds $ + thing_inside $ + drop_shadowed_swaps $ + env | otherwise -- Shadowing! Lots of things to do - = fix_up_uds $ - add_bad_joins $ - thing_inside $ + = add_bad_joins $ + del_bndrs_from_uds $ + thing_inside $ drop_shadowed_swaps $ drop_shadowed_joins $ - env_w_bndrs + env where - env_w_bndrs = env { occ_in_scope = in_scope `extendVarSetList` bndrs } + bndr_set :: UniqSet Var + bndr_set = mkVarSet bndrs + + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set + + -- bad_joins is true if it would be wrong to push occ_join_points inwards + -- (a) `bndrs` includes any of the occ_join_points + -- (b) `bndrs` includes any variables free in the RHSs of occ_join_points + bad_joins :: Bool + bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points + + is_bad :: Unique -> OccInfoEnv -> Bool -> Bool + is_bad uniq join_uds rest + = uniq `elemUniqSet_Directly` bndr_set || + not (bndr_fm `disjointUFM` join_uds) || + rest drop_shadowed_swaps :: OccEnv -> OccEnv -- See Note [The binder-swap substitution] (BS3) drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = bs_rng_vars }) - | any (`elemVarSet` bs_rng_vars) bndrs + | bs_rng_vars `disjointUniqSets` bndr_set = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } | otherwise - = env { occ_bs_env = swap_env `delVarEnvList` bndrs } + = env { occ_bs_env = swap_env `minusUFM` bndr_fm } drop_shadowed_joins :: OccEnv -> OccEnv -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) --- drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs } drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } - fix_up_uds :: WithUsageDetails a -> WithUsageDetails a + del_bndrs_from_uds :: WithUsageDetails a -> WithUsageDetails a -- Remove usage for bndrs -- Add usage info for CoVars used in the types of bndrs - fix_up_uds (WUD uds res) = WUD (uds `delDetails` bndrs) res + del_bndrs_from_uds (WUD uds res) = WUD (uds `delDetails` bndr_fm) res add_bad_joins :: WithUsageDetails a -> WithUsageDetails a -- Add usage info for occ_join_points that we cannot push inwardsa @@ -2966,14 +2983,6 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points | uniq `elemVarEnvByKey` env = env `plusVarEnv` join_env | otherwise = env -{- - bad_joins, good_joins :: IdEnv UsageDetails - (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points - - bad_join_rhs :: UsageDetails -> Bool - bad_join_rhs (UD { ud_env = rhs_usage }) = any (`elemVarEnv` rhs_usage) bndrs --} - addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv addJoinPoint env bndr rhs_uds | isEmptyVarEnv zeroed_form @@ -3511,6 +3520,12 @@ addManyOccs uds var_set add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set -- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes +addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails +-- Add any CoVars free in the type of a lambda-binder +-- See Note [Gather occurrences of coercion variables] +addLamCoVarOccs uds bndrs + = uds `addManyOccs` coVarsOfTypes [ idType id | id <- bndrs, isId id ] + emptyDetails :: UsageDetails emptyDetails = mkSimpleDetails emptyVarEnv @@ -3533,16 +3548,16 @@ emptyDetails = UD { ud_env = emptyVarEnv isEmptyDetails :: UsageDetails -> Bool isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env -delDetails :: UsageDetails -> [Id] -> UsageDetails +delDetails :: UsageDetails -> UniqFM Var a -> UsageDetails -- Delete these binders from the UsageDetails delDetails (UD { ud_env = env , ud_z_many = z_many , ud_z_in_lam = z_in_lam - , ud_z_tail = z_tail }) bndrs - = UD { ud_env = env `delVarEnvList` bndrs - , ud_z_many = z_many `delVarEnvList` bndrs - , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs - , ud_z_tail = z_tail `delVarEnvList` bndrs } + , ud_z_tail = z_tail }) bndr_fm + = UD { ud_env = env `minusUFM` bndr_fm + , ud_z_many = z_many `minusUFM` bndr_fm + , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm + , ud_z_tail = z_tail `minusUFM` bndr_fm } markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49500bd205a81a65dbb50f6a822a843046a95fbf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49500bd205a81a65dbb50f6a822a843046a95fbf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 20:40:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 18 Jul 2023 16:40:20 -0400 Subject: [Git][ghc/ghc][wip/T22404] Remove the in-scope set from OccAnal Message-ID: <64b6f8b4e1882_3a4b0fb7494216614@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 47526171 by Simon Peyton Jones at 2023-07-18T21:40:04+01:00 Remove the in-scope set from OccAnal - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -666,7 +666,7 @@ Here are the consequences * In the tricky (P3) we'll get an `andUDs` of * OneOcc{occ_n_br=0} from the occurrences of `j`) * OneOcc{occ_n_br=1} from the (f v) - These are `andUDs` together, and hence `addOccInfo`, and hence + These are `andUDs` together in `addOccInfo`, and hence `v` gets ManyOccs, just as it should. Clever! There are a couple of tricky wrinkles @@ -2151,32 +2151,37 @@ occAnalLamTail env expr occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Does not markInsidLam etc for the outmost batch of lambdas occ_anal_lam_tail env (Lam bndr expr) - | isTyVar bndr - = addInScope env [bndr] $ \env -> - let !(WUD usage expr') = occ_anal_lam_tail env expr - in WUD usage (Lam bndr expr') - -- Important: Do not modify occ_encl, so that with a RHS like - -- \(@ x) -> K @x (f @x) - -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain - -- from inlining f. See the beginning of Note [Cascading inlines]. - - | otherwise -- So 'bndr' is an Id - = addInScope env [bndr] $ \env -> - let (env_one_shots', bndr1) - = case occ_one_shots env of - [] -> ([], bndr) - (os : oss) -> (oss, updOneShotInfo bndr os) - -- Use updOneShotInfo, not setOneShotInfo, as pre-existing - -- one-shot info might be better than what we can infer, e.g. - -- due to explicit use of the magic 'oneShot' function. - -- See Note [The oneShot function] - - env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - !(WUD usage expr') = occ_anal_lam_tail env1 expr - bndr2 = tagLamBinder usage bndr1 - usage1 = usage `addManyOccs` coVarsOfType (idType bndr) - -- usage1: see Note [Gather occurrences of coercion variables] - in WUD usage1 (Lam bndr2 expr') + = go env [bndr] expr + where + go :: OccEnv -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env rev_bndrs (Lam bndr expr) + | isTyVar bndr + = go env (bndr:rev_bndrs) expr + -- Important: Do not modify occ_encl, so that with a RHS like + -- \(@ x) -> K @x (f @x) + -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain + -- from inlining f. See the beginning of Note [Cascading inlines]. + + | otherwise + = let (env_one_shots', bndr1) + = case occ_one_shots env of + [] -> ([], bndr) + (os : oss) -> (oss, updOneShotInfo bndr os) + -- Use updOneShotInfo, not setOneShotInfo, as pre-existing + -- one-shot info might be better than what we can infer, e.g. + -- due to explicit use of the magic 'oneShot' function. + -- See Note [The oneShot function] + env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } + in go env1 (bndr1 : rev_bndrs) expr + + go env rev_bndrs expr + = let bndrs = reverse rev_bndrs in + addInScope env bndrs $ \env -> + let !(WUD usage expr') = occ_anal_lam_tail env expr + bndrs' = tagLamBinders usage bndrs + in WUD (usage `addLamCoVarOccs` bndrs) + (mkLams bndrs' expr') + -- addLamCoVarOccs: see Note [Gather occurrences of coercion variables] -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] @@ -2785,8 +2790,6 @@ data OccEnv , occ_rule_act :: Activation -> Bool -- Which rules are active -- See Note [Finding rule RHS free vars] - , occ_in_scope :: VarSet -- Set of variables in scope - -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, -- then please replace x by (y |> mco) @@ -2834,8 +2837,7 @@ type OneShots = [OneShotInfo] initOccEnv :: OccEnv initOccEnv - = OccEnv { occ_in_scope = emptyVarSet - , occ_encl = OccVanilla + = OccEnv { occ_encl = OccVanilla , occ_one_shots = [] -- To be conservative, we say that all @@ -2911,40 +2913,58 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a -- Needed for all Vars not just Ids; a TyVar might have a CoVars in its kind -addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points }) +addInScope env@(OccEnv { occ_join_points = join_points }) bndrs thing_inside - | not (any (`elemVarSet` in_scope) bndrs) + | not bad_joins = -- No shadowing here; fast path for this common case - fix_up_uds (thing_inside env_w_bndrs) + del_bndrs_from_uds $ + thing_inside $ + drop_shadowed_swaps $ + env | otherwise -- Shadowing! Lots of things to do - = fix_up_uds $ - add_bad_joins $ - thing_inside $ + = add_bad_joins $ + del_bndrs_from_uds $ + thing_inside $ drop_shadowed_swaps $ drop_shadowed_joins $ - env_w_bndrs + env where - env_w_bndrs = env { occ_in_scope = in_scope `extendVarSetList` bndrs } + bndr_set :: UniqSet Var + bndr_set = mkVarSet bndrs + + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set + + -- bad_joins is true if it would be wrong to push occ_join_points inwards + -- (a) `bndrs` includes any of the occ_join_points + -- (b) `bndrs` includes any variables free in the RHSs of occ_join_points + bad_joins :: Bool + bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points + + is_bad :: Unique -> OccInfoEnv -> Bool -> Bool + is_bad uniq join_uds rest + = uniq `elemUniqSet_Directly` bndr_set || + not (bndr_fm `disjointUFM` join_uds) || + rest drop_shadowed_swaps :: OccEnv -> OccEnv -- See Note [The binder-swap substitution] (BS3) drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = bs_rng_vars }) - | any (`elemVarSet` bs_rng_vars) bndrs + | bs_rng_vars `disjointUniqSets` bndr_set = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } | otherwise - = env { occ_bs_env = swap_env `delVarEnvList` bndrs } + = env { occ_bs_env = swap_env `minusUFM` bndr_fm } drop_shadowed_joins :: OccEnv -> OccEnv -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) --- drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs } drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } - fix_up_uds :: WithUsageDetails a -> WithUsageDetails a + del_bndrs_from_uds :: WithUsageDetails a -> WithUsageDetails a -- Remove usage for bndrs -- Add usage info for CoVars used in the types of bndrs - fix_up_uds (WUD uds res) = WUD (uds `delDetails` bndrs) res + del_bndrs_from_uds (WUD uds res) = WUD (uds `delDetails` bndr_fm) res add_bad_joins :: WithUsageDetails a -> WithUsageDetails a -- Add usage info for occ_join_points that we cannot push inwardsa @@ -2966,14 +2986,6 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points | uniq `elemVarEnvByKey` env = env `plusVarEnv` join_env | otherwise = env -{- - bad_joins, good_joins :: IdEnv UsageDetails - (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points - - bad_join_rhs :: UsageDetails -> Bool - bad_join_rhs (UD { ud_env = rhs_usage }) = any (`elemVarEnv` rhs_usage) bndrs --} - addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv addJoinPoint env bndr rhs_uds | isEmptyVarEnv zeroed_form @@ -3511,6 +3523,12 @@ addManyOccs uds var_set add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set -- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes +addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails +-- Add any CoVars free in the type of a lambda-binder +-- See Note [Gather occurrences of coercion variables] +addLamCoVarOccs uds bndrs + = uds `addManyOccs` coVarsOfTypes [ idType id | id <- bndrs, isId id ] + emptyDetails :: UsageDetails emptyDetails = mkSimpleDetails emptyVarEnv @@ -3533,16 +3551,16 @@ emptyDetails = UD { ud_env = emptyVarEnv isEmptyDetails :: UsageDetails -> Bool isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env -delDetails :: UsageDetails -> [Id] -> UsageDetails +delDetails :: UsageDetails -> UniqFM Var a -> UsageDetails -- Delete these binders from the UsageDetails delDetails (UD { ud_env = env , ud_z_many = z_many , ud_z_in_lam = z_in_lam - , ud_z_tail = z_tail }) bndrs - = UD { ud_env = env `delVarEnvList` bndrs - , ud_z_many = z_many `delVarEnvList` bndrs - , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs - , ud_z_tail = z_tail `delVarEnvList` bndrs } + , ud_z_tail = z_tail }) bndr_fm + = UD { ud_env = env `minusUFM` bndr_fm + , ud_z_many = z_many `minusUFM` bndr_fm + , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm + , ud_z_tail = z_tail `minusUFM` bndr_fm } markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47526171c13416c0fc3e871dcb7010afbe57b0f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47526171c13416c0fc3e871dcb7010afbe57b0f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 21:14:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 18 Jul 2023 17:14:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Reg.Liveness: Strictness Message-ID: <64b7009f3d082_3a4b0fb741c244849@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8ad58ef1 by Ben Gamari at 2023-07-18T17:13:00-04:00 Reg.Liveness: Strictness - - - - - 490342ef by Ben Gamari at 2023-07-18T17:13:01-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - e822b807 by Ben Gamari at 2023-07-18T17:13:01-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 0da0bea2 by Sven Tennie at 2023-07-18T17:13:01-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 30b24868 by Sven Tennie at 2023-07-18T17:13:01-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - 56d53198 by Sven Tennie at 2023-07-18T17:13:01-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - 8a6f413f by Sven Tennie at 2023-07-18T17:13:01-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 73d540fc by Matthew Pickering at 2023-07-18T17:13:02-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 12d79a59 by Vladislav Zavialov at 2023-07-18T17:13:03-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 8a4d3b7c by sheaf at 2023-07-18T17:13:05-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 3ecd4722 by Alan Zimmerman at 2023-07-18T17:13:06-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 21 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - + docs/users_guide/9.10.1-notes.rst - docs/users_guide/release-notes.rst - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/printer/Test19784.hs - + testsuite/tests/rename/should_compile/T23664.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -278,6 +278,13 @@ lint-ci-config: - nix run .gitlab/generate-ci#generate-jobs # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code + # And run this to generate the .gitlab/jobs-metadata.json + - nix run .gitlab/generate-ci#generate-job-metadata + artifacts: + when: always + paths: + - .gitlab/jobs-metadata.json + - .gitlab/jobs.yaml dependencies: [] lint-submods: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -56,6 +56,25 @@ Note that there are variety of places in the native code generator where we assume that the code produced for a MachOp does not introduce new blocks. -} +-- Note [MO_S_MulMayOflo significant width] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- There are two interpretations in the code about what a multiplication +-- overflow exactly means: +-- +-- 1. The result does not fit into the specified width (of type Width.) +-- 2. The result does not fit into a register. +-- +-- (2) has some flaws: A following MO_Mul has a width, too. So MO_S_MulMayOflo +-- may signal no overflow, while MO_Mul truncates the result. There are +-- architectures with several register widths and it might be hard to decide +-- what's an overflow and what not. Both attributes can easily lead to subtle +-- bugs. +-- +-- (1) has the benefit that its interpretation is completely independent of the +-- architecture. So, the mid-term plan is to migrate to this +-- interpretation/sematics. + data MachOp -- Integer operations (insensitive to signed/unsigned) = MO_Add Width @@ -65,7 +84,8 @@ data MachOp | MO_Mul Width -- low word of multiply -- Signed multiply/divide - | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows + | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows. See + -- Note [MO_S_MulMayOflo significant width] | MO_S_Quot Width -- signed / (same semantics as IntQuotOp) | MO_S_Rem Width -- signed % (same semantics as IntRemOp) | MO_S_Neg Width -- unary - ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -1001,7 +1001,7 @@ livenessBack livenessBack _ liveregs _ done [] = (liveregs, done) livenessBack platform liveregs blockmap acc (instr : instrs) - = let (liveregs', instr') = liveness1 platform liveregs blockmap instr + = let !(!liveregs', instr') = liveness1 platform liveregs blockmap instr in livenessBack platform liveregs' blockmap (instr' : acc) instrs @@ -1024,15 +1024,15 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) = (liveregs1, LiveInstr instr (Just $ Liveness { liveBorn = emptyUniqSet - , liveDieRead = mkUniqSet r_dying - , liveDieWrite = mkUniqSet w_dying })) + , liveDieRead = r_dying + , liveDieWrite = w_dying })) | otherwise = (liveregs_br, LiveInstr instr (Just $ Liveness { liveBorn = emptyUniqSet , liveDieRead = mkUniqSet r_dying_br - , liveDieWrite = mkUniqSet w_dying })) + , liveDieWrite = w_dying })) where !(RU read written) = regUsageOfInstr platform instr @@ -1044,10 +1044,12 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) -- registers that are not live beyond this point, are recorded -- as dying here. - r_dying = [ reg | reg <- read, reg `notElem` written, + r_dying = mkUniqSet + [ reg | reg <- read, reg `notElem` written, not (elementOfUniqSet reg liveregs) ] - w_dying = [ reg | reg <- written, + w_dying = mkUniqSet + [ reg | reg <- written, not (elementOfUniqSet reg liveregs) ] -- union in the live regs from all the jump destinations of this @@ -1067,6 +1069,6 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) -- registers that are live only in the branch targets should -- be listed as dying here. live_branch_only = live_from_branch `minusUniqSet` liveregs - r_dying_br = nonDetEltsUniqSet (mkUniqSet r_dying `unionUniqSets` + r_dying_br = nonDetEltsUniqSet (r_dying `unionUniqSets` live_branch_only) -- See Note [Unique Determinism and code generation] ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -966,16 +966,38 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps return (Fixed format eax code) - imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + imulMayOflo W8 a b = do + -- The general case (W16, W32, W64) doesn't work for W8 as its + -- multiplication doesn't use two registers. + -- + -- The plan is: + -- 1. truncate and sign-extend a and b to 8bit width + -- 2. multiply a' = a * b in 32bit width + -- 3. copy and sign-extend 8bit from a' to c + -- 4. compare a' and c: they are equal if there was no overflow + (a_reg, a_code) <- getNonClobberedReg a + (b_reg, b_code) <- getNonClobberedReg b + let + code = a_code `appOL` b_code `appOL` + toOL [ + MOVSxL II8 (OpReg a_reg) (OpReg a_reg), + MOVSxL II8 (OpReg b_reg) (OpReg b_reg), + IMUL II32 (OpReg b_reg) (OpReg a_reg), + MOVSxL II8 (OpReg a_reg) (OpReg eax), + CMP II16 (OpReg a_reg) (OpReg eax), + SETCC NE (OpReg eax) + ] + return (Fixed II8 eax code) imulMayOflo rep a b = do (a_reg, a_code) <- getNonClobberedReg a b_code <- getAnyReg b let shift_amt = case rep of + W16 -> 15 W32 -> 31 W64 -> 63 - _ -> panic "shift_amt" + w -> panic ("shift_amt: " ++ show w) format = intFormat rep code = a_code `appOL` b_code eax `appOL` ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -82,7 +82,8 @@ module GHC.Parser.Annotation ( -- ** Working with comments in annotations noComments, comment, addCommentsToSrcAnn, setCommentsSrcAnn, addCommentsToEpAnn, setCommentsEpAnn, - transferAnnsA, commentsOnlyA, removeCommentsA, + transferAnnsA, transferAnnsOnlyA, transferCommentsOnlyA, commentsOnlyA, + removeCommentsA, placeholderRealSpan, ) where @@ -1154,6 +1155,26 @@ transferAnnsA (SrcSpanAnn (EpAnn a an cs) l) to (SrcSpanAnn (EpAnn a an' cs') loc) -> SrcSpanAnn (EpAnn a (an' <> an) (cs' <> cs)) loc +-- | Transfer trailing items from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferAnnsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferAnnsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2 + = (SrcSpanAnn EpAnnNotUsed l, ss2) +transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l') + = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn (spanAsAnchor l') an emptyComments) l') +transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l') + = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn a' (an' <> an) cs') l') + +-- | Transfer comments from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferCommentsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferCommentsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2 + = (SrcSpanAnn EpAnnNotUsed l, ss2) +transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l') + = (SrcSpanAnn (EpAnn a an emptyComments ) l, SrcSpanAnn (EpAnn (spanAsAnchor l') mempty cs) l') +transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l') + = (SrcSpanAnn (EpAnn a an emptyComments) l, SrcSpanAnn (EpAnn a' an' (cs <> cs')) l') + -- | Remove the exact print annotations payload, leaving only the -- anchor and comments. commentsOnlyA :: Monoid ann => SrcAnn ann -> SrcAnn ann ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -587,11 +587,14 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) MG { mg_alts = (L _ m1@[L _ mtchs1]) } })) binds | has_args m1 - = go [L (removeCommentsA loc1) mtchs1] (commentsOnlyA loc1) binds [] + = go [L loc1 mtchs1] (noAnnSrcSpan $ locA loc1) binds [] where - go :: [LMatch GhcPs (LHsExpr GhcPs)] -> SrcSpanAnnA - -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] - -> (LHsBind GhcPs,[LHsDecl GhcPs]) -- AZ + -- See Note [Exact Print Annotations for FunBind] + go :: [LMatch GhcPs (LHsExpr GhcPs)] -- accumulates matches for current fun + -> SrcSpanAnnA -- current top level loc + -> [LHsDecl GhcPs] -- Any docbinds seen + -> [LHsDecl GhcPs] -- rest of decls to be processed + -> (LHsBind GhcPs, [LHsDecl GhcPs]) -- FunBind, rest of decls go mtchs loc ((L loc2 (ValD _ (FunBind { fun_id = (L _ f2) , fun_matches = @@ -605,13 +608,61 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) = let doc_decls' = doc_decl : doc_decls in go mtchs (combineSrcSpansA loc loc2) binds doc_decls' go mtchs loc binds doc_decls - = ( L loc (makeFunBind fun_id1 (mkLocatedList $ reverse mtchs)) - , (reverse doc_decls) ++ binds) + = let + L llm last_m = head mtchs -- Guaranteed at least one + (llm',loc') = transferAnnsOnlyA llm loc -- Keep comments, transfer trailing + + matches' = reverse (L llm' last_m:tail mtchs) + L lfm first_m = head matches' + (lfm', loc'') = transferCommentsOnlyA lfm loc' + in + ( L loc'' (makeFunBind fun_id1 (mkLocatedList $ (L lfm' first_m:tail matches'))) + , (reverse doc_decls) ++ binds) -- Reverse the final matches, to get it back in the right order -- Do the same thing with the trailing doc comments getMonoBind bind binds = (bind, binds) +{- Note [Exact Print Annotations for FunBind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +An individual Match that ends up in a FunBind MatchGroup is initially +parsed as a LHsDecl. This takes the form + + L loc (ValD NoExtField (FunBind ... [L lm (Match ..)])) + +The loc contains the annotations, in particular comments, which are to +precede the declaration when printed, and [TrailingAnn] which are to +follow it. The [TrailingAnn] captures semicolons that may appear after +it when using the braces and semis style of coding. + +The match location (lm) has only a location in it at this point, no +annotations. Its location is the same as the top level location in +loc. + +What getMonoBind does it to take a sequence of FunBind LHsDecls that +belong to the same function and group them into a single function with +the component declarations all combined into the single MatchGroup as +[LMatch GhcPs]. + +Given that when exact printing a FunBind the exact printer simply +iterates over all the matches and prints each in turn, the simplest +behaviour would be to simply take the top level annotations (loc) for +each declaration, and use them for the individual component matches +(lm). + +The problem is the exact printer first has to deal with the top level +LHsDecl, which means annotations for the loc. This needs to be able to +be exact printed in the context of surrounding declarations, and if +some refactor decides to move the declaration elsewhere, the leading +comments and trailing semicolons need to be handled at that level. + +So the solution is to combine all the matches into one, pushing the +annotations into the LMatch's, and then at the end extract the +comments from the first match and [TrailingAnn] from the last to go in +the top level LHsDecl. +-} + -- Group together adjacent FunBinds for every function. getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs] getMonoBindAll [] = [] ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -845,8 +845,10 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = -- See [Mismatched class methods and associated type families] -- in TcInstDecls. where - what_lkup = LookupChild { wantedParent = the_parent - , lookupDataConFirst = False } + what_lkup = LookupChild { wantedParent = the_parent + , lookupDataConFirst = False + , prioritiseParent = True -- See T23664. + } {- Note [Family instance binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -690,8 +690,12 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items let bareName = (ieWrappedName . unLoc) n what_lkup :: LookupChild - what_lkup = LookupChild { wantedParent = spec_parent - , lookupDataConFirst = True } + what_lkup = + LookupChild + { wantedParent = spec_parent + , lookupDataConFirst = True + , prioritiseParent = False -- See T11970. + } -- Do not report export list declaration deprecations name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -1190,6 +1190,13 @@ data LookupChild , lookupDataConFirst :: Bool -- ^ for type constructors, should we look in the data constructor -- namespace first? + , prioritiseParent :: Bool + -- ^ should we prioritise getting the right 'Parent'? + -- + -- - @True@: prioritise getting the right 'Parent' + -- - @False@: prioritise getting the right 'NameSpace' + -- + -- See Note [childGREPriority]. } -- | After looking up something with the given 'NameSpace', is the resulting @@ -1225,14 +1232,52 @@ greIsRelevant which_gres ns gre where other_ns = greNameSpace gre +{- Note [childGREPriority] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are currently two places in the compiler where we look up GlobalRdrElts +which have a given Parent. These are the two calls to lookupSubBndrOcc_helper: + + A. Looking up children in an export item, e.g. + + module M ( T(MkT, D) ) where { data T = MkT; data D = D } + + B. Looking up binders in a class or instance declaration, e.g. + the operator +++ in the fixity declaration: + + class C a where { type (+++) :: a -> a ->; infixl 6 +++ } + (+++) :: Int -> Int -> Int; (+++) = (+) + +In these two situations, there are two competing metrics for finding the "best" +'GlobalRdrElt' that a particular 'OccName' resolves to: + + - does the resolved 'GlobalRdrElt' have the correct parent? + - does the resolved 'GlobalRdrElt' have the same 'NameSpace' as the 'OccName'? + +(A) and (B) have competing requirements. + +For the example of (A) above, we know that the child 'D' of 'T' must live +in the data namespace, so we look up the OccName 'OccName DataName "D"' and +prioritise the lookup results based on the 'NameSpace'. +This means we get an error message of the form: + + The type constructor 'T' is not the parent of the data constructor 'D'. + +as opposed to the rather unhelpful and confusing: + + The type constructor 'T' is not the parent of the type constructor 'D'. + +See test case T11970. + +For the example of (B) above, the fixity declaration for +++ lies inside the +class, so we should prioritise looking up 'GlobalRdrElt's whose parent is 'C'. +Not doing so led to #23664. +-} + -- | Scoring priority function for looking up children 'GlobalRdrElt'. -- --- First we score by 'NameSpace', with higher-priority 'NameSpace's having a --- lower number. Then we break ties by checking if the 'Parent' is correct. --- --- This complicated scoring function is determined by the behaviour required by --- 'lookupChildrenExport', which requires us to look in the data constructor --- 'NameSpace' first, for things in the type constructor 'NameSpace'. +-- We score by 'Parent' and 'NameSpace', with higher priorities having lower +-- numbers. Which lexicographic order we use ('Parent' or 'NameSpace' first) +-- is determined by the first argument; see Note [childGREPriority]. childGREPriority :: LookupChild -- ^ what kind of child do we want, -- e.g. what should its parent be? -> NameSpace -- ^ what 'NameSpace' are we originally looking in? @@ -1241,13 +1286,18 @@ childGREPriority :: LookupChild -- ^ what kind of child do we want, -- 'NameSpace', which is used to determine the score -- (in the first component) -> Maybe (Int, Int) -childGREPriority (LookupChild { wantedParent = wanted_parent, lookupDataConFirst = try_dc_first }) +childGREPriority (LookupChild { wantedParent = wanted_parent + , lookupDataConFirst = try_dc_first + , prioritiseParent = par_first }) ns gre = - case child_ns_prio $ greNameSpace gre of - Nothing -> Nothing - Just np -> Just (np, parent_prio $ greParent gre) - -- Prioritise GREs first on NameSpace, and then on Parent. - -- See T11970. + case child_ns_prio $ greNameSpace gre of + Nothing -> Nothing + Just ns_prio -> + let par_prio = parent_prio $ greParent gre + in Just $ if par_first + then (par_prio, ns_prio) + else (ns_prio, par_prio) + -- See Note [childGREPriority]. where -- Pick out the possible 'NameSpace's in order of priority. @@ -1302,11 +1352,9 @@ lookupGRE env = \case lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ | otherwise = fromMaybe [] $ lookupOccEnv env occ LookupChildren occ which_child -> - highestPriorityGREs (childGREPriority which_child ns) $ - concat $ lookupOccEnv_AllNameSpaces env occ - where - ns :: NameSpace - ns = occNameSpace occ + let ns = occNameSpace occ + all_gres = concat $ lookupOccEnv_AllNameSpaces env occ + in highestPriorityGREs (childGREPriority which_child ns) all_gres -- | Collect the 'GlobalRdrElt's with the highest priority according -- to the given function (lower value <=> higher priority). ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -212,13 +212,16 @@ addToUDFM_C f m k v = addToUDFM_C_Directly f m (getUnique k) v addListToUDFM :: Uniquable key => UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) +{-# INLINEABLE addListToUDFM #-} addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) +{-# INLINEABLE addListToUDFM_Directly #-} addListToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) +{-# INLINEABLE addListToUDFM_Directly_C #-} delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -139,9 +139,11 @@ zipToUFM ks vs = assert (length ks == length vs ) innerZip emptyUFM ks vs listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM +{-# INLINEABLE listToUFM #-} listToUFM_Directly :: [(Unique, elt)] -> UniqFM key elt listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM +{-# INLINEABLE listToUFM_Directly #-} listToIdentityUFM :: Uniquable key => [key] -> UniqFM key key listToIdentityUFM = foldl' (\m x -> addToUFM m x x) emptyUFM @@ -152,6 +154,7 @@ listToUFM_C -> [(key, elt)] -> UniqFM key elt listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM +{-# INLINEABLE listToUFM_C #-} addToUFM :: Uniquable key => UniqFM key elt -> key -> elt -> UniqFM key elt addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m) ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -74,12 +74,14 @@ unitUniqSet x = UniqSet $ unitUFM x x mkUniqSet :: Uniquable a => [a] -> UniqSet a mkUniqSet = foldl' addOneToUniqSet emptyUniqSet +{-# INLINEABLE mkUniqSet #-} addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x) addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a addListToUniqSet = foldl' addOneToUniqSet +{-# INLINEABLE addListToUniqSet #-} delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a) @@ -89,10 +91,12 @@ delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u) delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l) +{-# INLINEABLE delListFromUniqSet #-} delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a delListFromUniqSet_Directly (UniqSet s) l = UniqSet (delListFromUFM_Directly s l) +{-# INLINEABLE delListFromUniqSet_Directly #-} unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t) ===================================== docs/users_guide/9.10.1-notes.rst ===================================== @@ -0,0 +1,75 @@ +.. _release-9-10-1: + +Version 9.10.1 +============== + +Language +~~~~~~~~ + +Compiler +~~~~~~~~ + +GHCi +~~~~ + +Runtime system +~~~~~~~~~~~~~~ + +``base`` library +~~~~~~~~~~~~~~~~ + +``ghc-prim`` library +~~~~~~~~~~~~~~~~~~~~ + +``ghc`` library +~~~~~~~~~~~~~~~ + +``ghc-heap`` library +~~~~~~~~~~~~~~~~~~~~ + +``template-haskell`` library +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Included libraries +~~~~~~~~~~~~~~~~~~ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/release-notes.rst ===================================== @@ -4,4 +4,4 @@ Release notes .. toctree:: :maxdepth: 1 - 9.8.1-notes + 9.10.1-notes ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +{- + N.B. the contract of '%mulmayoflo' is a bit weak: "Return non-zero if there is + any possibility that the signed multiply of a and b might overflow. Return zero + only if you are absolutely sure that it won't overflow. If in doubt, return + non-zero." (Stg.h) + +This test verifies the a stronger contract: It's expected that there are no +false positives. This requirement is e.g. met by code generation backends which +execute the multiplication to check for overflow. +-} + +module Main where + +import GHC.Exts + +-- The argument and return types are unimportant: They're only used to force +-- evaluation, but carry no information. +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm ===================================== @@ -0,0 +1,98 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -226,3 +226,14 @@ test('T22296',[only_ways(llvm_ways) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) + +# TODO: Enable more architectures here. N.B. some code generation backends are +# not implemeted correctly (according to +# Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. +test('MulMayOflo_full', + [ extra_files(['MulMayOflo.hs']), + when(unregisterised(), skip), + unless(arch('x86_64') or arch('i386'), skip), + ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -1349,7 +1349,12 @@ { DumpSemis.hs:32:1-7 } (UnchangedAnchor)) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:33:1 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:6 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:7 }))]) (EpaComments [])) { DumpSemis.hs:32:1-7 }) (ValD @@ -1370,12 +1375,7 @@ { DumpSemis.hs:32:1-7 } (UnchangedAnchor)) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:33:1 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:6 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:7 }))]) + []) (EpaComments [])) { DumpSemis.hs:32:1-7 }) (Match @@ -1707,7 +1707,8 @@ { DumpSemis.hs:(36,1)-(44,4) } (UnchangedAnchor)) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:45:1 }))]) (EpaComments [])) { DumpSemis.hs:(36,1)-(44,4) }) (ValD @@ -1728,8 +1729,7 @@ { DumpSemis.hs:(36,1)-(44,4) } (UnchangedAnchor)) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:45:1 }))]) + []) (EpaComments [])) { DumpSemis.hs:(36,1)-(44,4) }) (Match @@ -2100,5 +2100,3 @@ (NoExtField)))))]))))))] (EmptyLocalBinds (NoExtField)))))])))))])) - - ===================================== testsuite/tests/printer/Test19784.hs ===================================== @@ -2,4 +2,9 @@ module Test19784 where { a 0 = 1; a _ = 2; + +-- c0 +b 0 = 1; -- c1 +b 1 = 2; -- c2 +b 2 = 3; -- c3 } ===================================== testsuite/tests/rename/should_compile/T23664.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies, TypeOperators #-} + +module T23664 where + +class POrd a where + type a >= b + infix 4 >= ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -214,6 +214,7 @@ test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) test('T23512b', normal, compile, ['']) +test('T23664', normal, compile, ['']) test('ExportWarnings1', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings1', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings2', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs', 'ExportWarnings_aux2.hs']), multimod_compile, ['ExportWarnings2', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings3', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings3', '-v0 -Wno-duplicate-exports -Wx-custom']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3195da2d9794489becd627ccc5f4f6160d97cd7b...3ecd4722b61410ef5e02cabedda25bed5e4c9939 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3195da2d9794489becd627ccc5f4f6160d97cd7b...3ecd4722b61410ef5e02cabedda25bed5e4c9939 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 21:28:12 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 18 Jul 2023 17:28:12 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] vdq: wording in docs and comments Message-ID: <64b703ec5d575_3a4b0fb74582470b7@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 9f1cc0f6 by Vladislav Zavialov at 2023-07-18T22:51:18+02:00 vdq: wording in docs and comments - - - - - 4 changed files: - compiler/GHC/Hs/Pat.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - docs/users_guide/exts/required_type_arguments.rst Changes: ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -588,8 +588,8 @@ isIrrefutableHsPat is_strict = goL -- since we cannot know until the splice is evaluated. go (SplicePat {}) = False - -- Unimportant, as isIrrefutableHsPat is only called in contexts - -- where EmbTyPat is rejected for other reasons (see TcRnIllegalTypePattern). + -- The behavior of this case is unimportant, as GHC will throw an error shortly + -- after reaching this case for other reasons (see TcRnIllegalTypePattern). go (EmbTyPat {}) = True go (XPat ext) = case ghcPass @p of ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -580,11 +580,10 @@ isOkNoBindPattern (L _ pat) = SumPat _ lp _ _ -> lpatternContainsSplice lp ConPat _ _ cpd -> any lpatternContainsSplice (hsConPatArgs cpd) XPat (HsPatExpanded _orig new) -> patternContainsSplice new - -- Corner cases - EmbTyPat{} -> - -- Unimportant, as isOkNoBindPattern is only called in contexts - -- where EmbTyPat is rejected for other reasons (see TcRnIllegalTypePattern). - True + + -- The behavior of this case is unimportant, as GHC will throw an error shortly + -- after reaching this case for other reasons (see TcRnIllegalTypePattern). + EmbTyPat{} -> True {- Note [Pattern bindings that bind no variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -2305,10 +2305,11 @@ isStrictPattern (L loc pat) = NPat{} -> True NPlusKPat{} -> True SplicePat{} -> True - EmbTyPat{} -> - -- Unimportant, as isStrictPattern is only called in contexts - -- where EmbTyPat is rejected for other reasons (see TcRnIllegalTypePattern). - False + + -- The behavior of this case is unimportant, as GHC will throw an error shortly + -- after reaching this case for other reasons (see TcRnIllegalTypePattern). + EmbTyPat{} -> False + XPat ext -> case ghcPass @p of #if __GLASGOW_HASKELL__ < 811 GhcPs -> dataConCantHappen ext ===================================== docs/users_guide/exts/required_type_arguments.rst ===================================== @@ -58,6 +58,7 @@ At use sites, we also instantiate this type variable explicitly:: Relation to :extension:`TypeApplications` ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + :extension:`RequiredTypeArguments` are similar to :extension:`TypeApplications` in that we pass a type to a function as an explicit argument. The difference is that type applications are optional: it is up to the caller whether to write @@ -105,7 +106,8 @@ indistinguishble from ordinary function arguments:: n = id_vdq Integer 42 -In this example we pass ``Integer`` as opposed to ``(type Integer)``. **This is -not currently implemented**. But for reasons of forward-compatibility, -:extension:`RequiredTypeArguments` does not allow the ``type`` syntax; nor does -it imply that :extension:`ExplicitNamespaces` does. \ No newline at end of file +In this example we pass ``Integer`` as opposed to ``(type Integer)``. +**This is not currently implemented**, but it demonstrates how +:extension:`RequiredTypeArguments` is not tied to the ``type`` syntax. +For this reason, using the ``type`` syntax requires enabling the +:extension:`ExplicitNamespaces` extension separately. \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f1cc0f6bc2135b471937725805e35ef9158d2a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f1cc0f6bc2135b471937725805e35ef9158d2a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 18 21:53:06 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 18 Jul 2023 17:53:06 -0400 Subject: [Git][ghc/ghc][wip/T22404] Remove the in-scope set from OccAnal Message-ID: <64b709c2b2921_3a4b0fb7458254290@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 78aae1b0 by Simon Peyton Jones at 2023-07-18T22:52:40+01:00 Remove the in-scope set from OccAnal - - - - - 2 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/SimpleOpt.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -666,7 +666,7 @@ Here are the consequences * In the tricky (P3) we'll get an `andUDs` of * OneOcc{occ_n_br=0} from the occurrences of `j`) * OneOcc{occ_n_br=1} from the (f v) - These are `andUDs` together, and hence `addOccInfo`, and hence + These are `andUDs` together in `addOccInfo`, and hence `v` gets ManyOccs, just as it should. Clever! There are a couple of tricky wrinkles @@ -2151,32 +2151,37 @@ occAnalLamTail env expr occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Does not markInsidLam etc for the outmost batch of lambdas occ_anal_lam_tail env (Lam bndr expr) - | isTyVar bndr - = addInScope env [bndr] $ \env -> - let !(WUD usage expr') = occ_anal_lam_tail env expr - in WUD usage (Lam bndr expr') - -- Important: Do not modify occ_encl, so that with a RHS like - -- \(@ x) -> K @x (f @x) - -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain - -- from inlining f. See the beginning of Note [Cascading inlines]. - - | otherwise -- So 'bndr' is an Id - = addInScope env [bndr] $ \env -> - let (env_one_shots', bndr1) - = case occ_one_shots env of - [] -> ([], bndr) - (os : oss) -> (oss, updOneShotInfo bndr os) - -- Use updOneShotInfo, not setOneShotInfo, as pre-existing - -- one-shot info might be better than what we can infer, e.g. - -- due to explicit use of the magic 'oneShot' function. - -- See Note [The oneShot function] - - env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - !(WUD usage expr') = occ_anal_lam_tail env1 expr - bndr2 = tagLamBinder usage bndr1 - usage1 = usage `addManyOccs` coVarsOfType (idType bndr) - -- usage1: see Note [Gather occurrences of coercion variables] - in WUD usage1 (Lam bndr2 expr') + = go env [bndr] expr + where + go :: OccEnv -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env rev_bndrs (Lam bndr expr) + | isTyVar bndr + = go env (bndr:rev_bndrs) expr + -- Important: Do not modify occ_encl, so that with a RHS like + -- \(@ x) -> K @x (f @x) + -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain + -- from inlining f. See the beginning of Note [Cascading inlines]. + + | otherwise + = let (env_one_shots', bndr1) + = case occ_one_shots env of + [] -> ([], bndr) + (os : oss) -> (oss, updOneShotInfo bndr os) + -- Use updOneShotInfo, not setOneShotInfo, as pre-existing + -- one-shot info might be better than what we can infer, e.g. + -- due to explicit use of the magic 'oneShot' function. + -- See Note [The oneShot function] + env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } + in go env1 (bndr1 : rev_bndrs) expr + + go env rev_bndrs expr + = let bndrs = reverse rev_bndrs in + addInScope env bndrs $ \env -> + let !(WUD usage expr') = occ_anal_lam_tail env expr + bndrs' = tagLamBinders usage bndrs + in WUD (usage `addLamCoVarOccs` bndrs) + (mkLams bndrs' expr') + -- addLamCoVarOccs: see Note [Gather occurrences of coercion variables] -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] @@ -2785,8 +2790,6 @@ data OccEnv , occ_rule_act :: Activation -> Bool -- Which rules are active -- See Note [Finding rule RHS free vars] - , occ_in_scope :: VarSet -- Set of variables in scope - -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, -- then please replace x by (y |> mco) @@ -2834,8 +2837,7 @@ type OneShots = [OneShotInfo] initOccEnv :: OccEnv initOccEnv - = OccEnv { occ_in_scope = emptyVarSet - , occ_encl = OccVanilla + = OccEnv { occ_encl = OccVanilla , occ_one_shots = [] -- To be conservative, we say that all @@ -2911,40 +2913,58 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a -- Needed for all Vars not just Ids; a TyVar might have a CoVars in its kind -addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points }) +addInScope env@(OccEnv { occ_join_points = join_points }) bndrs thing_inside - | not (any (`elemVarSet` in_scope) bndrs) + | not bad_joins = -- No shadowing here; fast path for this common case - fix_up_uds (thing_inside env_w_bndrs) + del_bndrs_from_uds $ + thing_inside $ + drop_shadowed_swaps $ + env | otherwise -- Shadowing! Lots of things to do - = fix_up_uds $ - add_bad_joins $ - thing_inside $ + = add_bad_joins $ + del_bndrs_from_uds $ + thing_inside $ drop_shadowed_swaps $ drop_shadowed_joins $ - env_w_bndrs + env where - env_w_bndrs = env { occ_in_scope = in_scope `extendVarSetList` bndrs } + bndr_set :: UniqSet Var + bndr_set = mkVarSet bndrs + + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set + + -- bad_joins is true if it would be wrong to push occ_join_points inwards + -- (a) `bndrs` includes any of the occ_join_points + -- (b) `bndrs` includes any variables free in the RHSs of occ_join_points + bad_joins :: Bool + bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points + + is_bad :: Unique -> OccInfoEnv -> Bool -> Bool + is_bad uniq join_uds rest + = uniq `elemUniqSet_Directly` bndr_set || + not (bndr_fm `disjointUFM` join_uds) || + rest drop_shadowed_swaps :: OccEnv -> OccEnv -- See Note [The binder-swap substitution] (BS3) drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = bs_rng_vars }) - | any (`elemVarSet` bs_rng_vars) bndrs - = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } + | bs_rng_vars `disjointUniqSets` bndr_set + = env { occ_bs_env = swap_env `minusUFM` bndr_fm } | otherwise - = env { occ_bs_env = swap_env `delVarEnvList` bndrs } + = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } drop_shadowed_joins :: OccEnv -> OccEnv -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) --- drop_shadowed_joins env = env { occ_join_points = good_joins `delVarEnvList` bndrs } drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } - fix_up_uds :: WithUsageDetails a -> WithUsageDetails a + del_bndrs_from_uds :: WithUsageDetails a -> WithUsageDetails a -- Remove usage for bndrs -- Add usage info for CoVars used in the types of bndrs - fix_up_uds (WUD uds res) = WUD (uds `delDetails` bndrs) res + del_bndrs_from_uds (WUD uds res) = WUD (uds `delDetails` bndr_fm) res add_bad_joins :: WithUsageDetails a -> WithUsageDetails a -- Add usage info for occ_join_points that we cannot push inwardsa @@ -2966,14 +2986,6 @@ addInScope env@(OccEnv { occ_in_scope = in_scope, occ_join_points = join_points | uniq `elemVarEnvByKey` env = env `plusVarEnv` join_env | otherwise = env -{- - bad_joins, good_joins :: IdEnv UsageDetails - (bad_joins, good_joins) = partitionVarEnv bad_join_rhs join_points - - bad_join_rhs :: UsageDetails -> Bool - bad_join_rhs (UD { ud_env = rhs_usage }) = any (`elemVarEnv` rhs_usage) bndrs --} - addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv addJoinPoint env bndr rhs_uds | isEmptyVarEnv zeroed_form @@ -3511,6 +3523,12 @@ addManyOccs uds var_set add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set -- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes +addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails +-- Add any CoVars free in the type of a lambda-binder +-- See Note [Gather occurrences of coercion variables] +addLamCoVarOccs uds bndrs + = uds `addManyOccs` coVarsOfTypes [ idType id | id <- bndrs, isId id ] + emptyDetails :: UsageDetails emptyDetails = mkSimpleDetails emptyVarEnv @@ -3533,16 +3551,16 @@ emptyDetails = UD { ud_env = emptyVarEnv isEmptyDetails :: UsageDetails -> Bool isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env -delDetails :: UsageDetails -> [Id] -> UsageDetails +delDetails :: UsageDetails -> UniqFM Var a -> UsageDetails -- Delete these binders from the UsageDetails delDetails (UD { ud_env = env , ud_z_many = z_many , ud_z_in_lam = z_in_lam - , ud_z_tail = z_tail }) bndrs - = UD { ud_env = env `delVarEnvList` bndrs - , ud_z_many = z_many `delVarEnvList` bndrs - , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs - , ud_z_tail = z_tail `delVarEnvList` bndrs } + , ud_z_tail = z_tail }) bndr_fm + = UD { ud_env = env `minusUFM` bndr_fm + , ud_z_many = z_many `minusUFM` bndr_fm + , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm + , ud_z_tail = z_tail `minusUFM` bndr_fm } markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -263,7 +263,6 @@ simple_opt_expr env expr go lam@(Lam {}) = go_lam env [] lam go (Case e b ty as) - -- See Note [Getting the map/coerce RULE to work] | isDeadBinder b , Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e' -- We don't need to be concerned about floats when looking for coerce. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78aae1b094ea9b225fc696e9c33e9728a18ae2ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78aae1b094ea9b225fc696e9c33e9728a18ae2ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 00:36:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 18 Jul 2023 20:36:21 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 42 commits: Bump deepseq bound to allow 1.5 Message-ID: <64b730057dadf_3a4b0f406ce402706c2@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 1228d3a4 by Ben Gamari at 2023-07-06T20:16:06-04:00 Bump deepseq bound to allow 1.5 - - - - - d3ffdaf9 by Ben Gamari at 2023-07-06T20:21:22-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - bf57fc9a by Ben Gamari at 2023-07-06T21:50:24-04:00 template-haskell: Bump version to 2.21.0.0 - - - - - 433d99a3 by Ben Gamari at 2023-07-12T09:42:25-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 89cb22c2 by Matthew Pickering at 2023-07-12T09:42:25-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 (cherry picked from commit 6295416ba0bc3e729b1f3dea56ef5d722f98ee9d) - - - - - 44b3c6d4 by Matthew Pickering at 2023-07-12T09:42:25-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 (cherry picked from commit 75b8b39a860a643b78405787bac582ba7cc3cb21) - - - - - b934a05f by Ben Gamari at 2023-07-12T09:42:25-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. (cherry picked from commit 46c9bcd6a47bdaa70869ed64da315315974b8b1d) - - - - - 8a6eb56a by Ben Gamari at 2023-07-12T09:42:25-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. (cherry picked from commit ec55035f8fe901b5d369221975fb1a741c677acb) - - - - - 7a5a1163 by Ben Gamari at 2023-07-12T09:42:25-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. (cherry picked from commit 3a09b789102dc0ea20a9af0912bc817ac5cb8c59) - - - - - ea1fb768 by Bryan Richter at 2023-07-12T09:42:25-04:00 Add missing void prototypes to rts functions See #23561. (cherry picked from commit 82ac6bf113526f61913943b911089534705984fb) - - - - - a474caef by Ben Gamari at 2023-07-12T09:42:25-04:00 gitlab-ci: Bump DOCKER_REV Ensuring that we bootstrap with GHC 9.4 universally. - - - - - 024861af by Ben Gamari at 2023-07-12T09:42:26-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. - - - - - 3b12e852 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. (cherry picked from commit 5b6612bc4f6b0a7ecc9868750bee1c359ffca871) - - - - - d72181cd by Ben Gamari at 2023-07-12T09:42:26-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files (cherry picked from commit 8b35e8caafeeccbf06b7faa70e807028a3f0ff43) - - - - - 594525fa by Ben Gamari at 2023-07-12T09:42:26-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. (cherry picked from commit d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8) - - - - - 555ad690 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. (cherry picked from commit 7c7d1f66d35f73a2faa898a33aa80cd276159dc2) - - - - - c4bb9e3e by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Various warnings fixes (cherry picked from commit cb92051e3d85575ff6abd753c9b135930cc50cf8) - - - - - f484169c by Ben Gamari at 2023-07-12T09:42:26-04:00 hadrian: Ignore warnings in unix and semaphore-compat (cherry picked from commit dec81dd1fd0475dde4929baae625d155387300bb) - - - - - 9922b77c by Matthew Pickering at 2023-07-12T09:42:26-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 (cherry picked from commit d7f6448aa06bbf26173a06ee5c624f5b734786c5) - - - - - ab74326f by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. (cherry picked from commit fd8c57694a00f6359bd66365f1284388c869ac60) - - - - - 9d9d9bc5 by Luite Stegeman at 2023-07-12T09:42:26-04:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 (cherry picked from commit 564164ef323a9f2cdeb8c69dcb2cf6df6382de4e) - - - - - a6ebaa83 by Torsten Schmits at 2023-07-12T09:42:26-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 (cherry picked from commit 40f4ef7c40e747dfea491d297475458d2ccaf860) - - - - - 3d6bd455 by Torsten Schmits at 2023-07-12T09:42:26-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 (cherry picked from commit 6fdcf969db85f3fe64123ba150e9226a0d2995cd) - - - - - a814fb6d by Ben Bellick at 2023-07-12T09:42:26-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure (cherry picked from commit 03f941f45607a5ee52ca53a358333bbb41ddb1bc) - - - - - cee76805 by aadaa_fgtaa at 2023-07-12T09:42:26-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts (cherry picked from commit b3e1436f968c0c36a27ea0339ee2554970b329fe) - - - - - 445dc082 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Add failing test case for #23492 (cherry picked from commit 6074cc3cda9b9836c784942a1aa7f766fb142787) - - - - - c505474d by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. (cherry picked from commit 356a269258a50bf67811fe0edb193fc9f82dfad1) - - - - - 765c1de8 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils (cherry picked from commit 3efe7f399a53ec7930c8a333ad2c114d956f0c2a) - - - - - 809f9b81 by Moisés Ackerman at 2023-07-12T09:42:26-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors (cherry picked from commit dd782343f131cfd983a7fb2431d9d4a9ae497551) - - - - - 76668b6e by Ben Gamari at 2023-07-12T09:42:26-04:00 Fix breakpoint - - - - - 2b3da4c4 by Ben Gamari at 2023-07-12T09:42:26-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. (cherry picked from commit bb0ed354b9b05c0774c1e9379823bceb785987ce) - - - - - 62bfea7a by Ben Gamari at 2023-07-13T08:10:26-04:00 gitlab-ci: Bump ci-images To freeze emsdk, avoiding #23641. - - - - - a01879a7 by Ben Gamari at 2023-07-13T08:10:26-04:00 testsuite: Accept metric changes Metric Increase: T6048 - - - - - c046a238 by Ben Gamari at 2023-07-13T08:10:26-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. - - - - - f356a7e8 by Ben Gamari at 2023-07-13T08:10:26-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. - - - - - c86a4055 by Ben Gamari at 2023-07-13T16:19:02-04:00 Update generate_bootstrap_plans - - - - - d58049ef by Ben Gamari at 2023-07-13T16:28:54-04:00 hadrian/bootstrap: Drop GHC 9.2 plans - - - - - a79d1806 by Ben Gamari at 2023-07-13T16:29:39-04:00 hadrian/bootstrap: Add 9.6.2 plans - - - - - 4f142ee9 by Ben Gamari at 2023-07-13T16:34:08-04:00 hadrian/bootstrap: Regenerate existing plans - - - - - 031d7f7c by Ben Gamari at 2023-07-13T17:27:30-04:00 gitlab-ci: Drop test-bootstrap:9.2 jobs - - - - - 0d7a34c1 by Ben Gamari at 2023-07-18T20:36:07-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - ed28b0f2 by Ben Gamari at 2023-07-18T20:36:07-04:00 rts/win32: Ensure reliability of IO manager shutdown When the Win32 threaded IO manager shuts down, `ioManagerDie` sends an `IO_MANAGER_DIE` event to the IO manager thread using the `io_manager_event` event object. Finally, it will closes the event object, and invalidate `io_manager_event`. Previously, `readIOManagerEvent` would see that `io_manager_event` is invalid and return `0`, suggesting that everything is right with the world. This meant that if `ioManagerDie` invalidated the handle before the event manager was blocked on the event we would end up in a situation where the event manager would never realize it was asked to shut down. Fix this by ensuring that `readIOManagerEvent` instead returns `IO_MANAGER_DIE` when we detect that the event object has been invalidated by `ioManagerDie`. Fixes #23691. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debugging.rst - docs/users_guide/using-optimisation.rst - ghc/ghc-bin.cabal.in - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a3c7d3a12e584b5e6c08a10968e42ff1d62e4c0...ed28b0f2cac246e9dad669fd59631b8f9e5db2f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a3c7d3a12e584b5e6c08a10968e42ff1d62e4c0...ed28b0f2cac246e9dad669fd59631b8f9e5db2f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 02:08:53 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Tue, 18 Jul 2023 22:08:53 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] Add flag to `-f{no-}specialise-incoherents` to enable/disable specialisation of Message-ID: <64b745b5107ed_3a4b0fb73cc2771b1@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 31805655 by Gergő Érdi at 2023-07-19T03:06:06+01:00 Add flag to `-f{no-}specialise-incoherents` to enable/disable specialisation of incoherent instances Fixes #23287 - - - - - 25 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Irred.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/Basic.hs - docs/users_guide/using-optimisation.rst - testsuite/tests/simplCore/should_run/T22448.hs - utils/check-exact/ExactPrint.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -11,7 +11,7 @@ The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv. module GHC.Core.InstEnv ( DFunId, InstMatch, ClsInstLookupResult, - Coherence(..), PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, + Canonical, PotentialUnifiers(..), getPotentialUnifiers, nullUnifiers, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, instanceHead, instanceSig, mkLocalClsInst, mkImportedClsInst, @@ -122,10 +122,11 @@ fuzzyClsInstCmp x y = cmp (RM_KnownTc _, RM_WildCard) = GT cmp (RM_KnownTc x, RM_KnownTc y) = stableNameCmp x y -isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool +isOverlappable, isOverlapping, isIncoherent, isNonCanonical :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) isOverlapping i = hasOverlappingFlag (overlapMode (is_flag i)) isIncoherent i = hasIncoherentFlag (overlapMode (is_flag i)) +isNonCanonical i = hasNonCanonicalFlag (overlapMode (is_flag i)) {- Note [ClsInst laziness and the rough-match fields] @@ -812,8 +813,41 @@ example Here both (I7) and (I8) match, GHC picks an arbitrary one. -So INCOHERENT may break the Coherence Assumption. To avoid this -incoherence breaking the specialiser, +So INCOHERENT may break the Coherence Assumption. But sometimes that +is fine, because the programmer promises that it doesn't matter which +one is chosen. A good example is in the `optics` library: + + data IxEq i is js where { IxEq :: IxEq i is is } + + class AppendIndices xs ys ks | xs ys -> ks where + appendIndices :: IxEq i (Curry xs (Curry ys i)) (Curry ks i) + + instance {-# INCOHERENT #-} xs ~ zs => AppendIndices xs '[] zs where + appendIndices = IxEq + + instance ys ~ zs => AppendIndices '[] ys zs where + appendIndices = IxEq + +Here `xs` and `ys` are type-level lists, and for type inference purposes we want to +solve the `AppendIndices` constraint when /either/ of them are the empty list. The +dictionaries are the same in both cases (indeed the dictionary type is a singleton!), +so we really don't care which is used. See #23287 for discussion. + + +In short, sometimes we want to specialise on these incoherently-selected dictionaries, +and sometimes we don't. It would be best to have a per-instance pragma, but for now +we have a global flag: + +* If an instance has an `{-# INCOHERENT #-}` pragma, we use its `OverlapFlag` to + label it as either + * `Incoherent`: meaning incoherent but still specialisable, or + * `NonCanonical`: meaning incoherent and not specialisable. + +The module-wide `-fspecialise-incoherents` flag determines which +choice is made. The rest of this note describes what happens for +`NonCanonical` instances, i.e. with `-fno-specialise-incoherents`. + +To avoid this incoherence breaking the specialiser, * We label as "incoherent" the dictionary constructed by a (potentially) incoherent use of an instance declaration. @@ -850,7 +884,7 @@ Here are the moving parts: * `GHC.HsToCore.Binds.dsHsWrapper` desugars the evidence application (f d) into (nospec f d) if `d` is incoherent. It has to do a dependency analysis to determine transitive dependencies, but we need to do that anyway. - See Note [Desugaring incoherent evidence] in GHC.HsToCore.Binds. + See Note [Desugaring non-canonical evidence] in GHC.HsToCore.Binds. See also Note [nospecId magic] in GHC.Types.Id.Make. -} @@ -955,10 +989,13 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +type Canonical = Bool -- See Note [Recording coherence information in `PotentialUnifiers`] -data PotentialUnifiers = NoUnifiers Coherence +data PotentialUnifiers = NoUnifiers Canonical + -- NoUnifiers True: We have a unique solution modulo canonicity + -- NoUnifiers False: The solutions is not canonical, and thus + -- we shouldn't specialise on it. | OneOrMoreUnifiers (NonEmpty ClsInst) -- This list is lazy as we only look at all the unifiers when -- printing an error message. It can be expensive to compute all @@ -967,33 +1004,28 @@ data PotentialUnifiers = NoUnifiers Coherence {- Note [Recording coherence information in `PotentialUnifiers`] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If we have any potential unifiers, then we go down the `NotSure` route -in `matchInstEnv`. According to Note [Rules for instance lookup] -steps IL4 and IL6, we only care about non-`INCOHERENT` instances for -this purpose. - -It is only when we don't have any potential unifiers (i.e. we know -that we have a unique solution modulo `INCOHERENT` instances) that we -care about that unique solution being coherent or not (see -Note [Coherence and specialisation: overview] for why we care at all). -So we only need the `Coherent` flag in the case where the set of -potential unifiers is otherwise empty. --} -instance Outputable Coherence where - ppr IsCoherent = text "coherent" - ppr IsIncoherent = text "incoherent" +When we find a matching instance, there might be other instances that +could potentially unify with the goal. For `INCOHERENT` instances, we +don't care (see steps IL4 and IL6 in Note [Rules for instance +lookup]). But if we have potentially unifying coherent instance, we +report these `OneOrMoreUnifiers` so that `matchInstEnv` can go down +the `NotSure` route. + +If this hurdle is passed, i.e. we have a unique solution up to +`INCOHERENT` instances, the specialiser needs to know if that unique +solution is canonical or not (see Note [Coherence and specialisation: +overview] for why we care at all). So when the set of potential +unifiers is empty, we record in `NoUnifiers` if the one solution is +`Canonical`. +-} instance Outputable PotentialUnifiers where - ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c + ppr (NoUnifiers c) = text "NoUnifiers" <+> if c then text "canonical" else text "non-canonical" ppr xs = ppr (getPotentialUnifiers xs) -instance Semigroup Coherence where - IsCoherent <> IsCoherent = IsCoherent - _ <> _ = IsIncoherent - instance Semigroup PotentialUnifiers where - NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 <> c2) + NoUnifiers c1 <> NoUnifiers c2 = NoUnifiers (c1 && c2) NoUnifiers _ <> u = u OneOrMoreUnifiers (unifier :| unifiers) <> u = OneOrMoreUnifiers (unifier :| (unifiers <> getPotentialUnifiers u)) @@ -1039,22 +1071,24 @@ lookupInstEnv' (InstEnv rm) vis_mods cls tys = acc - incoherently_matched :: PotentialUnifiers -> PotentialUnifiers - incoherently_matched (NoUnifiers _) = NoUnifiers IsIncoherent - incoherently_matched u = u + noncanonically_matched :: PotentialUnifiers -> PotentialUnifiers + noncanonically_matched (NoUnifiers _) = NoUnifiers False + noncanonically_matched u = u check_unifier :: [ClsInst] -> PotentialUnifiers - check_unifier [] = NoUnifiers IsCoherent + check_unifier [] = NoUnifiers True check_unifier (item at ClsInst { is_tvs = tpl_tvs, is_tys = tpl_tys }:items) | not (instIsVisible vis_mods item) = check_unifier items -- See Note [Instance lookup and orphan instances] | Just {} <- tcMatchTys tpl_tys tys = check_unifier items -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] + -- Record that we encountered non-canonical instances: Note [Coherence and specialisation: overview] + | isNonCanonical item + = noncanonically_matched $ check_unifier items -- Ignore ones that are incoherent: Note [Incoherent instances] - -- Record that we encountered incoherent instances: Note [Coherence and specialisation: overview] | isIncoherent item - = incoherently_matched $ check_unifier items + = check_unifier items | otherwise = assertPpr (tys_tv_set `disjointVarSet` tpl_tv_set) @@ -1111,7 +1145,7 @@ lookupInstEnv check_overlap_safe -- If the selected match is incoherent, discard all unifiers final_unifs = case final_matches of - (m:_) | isIncoherent (fst m) -> NoUnifiers IsCoherent + (m:_) | isIncoherent (fst m) -> NoUnifiers True _ -> all_unifs -- Note [Safe Haskell isSafeOverlap] @@ -1289,7 +1323,7 @@ noMatches = InstMatches { instMatches = [], instGuards = [] } pruneOverlappedMatches :: [InstMatch] -> [InstMatch] -- ^ Remove from the argument list any InstMatches for which another -- element of the list is more specific, and overlaps it, using the --- rules of Nove [Rules for instance lookup] +-- rules of Note [Rules for instance lookup] pruneOverlappedMatches all_matches = instMatches $ foldr insert_overlapping noMatches all_matches @@ -1446,33 +1480,8 @@ If the choice of instance *does* matter, all bets are still not off: users can consult the detailed specification of the instance selection algorithm in the GHC Users' Manual. However, this means we can end up with different instances at the same types at different parts of the -program, and this difference has to be preserved. For example, if we -have - - class C a where - op :: a -> String - - instance {-# OVERLAPPABLE #-} C a where ... - instance {-# INCOHERENT #-} C () where ... - -then depending on the circumstances (see #22448 for a full setup) some -occurrences of `op :: () -> String` may be resolved to the generic -instance, and other to the specific one; so we end up in the desugared -code with occurrences of both - - op @() ($dC_a @()) - -and - - op @() $dC_() - -In particular, the specialiser needs to ignore the incoherently -selected instance in `op @() ($dC_a @())`. So during instance lookup, -we record in `PotentialUnifiers` if a given solution was arrived at -incoherently; we then use this information to inhibit specialisation -a la Note [nospecId magic] in GHC.Types.Id.Make. - - +program, and this difference has to be preserved. Note [Coherence and +specialisation: overview] details how we achieve that. ************************************************************************ * * ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1169,7 +1169,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecialiseIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -268,6 +268,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecialiseIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2422,6 +2422,7 @@ fFlagsDeps = [ flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, + flagSpec "specialise-incoherents" Opt_SpecialiseIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -911,6 +911,7 @@ ppOverlapPragma mb = 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 where maybe_stext NoSourceText alt = text alt maybe_stext (SourceText src) _ = ftext src <+> text "#-}" ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -41,7 +41,7 @@ import GHC.Hs -- lots of things import GHC.Core -- lots of things import GHC.Core.SimpleOpt ( simpleOptExpr ) import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Core.Make import GHC.Core.Utils import GHC.Core.Opt.Arity ( etaExpand ) @@ -1152,14 +1152,14 @@ evidence that is used in `e`. This question arose when thinking about deep subsumption; see https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649). -Note [Desugaring incoherent evidence] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -If the evidence is coherent, we desugar WpEvApp by simply passing +Note [Desugaring non-canonical evidence] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +If the evidence is canonical, we desugar WpEvApp by simply passing core_tm directly to k: k core_tm -If the evidence is not coherent, we mark the application with nospec: +If the evidence is not canonical, we mark the application with nospec: nospec @(cls => a) k core_tm @@ -1170,14 +1170,14 @@ of the same type (see Note [nospecId magic] in GHC.Types.Id.Make). See Note [Coherence and specialisation: overview] for why we shouldn't specialise incoherent evidence. -We can find out if a given evidence is coherent or not during the -desugaring of its WpLet wrapper: an evidence is incoherent if its +We can find out if a given evidence is canonical or not during the +desugaring of its WpLet wrapper: an evidence is non-canonical if its own resolution was incoherent (see Note [Incoherent instances]), or -if its definition refers to other incoherent evidence. dsEvBinds is +if its definition refers to other non-canonical evidence. dsEvBinds is the convenient place to compute this, since it already needs to do inter-evidence dependency analysis to generate well-scoped -bindings. We then record this coherence information in the -dsl_coherence field of DsM's local environment. +bindings. We then record this specialisability information in the +dsl_unspecables field of DsM's local environment. -} @@ -1201,20 +1201,27 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring non-canonical evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } +-- We are about to construct an evidence application `f dict`. If the dictionary is +-- non-specialisable, instead construct +-- nospec f dict +-- See Note [nospecId magic] in GHC.Types.Id.Make for what `nospec` does. app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1232,7 +1239,7 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- * Desugars the ev_binds, sorts them into dependency order, and -- passes the resulting [CoreBind] to thing_inside --- * Extends the DsM (dsl_coherence field) with coherence information +-- * Extends the DsM (dsl_unspecable field) with specialisability information -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside @@ -1240,53 +1247,50 @@ dsEvBinds ev_binds thing_inside ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where - go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a + go ::[SCC (Node EvVar (Canonical, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False - - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where - ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + ((v, rhs), (this_canonical, deps)) = unpack_node node + transitively_unspecable = not this_canonical || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where - (pairs, direct_coherence) = unzip $ map unpack_node nodes + (pairs, direct_canonicity) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not this_canonical || any is_unspecable_remote deps | (this_canonical, deps) <- direct_canonicity ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring non-canonical evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty - unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) + unpack_node DigraphNode { node_key = v, node_payload = (canonical, rhs), node_dependencies = deps } = ((v, rhs), (canonical, deps)) -sort_ev_binds :: Bag (Id, Coherence, CoreExpr) -> [SCC (Node EvVar (Coherence, CoreExpr))] +sort_ev_binds :: Bag (Id, Canonical, CoreExpr) -> [SCC (Node EvVar (Canonical, CoreExpr))] -- We do SCC analysis of the evidence bindings, /after/ desugaring -- them. This is convenient: it means we can use the GHC.Core -- free-variable functions rather than having to do accurate free vars -- for EvTerm. sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges where - edges :: [ Node EvVar (Coherence, CoreExpr) ] + edges :: [ Node EvVar (Canonical, CoreExpr) ] edges = foldr ((:) . mk_node) [] ds_binds - mk_node :: (Id, Coherence, CoreExpr) -> Node EvVar (Coherence, CoreExpr) - mk_node (var, coherence, rhs) - = DigraphNode { node_payload = (coherence, rhs) + mk_node :: (Id, Canonical, CoreExpr) -> Node EvVar (Canonical, CoreExpr) + mk_node (var, canonical, rhs) + = DigraphNode { node_payload = (canonical, rhs) , node_key = var , node_dependencies = nonDetEltsUniqSet $ exprFreeVars rhs `unionVarSet` @@ -1295,13 +1299,13 @@ sort_ev_binds ds_binds = stronglyConnCompFromEdgedVerticesUniqR edges -- is still deterministic even if the edges are in nondeterministic order -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. -dsEvBind :: EvBind -> DsM (Id, Coherence, CoreExpr) +dsEvBind :: EvBind -> DsM (Id, Canonical, CoreExpr) dsEvBind (EvBind { eb_lhs = v, eb_rhs = r, eb_info = info }) = do e <- dsEvTerm r - let coherence = case info of - EvBindGiven{} -> IsCoherent - EvBindWanted{ ebi_coherence = coherence } -> coherence - return (v, coherence, e) + let canonical = case info of + EvBindGiven{} -> True + EvBindWanted{ ebi_canonical = canonical } -> canonical + return (v, canonical, e) {-********************************************************************** ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -357,7 +357,7 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +413,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -2628,6 +2628,7 @@ repOverlap mb = Overlapping _ -> just =<< dataCon overlappingDataConName Overlaps _ -> just =<< dataCon overlapsDataConName Incoherent _ -> just =<< dataCon incoherentDataConName + NonCanonical _ -> just =<< dataCon incoherentDataConName where nothing = coreNothing overlapTyConName just = coreJust overlapTyConName ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -79,9 +79,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar - -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + , dsl_unspecables :: S.Set EvVar + -- ^ See Note [Desugaring non-canonical evidence]: this field collects + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1212,11 +1212,11 @@ addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty ; case dest of EvVarDest evar - -> addTcEvBind ev_binds_var $ mkWantedEvBind evar IsCoherent err_tm + -> addTcEvBind ev_binds_var $ mkWantedEvBind evar True err_tm HoleDest hole -> do { -- See Note [Deferred errors for coercion holes] let co_var = coHoleCoVar hole - ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var IsCoherent err_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var True err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2514,6 +2514,7 @@ reifyClassInstance is_poly_tvs i Overlapping _ -> Just TH.Overlapping Overlaps _ -> Just TH.Overlaps Incoherent _ -> Just TH.Incoherent + NonCanonical _ -> Just TH.Incoherent ------------------------------ reifyFamilyInstances :: TyCon -> [FamInst] -> TcM [TH.Dec] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -92,7 +92,10 @@ data ClsInstResult | OneInst { cir_new_theta :: [TcPredType] , cir_mk_ev :: [EvExpr] -> EvTerm - , cir_coherence :: Coherence -- See Note [Coherence and specialisation: overview] + , cir_canonical :: Canonical -- cir_canonical=True => you can specialise on this instance + -- cir_canonical= False => you cannot specialise on this instance + -- (its OverlapFlag is NonCanonical) + -- See Note [Coherence and specialisation: overview] , cir_what :: InstanceWhat } | NotSure -- Multiple matches and/or one or more unifiers @@ -162,7 +165,7 @@ matchInstEnv dflags short_cut_solver clas tys ; return NoInstance } -- A single match (& no safe haskell failure) - ([(ispec, inst_tys)], NoUnifiers coherence, False) + ([(ispec, inst_tys)], NoUnifiers canonical, False) | short_cut_solver -- Called from the short-cut solver , isOverlappable ispec -- If the instance has OVERLAPPABLE or OVERLAPS or INCOHERENT @@ -175,12 +178,11 @@ matchInstEnv dflags short_cut_solver clas tys | otherwise -> do { let dfun_id = instanceDFunId ispec ; traceTc "matchClass success" $ - vcat [text "dict" <+> ppr pred, - ppr coherence, + vcat [text "dict" <+> ppr pred <+> parens (if canonical then text "canonical" else text "non-canonical"), text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ] -- Record that this dfun is needed - ; match_one (null unsafeOverlaps) coherence dfun_id inst_tys } + ; match_one (null unsafeOverlaps) canonical dfun_id inst_tys } -- More than one matches (or Safe Haskell fail!). Defer any -- reactions of a multitude until we learn more about the reagent @@ -191,15 +193,15 @@ matchInstEnv dflags short_cut_solver clas tys where pred = mkClassPred clas tys -match_one :: SafeOverlapping -> Coherence -> DFunId -> [DFunInstType] -> TcM ClsInstResult +match_one :: SafeOverlapping -> Canonical -> DFunId -> [DFunInstType] -> TcM ClsInstResult -- See Note [DFunInstType: instantiating types] in GHC.Core.InstEnv -match_one so coherence dfun_id mb_inst_tys +match_one so canonical dfun_id mb_inst_tys = do { traceTc "match_one" (ppr dfun_id $$ ppr mb_inst_tys) ; (tys, theta) <- instDFunType dfun_id mb_inst_tys ; traceTc "match_one 2" (ppr dfun_id $$ ppr tys $$ ppr theta) ; return $ OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = TopLevInstance { iw_dfun_id = dfun_id , iw_safe_over = so } } } @@ -235,7 +237,7 @@ matchCTuple :: Class -> [Type] -> TcM ClsInstResult matchCTuple clas tys -- (isCTupleClass clas) holds = return (OneInst { cir_new_theta = tys , cir_mk_ev = tuple_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) -- The dfun *is* the data constructor! where @@ -399,7 +401,7 @@ makeLitDict clas ty et , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) = return $ OneInst { cir_new_theta = [] , cir_mk_ev = \_ -> ev_tm - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } | otherwise @@ -448,7 +450,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_canonical = False -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } @@ -555,7 +557,7 @@ Some further observations about `withDict`: k (sv |> (sub co2 ; sym co))) That is, we cast the method using a coercion, and apply k to - it. Moreover, we mark the evidence as incoherent, resulting in + it. Moreover, we mark the evidence as non-canonical, resulting in the use of the 'nospec' magicId (see Note [nospecId magic] in GHC.Types.Id.Make) to ensure that the typeclass specialiser doesn't incorrectly common-up distinct evidence terms. This is @@ -641,7 +643,7 @@ doFunTy :: Class -> Type -> Mult -> Type -> Type -> TcM ClsInstResult doFunTy clas ty mult arg_ty ret_ty = return $ OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where preds = map (mk_typeable_pred clas) [mult, arg_ty, ret_ty] @@ -658,7 +660,7 @@ doTyConApp clas ty tc kind_args | tyConIsTypeable tc = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) kind_args , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinTypeableInstance tc } | otherwise = return NoInstance @@ -690,7 +692,7 @@ doTyApp clas ty f tk | otherwise = return $ OneInst { cir_new_theta = map (mk_typeable_pred clas) [f, tk] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } where mk_ev [t1,t2] = evTypeable ty $ EvTypeableTyApp (EvExpr t1) (EvExpr t2) @@ -711,7 +713,7 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc mk_ev _ = panic "doTyLit" ; return (OneInst { cir_new_theta = [kc_pred] , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance }) } {- Note [Typeable (T a b c)] @@ -946,7 +948,7 @@ matchHasField dflags short_cut clas tys ; keepAlive (greName gre) ; return OneInst { cir_new_theta = theta , cir_mk_ev = mk_ev - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = BuiltinInstance } } else matchInstEnv dflags short_cut clas tys } ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -33,7 +33,6 @@ import GHC.Data.Bag import GHC.Core.Class import GHC.Core import GHC.Core.DataCon -import GHC.Core.InstEnv ( Coherence(IsCoherent) ) import GHC.Core.Make import GHC.Driver.DynFlags import GHC.Data.FastString @@ -612,7 +611,7 @@ solveImplicationUsingUnsatGiven go_simple ct = case ctEvidence ct of CtWanted { ctev_pred = pty, ctev_dest = dst } -> do { ev_expr <- unsatisfiableEvExpr unsat_given pty - ; setWantedEvTerm dst IsCoherent $ EvExpr ev_expr } + ; setWantedEvTerm dst True $ EvExpr ev_expr } _ -> return () -- | Create an evidence expression for an arbitrary constraint using ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Hs.Type( HsIPName(..) ) import GHC.Core import GHC.Core.Type -import GHC.Core.InstEnv ( DFunInstType, Coherence(..) ) +import GHC.Core.InstEnv ( DFunInstType ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) @@ -184,7 +184,7 @@ solveCallStack ev ev_cs -- `IP ip CallStack`. See Note [Overview of implicit CallStacks] = do { cs_tm <- evCallStack ev_cs ; let ev_tm = mkEvCast cs_tm (wrapIP (ctEvPred ev)) - ; setEvBindIfWanted ev IsCoherent ev_tm } + ; setEvBindIfWanted ev True ev_tm } {- Note [Shadowing of implicit parameters] @@ -394,7 +394,7 @@ solveEqualityDict ev cls tys ; (co, _, _) <- wrapUnifierTcS ev role $ \uenv -> uType uenv t1 t2 -- Set d :: (t1~t2) = Eq# co - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ evDataConApp data_con tys [Coercion co] ; stopWith ev "Solved wanted lifted equality" } @@ -715,10 +715,10 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys -- the inert from the work-item or vice-versa. ; case solveOneFromTheOther (CDictCan dict_i) (CDictCan dict_w) of KeepInert -> do { traceTcS "lookupInertDict:KeepInert" (ppr dict_w) - ; setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + ; setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; return $ Stop ev_w (text "Dict equal" <+> ppr dict_w) } KeepWork -> do { traceTcS "lookupInertDict:KeepWork" (ppr dict_w) - ; setEvBindIfWanted ev_i IsCoherent (ctEvTerm ev_w) + ; setEvBindIfWanted ev_i True (ctEvTerm ev_w) ; updInertCans (updDicts $ delDict dict_w) ; continueWith () } } } @@ -784,7 +784,7 @@ shortCutSolver dflags ev_w ev_i ; case inst_res of OneInst { cir_new_theta = preds , cir_mk_ev = mk_ev - , cir_coherence = coherence + , cir_canonical = canonical , cir_what = what } | safeOverlap what , all isTyFamFree preds -- Note [Shortcut solving: type families] @@ -804,7 +804,7 @@ shortCutSolver dflags ev_w ev_i ; let ev_tm = mk_ev (map getEvExpr evc_vs) ev_binds' = extendEvBinds ev_binds $ - mkWantedEvBind (ctEvEvId ev) coherence ev_tm + mkWantedEvBind (ctEvEvId ev) canonical ev_tm ; foldlM try_solve_from_instance (ev_binds', solved_dicts') $ freshGoals evc_vs } @@ -847,7 +847,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev, di_cls = cls -- See Note [No Given/Given fundeps] | Just solved_ev <- lookupSolvedDict inerts dict_loc cls xis -- Cached - = do { setEvBindIfWanted ev IsCoherent (ctEvTerm solved_ev) + = do { setEvBindIfWanted ev True (ctEvTerm solved_ev) ; stopWith ev "Dict/Top (cached)" } | otherwise -- Wanted, but not cached @@ -869,14 +869,14 @@ chooseInstance work_item (OneInst { cir_new_theta = theta , cir_what = what , cir_mk_ev = mk_ev - , cir_coherence = coherence }) + , cir_canonical = canonical }) = do { traceTcS "doTopReact/found instance for" $ ppr work_item ; deeper_loc <- checkInstanceOK loc what pred ; checkReductionDepth deeper_loc pred ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar) (ppr work_item) ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta - ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars)) + ; setEvBindIfWanted work_item canonical (mk_ev (map getEvExpr evc_vars)) ; emitWorkNC (freshGoals evc_vars) ; stopWith work_item "Dict/Top (solved wanted)" } where @@ -1070,7 +1070,7 @@ matchLocalInst pred loc -> do { let result = OneInst { cir_new_theta = theta , cir_mk_ev = evDFunApp dfun_id tys - , cir_coherence = IsCoherent + , cir_canonical = True , cir_what = LocalInstance } ; traceTcS "Best local instance found:" $ vcat [ text "pred:" <+> ppr pred @@ -1317,7 +1317,7 @@ last_resort inerts (DictCt { di_ev = ev_w, di_cls = cls, di_tys = xis }) , Just ct_i <- lookupInertDict inerts loc_w cls xis , let ev_i = dictCtEvidence ct_i , isGiven ev_i - = do { setEvBindIfWanted ev_w IsCoherent (ctEvTerm ev_i) + = do { setEvBindIfWanted ev_w True (ctEvTerm ev_i) ; ctLocWarnTcS loc_w $ TcRnLoopySuperclassSolve loc_w (ctEvPred ev_w) ; return $ Stop ev_w (text "Loopy superclass") } @@ -2158,4 +2158,3 @@ constraints. See also Note [Evidence for quantified constraints] in GHC.Core.Predicate. -} - ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -32,7 +32,6 @@ import GHC.Core.Coercion import GHC.Core.Coercion.Axiom import GHC.Core.Reduction import GHC.Core.Unify( tcUnifyTyWithTFs ) -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.FamInstEnv ( FamInstEnvs, FamInst(..), apartnessCheck , lookupFamInstEnvByTyCon ) import GHC.Core @@ -357,7 +356,7 @@ can_eq_nc rewritten rdr_env envs ev eq_rel ty1 ps_ty1 (CastTy ty2 co2) _ -- Literals can_eq_nc _rewritten _rdr_env _envs ev eq_rel ty1@(LitTy l1) _ (LitTy l2) _ | l1 == l2 - = do { setEvBindIfWanted ev IsCoherent (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) + = do { setEvBindIfWanted ev True (evCoercion $ mkReflCo (eqRelRole eq_rel) ty1) ; stopWith ev "Equal LitTy" } -- Decompose FunTy: (s -> t) and (c => t) @@ -1847,7 +1846,7 @@ canEqCanLHSFinish_try_unification ev eq_rel swapped lhs rhs -- Provide Refl evidence for the constraint -- Ignore 'swapped' because it's Refl! - ; setEvBindIfWanted new_ev IsCoherent $ + ; setEvBindIfWanted new_ev True $ evCoercion (mkNomReflCo final_rhs) -- Kick out any constraints that can now be rewritten @@ -1958,7 +1957,7 @@ canEqReflexive :: CtEvidence -- ty ~ ty -> TcType -- ty -> TcS (StopOrContinue a) -- always Stop canEqReflexive ev eq_rel ty - = do { setEvBindIfWanted ev IsCoherent $ + = do { setEvBindIfWanted ev True $ evCoercion (mkReflCo (eqRelRole eq_rel) ty) ; stopWith ev "Solved by reflexivity" } @@ -2541,7 +2540,7 @@ tryInertEqs work_item@(EqCt { eq_ev = ev, eq_eq_rel = eq_rel }) = Stage $ do { inerts <- getInertCans ; if | Just (ev_i, swapped) <- inertsCanDischarge inerts work_item - -> do { setEvBindIfWanted ev IsCoherent $ + -> do { setEvBindIfWanted ev True $ evCoercion (maybeSymCo swapped $ downgradeRole (eqRelRole eq_rel) (ctEvRole ev_i) @@ -3188,4 +3187,4 @@ To avoid this situation we do not cache as solved any workitems (or inert) which did not really made a 'step' towards proving some goal. Solved's are just an optimization so we don't lose anything in terms of completeness of solving. --} \ No newline at end of file +-} ===================================== compiler/GHC/Tc/Solver/Irred.hs ===================================== @@ -15,7 +15,6 @@ import GHC.Tc.Solver.Monad import GHC.Tc.Types.Evidence import GHC.Core.Coercion -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Types.Basic( SwapFlag(..) ) @@ -74,9 +73,9 @@ try_inert_irreds inerts irred_w@(IrredCt { ir_ev = ev_w, ir_reason = reason }) vcat [ text "wanted:" <+> (ppr ct_w $$ ppr (ctOrigin ct_w)) , text "inert: " <+> (ppr ct_i $$ ppr (ctOrigin ct_i)) ] ; case solveOneFromTheOther ct_i ct_w of - KeepInert -> do { setEvBindIfWanted ev_w IsCoherent (swap_me swap ev_i) + KeepInert -> do { setEvBindIfWanted ev_w True (swap_me swap ev_i) ; return (Stop ev_w (text "Irred equal:KeepInert" <+> ppr ct_w)) } - KeepWork -> do { setEvBindIfWanted ev_i IsCoherent (swap_me swap ev_w) + KeepWork -> do { setEvBindIfWanted ev_i True (swap_me swap ev_w) ; updInertCans (updIrreds (\_ -> others)) ; continueWith () } } ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -1688,19 +1688,19 @@ setWantedEq (HoleDest hole) co setWantedEq (EvVarDest ev) _ = pprPanic "setWantedEq: EvVarDest" (ppr ev) -- | Good for both equalities and non-equalities -setWantedEvTerm :: TcEvDest -> Coherence -> EvTerm -> TcS () -setWantedEvTerm (HoleDest hole) _coherence tm +setWantedEvTerm :: TcEvDest -> Canonical -> EvTerm -> TcS () +setWantedEvTerm (HoleDest hole) _canonical tm | Just co <- evTermCoercion_maybe tm = do { useVars (coVarsOfCo co) ; fillCoercionHole hole co } | otherwise = -- See Note [Yukky eq_sel for a HoleDest] do { let co_var = coHoleCoVar hole - ; setEvBind (mkWantedEvBind co_var IsCoherent tm) + ; setEvBind (mkWantedEvBind co_var True tm) ; fillCoercionHole hole (mkCoVarCo co_var) } -setWantedEvTerm (EvVarDest ev_id) coherence tm - = setEvBind (mkWantedEvBind ev_id coherence tm) +setWantedEvTerm (EvVarDest ev_id) canonical tm + = setEvBind (mkWantedEvBind ev_id canonical tm) {- Note [Yukky eq_sel for a HoleDest] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1726,10 +1726,10 @@ fillCoercionHole hole co = do { wrapTcS $ TcM.fillCoercionHole hole co ; kickOutAfterFillingCoercionHole hole } -setEvBindIfWanted :: CtEvidence -> Coherence -> EvTerm -> TcS () -setEvBindIfWanted ev coherence tm +setEvBindIfWanted :: CtEvidence -> Canonical -> EvTerm -> TcS () +setEvBindIfWanted ev canonical tm = case ev of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest coherence tm + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest canonical tm _ -> return () newTcEvBinds :: TcS EvBindsVar ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -20,7 +20,6 @@ import GHC.Tc.Types.Constraint import GHC.Tc.Solver.InertSet import GHC.Tc.Solver.Monad -import GHC.Core.InstEnv ( Coherence(..) ) import GHC.Core.Predicate import GHC.Core.Reduction import GHC.Core.Coercion @@ -427,7 +426,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars , et_binds = ev_binds, et_body = w_id } @@ -556,7 +555,7 @@ finish_rewrite ev@(CtWanted { ctev_dest = dest (Reduction co new_pred) new_rewriters = do { mb_new_ev <- newWanted loc rewriters' new_pred ; massert (coercionRole co == ctEvRole ev) - ; setWantedEvTerm dest IsCoherent $ + ; setWantedEvTerm dest True $ mkEvCast (getEvExpr mb_new_ev) (downgradeRole Representational (ctEvRole ev) (mkSymCo co)) ; case mb_new_ev of @@ -631,7 +630,7 @@ runTcPluginsWanted wc@(WC { wc_simple = simples1 }) where setEv :: (EvTerm,Ct) -> TcS () setEv (ev,ct) = case ctEvidence ct of - CtWanted { ctev_dest = dest } -> setWantedEvTerm dest IsCoherent ev -- TODO: plugins should be able to signal non-coherence + CtWanted { ctev_dest = dest } -> setWantedEvTerm dest True ev -- TODO: plugins should be able to signal non-canonicity _ -> panic "runTcPluginsWanted.setEv: attempt to solve non-wanted!" -- | A pair of (given, wanted) constraints to pass to plugins ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1482,7 +1482,7 @@ tcSuperClasses skol_info dfun_id cls tyvars dfun_evs dfun_ev_binds sc_theta ; sc_top_name <- newName (mkSuperDictAuxOcc n (getOccName cls)) ; sc_ev_id <- newEvVar sc_pred - ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id IsCoherent sc_ev_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id True sc_ev_tm ; let sc_top_ty = tcMkDFunSigmaTy tyvars (map idType dfun_evs) sc_pred sc_top_id = mkLocalId sc_top_name ManyTy sc_top_ty export = ABE { abe_wrap = idHsWrapper ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -70,7 +70,7 @@ import GHC.Types.Basic import GHC.Core import GHC.Core.Class (Class, classSCSelId ) import GHC.Core.FVs ( exprSomeFreeVars ) -import GHC.Core.InstEnv ( Coherence(..) ) +import GHC.Core.InstEnv ( Canonical ) import GHC.Utils.Misc import GHC.Utils.Panic @@ -451,7 +451,7 @@ instance Outputable EvBindMap where data EvBindInfo = EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver } - | EvBindWanted { ebi_coherence :: Coherence -- See Note [Desugaring incoherent evidence] + | EvBindWanted { ebi_canonical :: Canonical -- See Note [Desugaring non-canonical evidence] } ----------------- @@ -465,7 +465,7 @@ data EvBind evBindVar :: EvBind -> EvVar evBindVar = eb_lhs -mkWantedEvBind :: EvVar -> Coherence -> EvTerm -> EvBind +mkWantedEvBind :: EvVar -> Canonical -> EvTerm -> EvBind mkWantedEvBind ev c tm = EvBind { eb_info = EvBindWanted c, eb_lhs = ev, eb_rhs = tm } -- EvTypeable are never given, so we can work with EvExpr here instead of EvTerm ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts, RecursiveDo #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -821,16 +822,31 @@ getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag -- set the OverlapMode to 'm' getOverlapFlag overlap_mode = do { dflags <- getDynFlags - ; let overlap_ok = xopt LangExt.OverlappingInstances dflags - incoherent_ok = xopt LangExt.IncoherentInstances dflags + ; let overlap_ok = xopt LangExt.OverlappingInstances dflags + incoherent_ok = xopt LangExt.IncoherentInstances dflags + noncanonical_incoherence = not $ gopt Opt_SpecialiseIncoherents dflags + use x = OverlapFlag { isSafeOverlap = safeLanguageOn dflags , overlapMode = x } default_oflag | incoherent_ok = use (Incoherent NoSourceText) | overlap_ok = use (Overlaps NoSourceText) | otherwise = use (NoOverlap NoSourceText) - final_oflag = setOverlapModeMaybe default_oflag overlap_mode + oflag = setOverlapModeMaybe default_oflag overlap_mode + final_oflag = effective_oflag noncanonical_incoherence oflag ; return final_oflag } + where + effective_oflag noncanonical_incoherence oflag at OverlapFlag{ overlapMode = overlap_mode } + = oflag { overlapMode = effective_overlap_mode noncanonical_incoherence overlap_mode } + + -- The `-fspecialise-incoherents` flag controls the meaning of the + -- `Incoherent` overlap mode: as either an Incoherent overlap + -- flag, or a NonCanonical overlap flag. See Note [Coherence and specialisation: overview] + -- in GHC.Core.InstEnv for why we care about this distinction. + effective_overlap_mode noncanonical_incoherence = \case + Incoherent s | noncanonical_incoherence -> NonCanonical s + overlap_mode -> overlap_mode + tcGetInsts :: TcM [ClsInst] -- Gets the local class instances. ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Types.Basic ( TopLevelFlag(..), isTopLevel, isNotTopLevel, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, - hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, + hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag, hasNonCanonicalFlag, Boxity(..), isBoxed, @@ -628,6 +628,7 @@ hasIncoherentFlag :: OverlapMode -> Bool hasIncoherentFlag mode = case mode of Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappableFlag :: OverlapMode -> Bool @@ -636,6 +637,7 @@ hasOverlappableFlag mode = Overlappable _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False hasOverlappingFlag :: OverlapMode -> Bool @@ -644,8 +646,14 @@ hasOverlappingFlag mode = Overlapping _ -> True Overlaps _ -> True Incoherent _ -> True + NonCanonical _ -> True _ -> False +hasNonCanonicalFlag :: OverlapMode -> Bool +hasNonCanonicalFlag = \case + NonCanonical{} -> True + _ -> False + data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv = NoOverlap SourceText -- See Note [Pragma source text] @@ -700,6 +708,16 @@ data OverlapMode -- See Note [Rules for instance lookup] in GHC.Core.InstEnv -- instantiating 'b' would change which instance -- was chosen. See also Note [Incoherent instances] in "GHC.Core.InstEnv" + | NonCanonical SourceText + -- ^ Behave like Incoherent, but the instance choice is observable + -- by the program behaviour. See Note [Coherence and specialisation: overview]. + -- + -- We don't have surface syntax for the distinction between + -- Incoherent and NonCanonical instances; instead, the flag + -- `-f{no-}specialise-incoherents` (on by default) controls + -- whether `INCOHERENT` instances are regarded as Incoherent or + -- NonCanonical. + deriving (Eq, Data) @@ -712,6 +730,7 @@ instance Outputable OverlapMode where ppr (Overlapping _) = text "[overlapping]" ppr (Overlaps _) = text "[overlap ok]" ppr (Incoherent _) = text "[incoherent]" + ppr (NonCanonical _) = text "[noncanonical]" instance Binary OverlapMode where put_ bh (NoOverlap s) = putByte bh 0 >> put_ bh s @@ -719,6 +738,7 @@ instance Binary OverlapMode where put_ bh (Incoherent s) = putByte bh 2 >> put_ bh s put_ bh (Overlapping s) = putByte bh 3 >> put_ bh s put_ bh (Overlappable s) = putByte bh 4 >> put_ bh s + put_ bh (NonCanonical s) = putByte bh 5 >> put_ bh s get bh = do h <- getByte bh case h of @@ -727,6 +747,7 @@ instance Binary OverlapMode where 2 -> (get bh) >>= \s -> return $ Incoherent s 3 -> (get bh) >>= \s -> return $ Overlapping s 4 -> (get bh) >>= \s -> return $ Overlappable s + 5 -> (get bh) >>= \s -> return $ NonCanonical s _ -> panic ("get OverlapMode" ++ show h) ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1144,6 +1144,25 @@ as such you shouldn't need to set any of them explicitly. A flag which returns a constrained type. For example, a type class where one of the methods implements a traversal. + +.. ghc-flag:: -fspecialise-incoherents + :shortdesc: Enable specialisation on incoherent instances + :type: dynamic + :reverse: -fno-specialise-incoherents + :category: + + :default: on + + Enable specialisation of overloaded functions in cases when the + selected instance is incoherent. This makes the choice of instance + non-deterministic, so it is only safe to do if there is no + observable runtime behaviour difference between potentially + unifying instances. Turning this flag off ensures the incoherent + instance selection adheres to the algorithm described in + :extension:`IncoherentInstances` at the cost of optimisation + opportunities arising from specialisation. + + .. ghc-flag:: -finline-generics :shortdesc: Annotate methods of derived Generic and Generic1 instances with INLINE[1] pragmas based on heuristics. Implied by :ghc-flag:`-O`. ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-specialise-incoherents #-} class C a where op :: a -> String ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -2081,6 +2081,11 @@ instance ExactPrint (LocatedP OverlapMode) where an1 <- markAnnCloseP an0 return (L (SrcSpanAnn an1 l) (Incoherent src)) + exact (L (SrcSpanAnn an l) (NonCanonical src)) = do + an0 <- markAnnOpenP an src "{-# INCOHERENT" + an1 <- markAnnCloseP an0 + return (L (SrcSpanAnn an1 l) (Incoherent src)) + -- --------------------------------------------------------------------- instance ExactPrint (HsBind GhcPs) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/318056557988b7ac0ddbacbfbf47870aa37550ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/318056557988b7ac0ddbacbfbf47870aa37550ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 04:38:28 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 19 Jul 2023 00:38:28 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] 25 commits: base: fix haddock syntax in GHC.Profiling Message-ID: <64b768c44af46_3a4b0fb74942926a1@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 829a9abe by Gergő Érdi at 2023-07-19T03:10:10+01:00 Desugar bindings in the context of their evidence Closes #23172 - - - - - f9173fc4 by Gergő Érdi at 2023-07-19T03:10:10+01:00 Add flag to `-f{no-}specialise-incoherents` to enable/disable specialisation of incoherent instances Fixes #23287 - - - - - 21 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/318056557988b7ac0ddbacbfbf47870aa37550ae...f9173fc4b74fba959b866304f4b03be927ced78b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/318056557988b7ac0ddbacbfbf47870aa37550ae...f9173fc4b74fba959b866304f4b03be927ced78b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 07:33:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 19 Jul 2023 03:33:43 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Reg.Liveness: Strictness Message-ID: <64b791d7effe3_3a4b0fb7408308162@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 4 changed files: - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -1001,7 +1001,7 @@ livenessBack livenessBack _ liveregs _ done [] = (liveregs, done) livenessBack platform liveregs blockmap acc (instr : instrs) - = let (liveregs', instr') = liveness1 platform liveregs blockmap instr + = let !(!liveregs', instr') = liveness1 platform liveregs blockmap instr in livenessBack platform liveregs' blockmap (instr' : acc) instrs @@ -1024,15 +1024,15 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) = (liveregs1, LiveInstr instr (Just $ Liveness { liveBorn = emptyUniqSet - , liveDieRead = mkUniqSet r_dying - , liveDieWrite = mkUniqSet w_dying })) + , liveDieRead = r_dying + , liveDieWrite = w_dying })) | otherwise = (liveregs_br, LiveInstr instr (Just $ Liveness { liveBorn = emptyUniqSet , liveDieRead = mkUniqSet r_dying_br - , liveDieWrite = mkUniqSet w_dying })) + , liveDieWrite = w_dying })) where !(RU read written) = regUsageOfInstr platform instr @@ -1044,10 +1044,12 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) -- registers that are not live beyond this point, are recorded -- as dying here. - r_dying = [ reg | reg <- read, reg `notElem` written, + r_dying = mkUniqSet + [ reg | reg <- read, reg `notElem` written, not (elementOfUniqSet reg liveregs) ] - w_dying = [ reg | reg <- written, + w_dying = mkUniqSet + [ reg | reg <- written, not (elementOfUniqSet reg liveregs) ] -- union in the live regs from all the jump destinations of this @@ -1067,6 +1069,6 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) -- registers that are live only in the branch targets should -- be listed as dying here. live_branch_only = live_from_branch `minusUniqSet` liveregs - r_dying_br = nonDetEltsUniqSet (mkUniqSet r_dying `unionUniqSets` + r_dying_br = nonDetEltsUniqSet (r_dying `unionUniqSets` live_branch_only) -- See Note [Unique Determinism and code generation] ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -212,13 +212,16 @@ addToUDFM_C f m k v = addToUDFM_C_Directly f m (getUnique k) v addListToUDFM :: Uniquable key => UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) +{-# INLINEABLE addListToUDFM #-} addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) +{-# INLINEABLE addListToUDFM_Directly #-} addListToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) +{-# INLINEABLE addListToUDFM_Directly_C #-} delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -139,9 +139,11 @@ zipToUFM ks vs = assert (length ks == length vs ) innerZip emptyUFM ks vs listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM +{-# INLINEABLE listToUFM #-} listToUFM_Directly :: [(Unique, elt)] -> UniqFM key elt listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM +{-# INLINEABLE listToUFM_Directly #-} listToIdentityUFM :: Uniquable key => [key] -> UniqFM key key listToIdentityUFM = foldl' (\m x -> addToUFM m x x) emptyUFM @@ -152,6 +154,7 @@ listToUFM_C -> [(key, elt)] -> UniqFM key elt listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM +{-# INLINEABLE listToUFM_C #-} addToUFM :: Uniquable key => UniqFM key elt -> key -> elt -> UniqFM key elt addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m) ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -74,12 +74,14 @@ unitUniqSet x = UniqSet $ unitUFM x x mkUniqSet :: Uniquable a => [a] -> UniqSet a mkUniqSet = foldl' addOneToUniqSet emptyUniqSet +{-# INLINEABLE mkUniqSet #-} addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x) addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a addListToUniqSet = foldl' addOneToUniqSet +{-# INLINEABLE addListToUniqSet #-} delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a) @@ -89,10 +91,12 @@ delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u) delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l) +{-# INLINEABLE delListFromUniqSet #-} delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a delListFromUniqSet_Directly (UniqSet s) l = UniqSet (delListFromUFM_Directly s l) +{-# INLINEABLE delListFromUniqSet_Directly #-} unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/257f1567395be441ebf7ada996e4edf36abbe7e9...b947250bda6ab996242faf18b82a42008c228eaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/257f1567395be441ebf7ada996e4edf36abbe7e9...b947250bda6ab996242faf18b82a42008c228eaf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 07:34:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 19 Jul 2023 03:34:28 -0400 Subject: [Git][ghc/ghc][master] 4 commits: x86 Codegen: Implement MO_S_MulMayOflo for W16 Message-ID: <64b79204e1995_3a4b0fb74583118d5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 5 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -56,6 +56,25 @@ Note that there are variety of places in the native code generator where we assume that the code produced for a MachOp does not introduce new blocks. -} +-- Note [MO_S_MulMayOflo significant width] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- There are two interpretations in the code about what a multiplication +-- overflow exactly means: +-- +-- 1. The result does not fit into the specified width (of type Width.) +-- 2. The result does not fit into a register. +-- +-- (2) has some flaws: A following MO_Mul has a width, too. So MO_S_MulMayOflo +-- may signal no overflow, while MO_Mul truncates the result. There are +-- architectures with several register widths and it might be hard to decide +-- what's an overflow and what not. Both attributes can easily lead to subtle +-- bugs. +-- +-- (1) has the benefit that its interpretation is completely independent of the +-- architecture. So, the mid-term plan is to migrate to this +-- interpretation/sematics. + data MachOp -- Integer operations (insensitive to signed/unsigned) = MO_Add Width @@ -65,7 +84,8 @@ data MachOp | MO_Mul Width -- low word of multiply -- Signed multiply/divide - | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows + | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows. See + -- Note [MO_S_MulMayOflo significant width] | MO_S_Quot Width -- signed / (same semantics as IntQuotOp) | MO_S_Rem Width -- signed % (same semantics as IntRemOp) | MO_S_Neg Width -- unary - ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -966,16 +966,38 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps return (Fixed format eax code) - imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + imulMayOflo W8 a b = do + -- The general case (W16, W32, W64) doesn't work for W8 as its + -- multiplication doesn't use two registers. + -- + -- The plan is: + -- 1. truncate and sign-extend a and b to 8bit width + -- 2. multiply a' = a * b in 32bit width + -- 3. copy and sign-extend 8bit from a' to c + -- 4. compare a' and c: they are equal if there was no overflow + (a_reg, a_code) <- getNonClobberedReg a + (b_reg, b_code) <- getNonClobberedReg b + let + code = a_code `appOL` b_code `appOL` + toOL [ + MOVSxL II8 (OpReg a_reg) (OpReg a_reg), + MOVSxL II8 (OpReg b_reg) (OpReg b_reg), + IMUL II32 (OpReg b_reg) (OpReg a_reg), + MOVSxL II8 (OpReg a_reg) (OpReg eax), + CMP II16 (OpReg a_reg) (OpReg eax), + SETCC NE (OpReg eax) + ] + return (Fixed II8 eax code) imulMayOflo rep a b = do (a_reg, a_code) <- getNonClobberedReg a b_code <- getAnyReg b let shift_amt = case rep of + W16 -> 15 W32 -> 31 W64 -> 63 - _ -> panic "shift_amt" + w -> panic ("shift_amt: " ++ show w) format = intFormat rep code = a_code `appOL` b_code eax `appOL` ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +{- + N.B. the contract of '%mulmayoflo' is a bit weak: "Return non-zero if there is + any possibility that the signed multiply of a and b might overflow. Return zero + only if you are absolutely sure that it won't overflow. If in doubt, return + non-zero." (Stg.h) + +This test verifies the a stronger contract: It's expected that there are no +false positives. This requirement is e.g. met by code generation backends which +execute the multiplication to check for overflow. +-} + +module Main where + +import GHC.Exts + +-- The argument and return types are unimportant: They're only used to force +-- evaluation, but carry no information. +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm ===================================== @@ -0,0 +1,98 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -226,3 +226,14 @@ test('T22296',[only_ways(llvm_ways) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) + +# TODO: Enable more architectures here. N.B. some code generation backends are +# not implemeted correctly (according to +# Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. +test('MulMayOflo_full', + [ extra_files(['MulMayOflo.hs']), + when(unregisterised(), skip), + unless(arch('x86_64') or arch('i386'), skip), + ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b947250bda6ab996242faf18b82a42008c228eaf...a36f9dc94823c75fb789710bc67b92e87a630440 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b947250bda6ab996242faf18b82a42008c228eaf...a36f9dc94823c75fb789710bc67b92e87a630440 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 07:34:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 19 Jul 2023 03:34:59 -0400 Subject: [Git][ghc/ghc][master] lint-ci-config: Generate jobs-metadata.json Message-ID: <64b7922379a82_3a4b0fb746c3166ee@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -278,6 +278,13 @@ lint-ci-config: - nix run .gitlab/generate-ci#generate-jobs # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code + # And run this to generate the .gitlab/jobs-metadata.json + - nix run .gitlab/generate-ci#generate-job-metadata + artifacts: + when: always + paths: + - .gitlab/jobs-metadata.json + - .gitlab/jobs.yaml dependencies: [] lint-submods: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38a362485c78cc0fd2618ad2560eadf0b7d08a04 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38a362485c78cc0fd2618ad2560eadf0b7d08a04 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 07:35:35 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 19 Jul 2023 03:35:35 -0400 Subject: [Git][ghc/ghc][master] Initialize 9.10.1-notes.rst Message-ID: <64b79247419fa_3a4b0fb741c3207ae@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 2 changed files: - + docs/users_guide/9.10.1-notes.rst - docs/users_guide/release-notes.rst Changes: ===================================== docs/users_guide/9.10.1-notes.rst ===================================== @@ -0,0 +1,75 @@ +.. _release-9-10-1: + +Version 9.10.1 +============== + +Language +~~~~~~~~ + +Compiler +~~~~~~~~ + +GHCi +~~~~ + +Runtime system +~~~~~~~~~~~~~~ + +``base`` library +~~~~~~~~~~~~~~~~ + +``ghc-prim`` library +~~~~~~~~~~~~~~~~~~~~ + +``ghc`` library +~~~~~~~~~~~~~~~ + +``ghc-heap`` library +~~~~~~~~~~~~~~~~~~~~ + +``template-haskell`` library +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Included libraries +~~~~~~~~~~~~~~~~~~ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/release-notes.rst ===================================== @@ -4,4 +4,4 @@ Release notes .. toctree:: :maxdepth: 1 - 9.8.1-notes + 9.10.1-notes View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1535a67146b11ca0f37ce9b610890d3c4e090deb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1535a67146b11ca0f37ce9b610890d3c4e090deb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 07:36:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 19 Jul 2023 03:36:26 -0400 Subject: [Git][ghc/ghc][master] Prioritise Parent when looking up class sub-binder Message-ID: <64b7927a5ce05_3a4b0fb755c3258de@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 5 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Name/Reader.hs - + testsuite/tests/rename/should_compile/T23664.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -845,8 +845,10 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = -- See [Mismatched class methods and associated type families] -- in TcInstDecls. where - what_lkup = LookupChild { wantedParent = the_parent - , lookupDataConFirst = False } + what_lkup = LookupChild { wantedParent = the_parent + , lookupDataConFirst = False + , prioritiseParent = True -- See T23664. + } {- Note [Family instance binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -690,8 +690,12 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items let bareName = (ieWrappedName . unLoc) n what_lkup :: LookupChild - what_lkup = LookupChild { wantedParent = spec_parent - , lookupDataConFirst = True } + what_lkup = + LookupChild + { wantedParent = spec_parent + , lookupDataConFirst = True + , prioritiseParent = False -- See T11970. + } -- Do not report export list declaration deprecations name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -1190,6 +1190,13 @@ data LookupChild , lookupDataConFirst :: Bool -- ^ for type constructors, should we look in the data constructor -- namespace first? + , prioritiseParent :: Bool + -- ^ should we prioritise getting the right 'Parent'? + -- + -- - @True@: prioritise getting the right 'Parent' + -- - @False@: prioritise getting the right 'NameSpace' + -- + -- See Note [childGREPriority]. } -- | After looking up something with the given 'NameSpace', is the resulting @@ -1225,14 +1232,52 @@ greIsRelevant which_gres ns gre where other_ns = greNameSpace gre +{- Note [childGREPriority] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are currently two places in the compiler where we look up GlobalRdrElts +which have a given Parent. These are the two calls to lookupSubBndrOcc_helper: + + A. Looking up children in an export item, e.g. + + module M ( T(MkT, D) ) where { data T = MkT; data D = D } + + B. Looking up binders in a class or instance declaration, e.g. + the operator +++ in the fixity declaration: + + class C a where { type (+++) :: a -> a ->; infixl 6 +++ } + (+++) :: Int -> Int -> Int; (+++) = (+) + +In these two situations, there are two competing metrics for finding the "best" +'GlobalRdrElt' that a particular 'OccName' resolves to: + + - does the resolved 'GlobalRdrElt' have the correct parent? + - does the resolved 'GlobalRdrElt' have the same 'NameSpace' as the 'OccName'? + +(A) and (B) have competing requirements. + +For the example of (A) above, we know that the child 'D' of 'T' must live +in the data namespace, so we look up the OccName 'OccName DataName "D"' and +prioritise the lookup results based on the 'NameSpace'. +This means we get an error message of the form: + + The type constructor 'T' is not the parent of the data constructor 'D'. + +as opposed to the rather unhelpful and confusing: + + The type constructor 'T' is not the parent of the type constructor 'D'. + +See test case T11970. + +For the example of (B) above, the fixity declaration for +++ lies inside the +class, so we should prioritise looking up 'GlobalRdrElt's whose parent is 'C'. +Not doing so led to #23664. +-} + -- | Scoring priority function for looking up children 'GlobalRdrElt'. -- --- First we score by 'NameSpace', with higher-priority 'NameSpace's having a --- lower number. Then we break ties by checking if the 'Parent' is correct. --- --- This complicated scoring function is determined by the behaviour required by --- 'lookupChildrenExport', which requires us to look in the data constructor --- 'NameSpace' first, for things in the type constructor 'NameSpace'. +-- We score by 'Parent' and 'NameSpace', with higher priorities having lower +-- numbers. Which lexicographic order we use ('Parent' or 'NameSpace' first) +-- is determined by the first argument; see Note [childGREPriority]. childGREPriority :: LookupChild -- ^ what kind of child do we want, -- e.g. what should its parent be? -> NameSpace -- ^ what 'NameSpace' are we originally looking in? @@ -1241,13 +1286,18 @@ childGREPriority :: LookupChild -- ^ what kind of child do we want, -- 'NameSpace', which is used to determine the score -- (in the first component) -> Maybe (Int, Int) -childGREPriority (LookupChild { wantedParent = wanted_parent, lookupDataConFirst = try_dc_first }) +childGREPriority (LookupChild { wantedParent = wanted_parent + , lookupDataConFirst = try_dc_first + , prioritiseParent = par_first }) ns gre = - case child_ns_prio $ greNameSpace gre of - Nothing -> Nothing - Just np -> Just (np, parent_prio $ greParent gre) - -- Prioritise GREs first on NameSpace, and then on Parent. - -- See T11970. + case child_ns_prio $ greNameSpace gre of + Nothing -> Nothing + Just ns_prio -> + let par_prio = parent_prio $ greParent gre + in Just $ if par_first + then (par_prio, ns_prio) + else (ns_prio, par_prio) + -- See Note [childGREPriority]. where -- Pick out the possible 'NameSpace's in order of priority. @@ -1302,11 +1352,9 @@ lookupGRE env = \case lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ | otherwise = fromMaybe [] $ lookupOccEnv env occ LookupChildren occ which_child -> - highestPriorityGREs (childGREPriority which_child ns) $ - concat $ lookupOccEnv_AllNameSpaces env occ - where - ns :: NameSpace - ns = occNameSpace occ + let ns = occNameSpace occ + all_gres = concat $ lookupOccEnv_AllNameSpaces env occ + in highestPriorityGREs (childGREPriority which_child ns) all_gres -- | Collect the 'GlobalRdrElt's with the highest priority according -- to the given function (lower value <=> higher priority). ===================================== testsuite/tests/rename/should_compile/T23664.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies, TypeOperators #-} + +module T23664 where + +class POrd a where + type a >= b + infix 4 >= ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -214,6 +214,7 @@ test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) test('T23512b', normal, compile, ['']) +test('T23664', normal, compile, ['']) test('ExportWarnings1', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings1', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings2', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs', 'ExportWarnings_aux2.hs']), multimod_compile, ['ExportWarnings2', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings3', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings3', '-v0 -Wno-duplicate-exports -Wx-custom']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bd4d5b5482fd44914f22492877b3f3ca27299e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bd4d5b5482fd44914f22492877b3f3ca27299e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 07:37:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 19 Jul 2023 03:37:00 -0400 Subject: [Git][ghc/ghc][master] EPA: Improve annotation management in getMonoBind Message-ID: <64b7929c552a7_3a4b0fb746c329586@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 4 changed files: - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/printer/Test19784.hs Changes: ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -82,7 +82,8 @@ module GHC.Parser.Annotation ( -- ** Working with comments in annotations noComments, comment, addCommentsToSrcAnn, setCommentsSrcAnn, addCommentsToEpAnn, setCommentsEpAnn, - transferAnnsA, commentsOnlyA, removeCommentsA, + transferAnnsA, transferAnnsOnlyA, transferCommentsOnlyA, commentsOnlyA, + removeCommentsA, placeholderRealSpan, ) where @@ -1154,6 +1155,26 @@ transferAnnsA (SrcSpanAnn (EpAnn a an cs) l) to (SrcSpanAnn (EpAnn a an' cs') loc) -> SrcSpanAnn (EpAnn a (an' <> an) (cs' <> cs)) loc +-- | Transfer trailing items from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferAnnsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferAnnsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2 + = (SrcSpanAnn EpAnnNotUsed l, ss2) +transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l') + = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn (spanAsAnchor l') an emptyComments) l') +transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l') + = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn a' (an' <> an) cs') l') + +-- | Transfer comments from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferCommentsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferCommentsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2 + = (SrcSpanAnn EpAnnNotUsed l, ss2) +transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l') + = (SrcSpanAnn (EpAnn a an emptyComments ) l, SrcSpanAnn (EpAnn (spanAsAnchor l') mempty cs) l') +transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l') + = (SrcSpanAnn (EpAnn a an emptyComments) l, SrcSpanAnn (EpAnn a' an' (cs <> cs')) l') + -- | Remove the exact print annotations payload, leaving only the -- anchor and comments. commentsOnlyA :: Monoid ann => SrcAnn ann -> SrcAnn ann ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -587,11 +587,14 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) MG { mg_alts = (L _ m1@[L _ mtchs1]) } })) binds | has_args m1 - = go [L (removeCommentsA loc1) mtchs1] (commentsOnlyA loc1) binds [] + = go [L loc1 mtchs1] (noAnnSrcSpan $ locA loc1) binds [] where - go :: [LMatch GhcPs (LHsExpr GhcPs)] -> SrcSpanAnnA - -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] - -> (LHsBind GhcPs,[LHsDecl GhcPs]) -- AZ + -- See Note [Exact Print Annotations for FunBind] + go :: [LMatch GhcPs (LHsExpr GhcPs)] -- accumulates matches for current fun + -> SrcSpanAnnA -- current top level loc + -> [LHsDecl GhcPs] -- Any docbinds seen + -> [LHsDecl GhcPs] -- rest of decls to be processed + -> (LHsBind GhcPs, [LHsDecl GhcPs]) -- FunBind, rest of decls go mtchs loc ((L loc2 (ValD _ (FunBind { fun_id = (L _ f2) , fun_matches = @@ -605,13 +608,61 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) = let doc_decls' = doc_decl : doc_decls in go mtchs (combineSrcSpansA loc loc2) binds doc_decls' go mtchs loc binds doc_decls - = ( L loc (makeFunBind fun_id1 (mkLocatedList $ reverse mtchs)) - , (reverse doc_decls) ++ binds) + = let + L llm last_m = head mtchs -- Guaranteed at least one + (llm',loc') = transferAnnsOnlyA llm loc -- Keep comments, transfer trailing + + matches' = reverse (L llm' last_m:tail mtchs) + L lfm first_m = head matches' + (lfm', loc'') = transferCommentsOnlyA lfm loc' + in + ( L loc'' (makeFunBind fun_id1 (mkLocatedList $ (L lfm' first_m:tail matches'))) + , (reverse doc_decls) ++ binds) -- Reverse the final matches, to get it back in the right order -- Do the same thing with the trailing doc comments getMonoBind bind binds = (bind, binds) +{- Note [Exact Print Annotations for FunBind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +An individual Match that ends up in a FunBind MatchGroup is initially +parsed as a LHsDecl. This takes the form + + L loc (ValD NoExtField (FunBind ... [L lm (Match ..)])) + +The loc contains the annotations, in particular comments, which are to +precede the declaration when printed, and [TrailingAnn] which are to +follow it. The [TrailingAnn] captures semicolons that may appear after +it when using the braces and semis style of coding. + +The match location (lm) has only a location in it at this point, no +annotations. Its location is the same as the top level location in +loc. + +What getMonoBind does it to take a sequence of FunBind LHsDecls that +belong to the same function and group them into a single function with +the component declarations all combined into the single MatchGroup as +[LMatch GhcPs]. + +Given that when exact printing a FunBind the exact printer simply +iterates over all the matches and prints each in turn, the simplest +behaviour would be to simply take the top level annotations (loc) for +each declaration, and use them for the individual component matches +(lm). + +The problem is the exact printer first has to deal with the top level +LHsDecl, which means annotations for the loc. This needs to be able to +be exact printed in the context of surrounding declarations, and if +some refactor decides to move the declaration elsewhere, the leading +comments and trailing semicolons need to be handled at that level. + +So the solution is to combine all the matches into one, pushing the +annotations into the LMatch's, and then at the end extract the +comments from the first match and [TrailingAnn] from the last to go in +the top level LHsDecl. +-} + -- Group together adjacent FunBinds for every function. getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs] getMonoBindAll [] = [] ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -1349,7 +1349,12 @@ { DumpSemis.hs:32:1-7 } (UnchangedAnchor)) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:33:1 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:6 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:7 }))]) (EpaComments [])) { DumpSemis.hs:32:1-7 }) (ValD @@ -1370,12 +1375,7 @@ { DumpSemis.hs:32:1-7 } (UnchangedAnchor)) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:33:1 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:6 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:7 }))]) + []) (EpaComments [])) { DumpSemis.hs:32:1-7 }) (Match @@ -1707,7 +1707,8 @@ { DumpSemis.hs:(36,1)-(44,4) } (UnchangedAnchor)) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:45:1 }))]) (EpaComments [])) { DumpSemis.hs:(36,1)-(44,4) }) (ValD @@ -1728,8 +1729,7 @@ { DumpSemis.hs:(36,1)-(44,4) } (UnchangedAnchor)) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:45:1 }))]) + []) (EpaComments [])) { DumpSemis.hs:(36,1)-(44,4) }) (Match @@ -2100,5 +2100,3 @@ (NoExtField)))))]))))))] (EmptyLocalBinds (NoExtField)))))])))))])) - - ===================================== testsuite/tests/printer/Test19784.hs ===================================== @@ -2,4 +2,9 @@ module Test19784 where { a 0 = 1; a _ = 2; + +-- c0 +b 0 = 1; -- c1 +b 1 = 2; -- c2 +b 2 = 3; -- c3 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c8fdda3458a72be9ea90d45ab379444ab0cfb30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c8fdda3458a72be9ea90d45ab379444ab0cfb30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 09:50:01 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 05:50:01 -0400 Subject: [Git][ghc/ghc][wip/test-primops] more jobs Message-ID: <64b7b1c9d452b_3a4b0fb7480351581@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: ec001db9 by Matthew Pickering at 2023-07-19T10:45:11+01:00 more jobs - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -825,19 +825,46 @@ release-hackage-lint: branch: "wip/ci" strategy: "depend" -test-primops-validate: +.test-primops-validate-template: needs: - # - job: x86_64-linux-deb10-validate+debug_info - # artifacts: false + - job: x86_64-linux-deb10-validate+debug_info + artifacts: false - job: aarch64-linux-deb10-validate artifacts: false - # - job: aarch64-darwin-validate - # artifacts: false - # - job: x64_64-darwin-validate - # artifacts: false + - job: aarch64-darwin-validate + artifacts: false + - job: x64_64-darwin-validate + artifacts: false extends: .test-primops + +test-primops-validate: + extends: .test-primops-validate-template when: manual +test-primops-label: + extends: .test-primops-validate-template + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*user-facing.*/' + +test-primops-nightly: + needs: + - job: nightly-x86_64-linux-deb10-validate + artifacts: false + - job: nightly-aarch64-linux-deb10-validate + artifacts: false + - job: nightly-aarch64-darwin-validate + artifacts: false + - job: nightly-x64_64-darwin-validate + artifacts: false + extends: .test-primops + rules: + - if: $NIGHTLY + +test-primops-release: + extends: .test-primops + rules: + - if: '$RELEASE_JOB == "yes"' + ############################################################ # Nofib testing # (Disabled: See #21859) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec001db992160e2b6633eb3a247f15212f5bec07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec001db992160e2b6633eb3a247f15212f5bec07 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 09:51:05 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 05:51:05 -0400 Subject: [Git][ghc/ghc][wip/test-primops] fix Message-ID: <64b7b20950098_3a4b0fb745835177@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 008a1c40 by Matthew Pickering at 2023-07-19T10:50:58+01:00 fix - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -833,7 +833,7 @@ release-hackage-lint: artifacts: false - job: aarch64-darwin-validate artifacts: false - - job: x64_64-darwin-validate + - job: x86_64-darwin-validate artifacts: false extends: .test-primops @@ -854,7 +854,7 @@ test-primops-nightly: artifacts: false - job: nightly-aarch64-darwin-validate artifacts: false - - job: nightly-x64_64-darwin-validate + - job: nightly-x86_64-darwin-validate artifacts: false extends: .test-primops rules: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/008a1c4060cb1ac939124df6aa4ca438f82d1f8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/008a1c4060cb1ac939124df6aa4ca438f82d1f8f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 09:52:17 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 19 Jul 2023 05:52:17 -0400 Subject: [Git][ghc/ghc][wip/T23645] 44 commits: Use deb10 for i386 bindists Message-ID: <64b7b2519efd2_3a4b0fb755c353931@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 22d67ca0 by Jaro Reinders at 2023-07-19T11:51:38+02:00 Improve mulmayoflo - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8439d2e36550784cb72a3242dfb90c0fbee18ff6...22d67ca087d42c03b987d49815d3af6c1cba28a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8439d2e36550784cb72a3242dfb90c0fbee18ff6...22d67ca087d42c03b987d49815d3af6c1cba28a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 09:53:21 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 05:53:21 -0400 Subject: [Git][ghc/ghc][wip/test-primops] fix Message-ID: <64b7b291caa26_3a4b0fb740835618f@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 62767cc1 by Matthew Pickering at 2023-07-19T10:53:13+01:00 fix - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -829,12 +829,16 @@ release-hackage-lint: needs: - job: x86_64-linux-deb10-validate+debug_info artifacts: false + optional: true - job: aarch64-linux-deb10-validate artifacts: false + optional: true - job: aarch64-darwin-validate artifacts: false + optional: true - job: x86_64-darwin-validate artifacts: false + optional: true extends: .test-primops test-primops-validate: @@ -850,12 +854,16 @@ test-primops-nightly: needs: - job: nightly-x86_64-linux-deb10-validate artifacts: false + optional: true - job: nightly-aarch64-linux-deb10-validate artifacts: false + optional: true - job: nightly-aarch64-darwin-validate artifacts: false + optional: true - job: nightly-x86_64-darwin-validate artifacts: false + optional: true extends: .test-primops rules: - if: $NIGHTLY View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62767cc1252e349f069607c2d3cc10e6aa8fd626 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62767cc1252e349f069607c2d3cc10e6aa8fd626 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 10:00:58 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 19 Jul 2023 06:00:58 -0400 Subject: [Git][ghc/ghc][wip/T23645] Improve mulmayoflo Message-ID: <64b7b45a16f55_3a4b0fb7458357737@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: 9513973b by Jaro Reinders at 2023-07-19T12:00:48+02:00 Improve mulmayoflo - - - - - 3 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - testsuite/tests/codeGen/should_run/MulMayOflo.hs - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -972,21 +972,20 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps -- multiplication doesn't use two registers. -- -- The plan is: - -- 1. truncate and sign-extend a and b to 8bit width - -- 2. multiply a' = a * b in 32bit width - -- 3. copy and sign-extend 8bit from a' to c - -- 4. compare a' and c: they are equal if there was no overflow + -- 1. multiply b1 = a * b where b1 has 16bit width + -- 2. subtract b2 = b1 - (-128) + -- (this has shorter machine code than b1 + 128) + -- 3. compare b2 > 255 unsigned + -- This is equivalent to checking b1 < -128 || 127 < b1 (a_reg, a_code) <- getNonClobberedReg a - (b_reg, b_code) <- getNonClobberedReg b + b_code <- getAnyReg b let - code = a_code `appOL` b_code `appOL` + code = a_code `appOL` b_code eax `appOL` toOL [ - MOVSxL II8 (OpReg a_reg) (OpReg a_reg), - MOVSxL II8 (OpReg b_reg) (OpReg b_reg), - IMUL II32 (OpReg b_reg) (OpReg a_reg), - MOVSxL II8 (OpReg a_reg) (OpReg eax), - CMP II16 (OpReg a_reg) (OpReg eax), - SETCC NE (OpReg eax) + IMUL2 II8 (OpReg a_reg), -- result in %ax + SUB II16 (OpImm (ImmInt (-128))) (OpReg eax), + CMP II16 (OpImm (ImmInt 255)) (OpReg eax), + SETCC GU (OpReg eax) ] return (Fixed II8 eax code) imulMayOflo rep a b = do ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -23,4 +23,4 @@ import GHC.Exts foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# main :: IO () -main = print . show $ W# (runCmmzh# 42##) +main = W# (runCmmzh# 42##) `seq` pure () ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -232,8 +232,6 @@ test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) # Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. test('MulMayOflo_full', [ extra_files(['MulMayOflo.hs']), - when(unregisterised(), skip), - unless(arch('x86_64') or arch('i386'), skip), - ignore_stdout], + when(unregisterised(), skip) ], multi_compile_and_run, ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9513973b37c0cce03b7a57f28be124cdd54efb69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9513973b37c0cce03b7a57f28be124cdd54efb69 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 11:06:32 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 07:06:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/gen-ci-fast Message-ID: <64b7c3b8cd34_3a4b0fb755c3762e@gitlab.mail> Matthew Pickering pushed new branch wip/gen-ci-fast at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/gen-ci-fast You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 11:08:46 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 07:08:46 -0400 Subject: [Git][ghc/ghc][wip/gen-ci-fast] ci: Make "fast-ci" the default validate configuration Message-ID: <64b7c43ed1aaf_3a4b0fb7430376698@gitlab.mail> Matthew Pickering pushed to branch wip/gen-ci-fast at Glasgow Haskell Compiler / GHC Commits: c5058a91 by Matthew Pickering at 2023-07-19T12:08:20+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 2 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -556,7 +556,8 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set +data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present @@ -578,7 +579,7 @@ false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String ruleString On FastCI = true -ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" +ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" @@ -767,17 +768,25 @@ delVariable k j = j { jobVariables = MonoidalMap $ Map.delete k $ unMonoidalMap validate :: Arch -> Opsys -> BuildConfig -> NamedJob Job validate = job +-- Nightly and release apply the FastCI configuration to all jobs so that they all run in +-- the pipeline (not conditional on the full-ci label) +nightlyRule :: Job -> Job +nightlyRule = addJobRule FastCI . addJobRule Nightly + +releaseRule :: Job -> Job +releaseRule = addJobRule FastCI . addJobRule ReleaseOnly + -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job nightly arch opsys bc = let NamedJob n j = job arch opsys bc - in NamedJob { name = "nightly-" ++ n, jobInfo = addJobRule Nightly . keepArtifacts "8 weeks" . highCompression $ j} + in NamedJob { name = "nightly-" ++ n, jobInfo = nightlyRule . keepArtifacts "8 weeks" . highCompression $ j} -- | Make a normal release CI job release :: Arch -> Opsys -> BuildConfig -> NamedJob Job release arch opsys bc = let NamedJob n j = job arch opsys (bc { buildFlavour = Release }) - in NamedJob { name = "release-" ++ n, jobInfo = addJobRule ReleaseOnly . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} + in NamedJob { name = "release-" ++ n, jobInfo = releaseRule . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} -- Specific job modification functions @@ -806,6 +815,7 @@ useHashUnitIds :: Job -> Job useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode +-- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job fastCI = modifyValidateJobs (addJobRule FastCI) @@ -888,7 +898,7 @@ job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf , validateBuilds Amd64 (Linux Debian10) nativeInt - , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) + , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure @@ -907,7 +917,7 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla)) -- Fedora33 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - , standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig + , fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) @@ -915,8 +925,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) - , standardBuilds AArch64 Darwin - , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) + , fastCI (standardBuilds AArch64 Darwin) + , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1558,7 +1558,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1622,7 +1622,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1687,7 +1687,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1749,7 +1749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1811,7 +1811,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1873,7 +1873,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1937,7 +1937,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2002,7 +2002,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2066,7 +2066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2129,7 +2129,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2191,7 +2191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2249,7 +2249,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2311,7 +2311,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2377,7 +2377,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2444,7 +2444,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2508,7 +2508,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2572,7 +2572,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2774,7 +2774,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2840,7 +2840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2904,7 +2904,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2968,7 +2968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3032,7 +3032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3096,7 +3096,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3160,7 +3160,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3224,7 +3224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3290,7 +3290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3356,7 +3356,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3486,7 +3486,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3550,7 +3550,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3610,7 +3610,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3673,7 +3673,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3740,7 +3740,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3808,7 +3808,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3871,7 +3871,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3935,7 +3935,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3999,7 +3999,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4063,7 +4063,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4126,7 +4126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4188,7 +4188,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4311,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4372,7 +4372,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4433,7 +4433,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4494,7 +4494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4556,7 +4556,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4619,7 +4619,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4682,7 +4682,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4746,7 +4746,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS ~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS ~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4807,7 +4807,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5058a9185157e43d05623cb58b250230cd08df6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5058a9185157e43d05623cb58b250230cd08df6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 11:11:36 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 07:11:36 -0400 Subject: [Git][ghc/ghc][wip/gen-ci-fast] ci: Make "fast-ci" the default validate configuration Message-ID: <64b7c4e870303_3a4b0fb73cc37681c@gitlab.mail> Matthew Pickering pushed to branch wip/gen-ci-fast at Glasgow Haskell Compiler / GHC Commits: e7f26e09 by Matthew Pickering at 2023-07-19T12:11:08+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 2 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -556,7 +556,8 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set +data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present @@ -578,7 +579,7 @@ false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String ruleString On FastCI = true -ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" +ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" @@ -767,17 +768,25 @@ delVariable k j = j { jobVariables = MonoidalMap $ Map.delete k $ unMonoidalMap validate :: Arch -> Opsys -> BuildConfig -> NamedJob Job validate = job +-- Nightly and release apply the FastCI configuration to all jobs so that they all run in +-- the pipeline (not conditional on the full-ci label) +nightlyRule :: Job -> Job +nightlyRule = addJobRule FastCI . addJobRule Nightly + +releaseRule :: Job -> Job +releaseRule = addJobRule FastCI . addJobRule ReleaseOnly + -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job nightly arch opsys bc = let NamedJob n j = job arch opsys bc - in NamedJob { name = "nightly-" ++ n, jobInfo = addJobRule Nightly . keepArtifacts "8 weeks" . highCompression $ j} + in NamedJob { name = "nightly-" ++ n, jobInfo = nightlyRule . keepArtifacts "8 weeks" . highCompression $ j} -- | Make a normal release CI job release :: Arch -> Opsys -> BuildConfig -> NamedJob Job release arch opsys bc = let NamedJob n j = job arch opsys (bc { buildFlavour = Release }) - in NamedJob { name = "release-" ++ n, jobInfo = addJobRule ReleaseOnly . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} + in NamedJob { name = "release-" ++ n, jobInfo = releaseRule . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} -- Specific job modification functions @@ -806,6 +815,7 @@ useHashUnitIds :: Job -> Job useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode +-- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job fastCI = modifyValidateJobs (addJobRule FastCI) @@ -888,7 +898,7 @@ job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf , validateBuilds Amd64 (Linux Debian10) nativeInt - , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) + , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure @@ -907,7 +917,7 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla)) -- Fedora33 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - , standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig + , fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) @@ -915,8 +925,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) - , standardBuilds AArch64 Darwin - , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) + , fastCI (standardBuilds AArch64 Darwin) + , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1558,7 +1558,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1622,7 +1622,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1687,7 +1687,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1749,7 +1749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1811,7 +1811,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1873,7 +1873,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1937,7 +1937,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2002,7 +2002,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2066,7 +2066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2129,7 +2129,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2191,7 +2191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2249,7 +2249,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2311,7 +2311,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2377,7 +2377,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2444,7 +2444,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2508,7 +2508,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2572,7 +2572,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2774,7 +2774,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2840,7 +2840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2904,7 +2904,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2968,7 +2968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3032,7 +3032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3096,7 +3096,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3160,7 +3160,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3224,7 +3224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3290,7 +3290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3356,7 +3356,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3486,7 +3486,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3550,7 +3550,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3610,7 +3610,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3673,7 +3673,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3740,7 +3740,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3808,7 +3808,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3871,7 +3871,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3935,7 +3935,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3999,7 +3999,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4063,7 +4063,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4126,7 +4126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4188,7 +4188,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4311,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4372,7 +4372,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4433,7 +4433,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4494,7 +4494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4556,7 +4556,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4619,7 +4619,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4682,7 +4682,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4746,7 +4746,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4807,7 +4807,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7f26e09a12468f48f90540eb025ebd7c4fc0fdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7f26e09a12468f48f90540eb025ebd7c4fc0fdb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 11:25:03 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 07:25:03 -0400 Subject: [Git][ghc/ghc][wip/gen-ci-fast] ci: Make "fast-ci" the default validate configuration Message-ID: <64b7c80fd8f6d_3a4b0fb745838921e@gitlab.mail> Matthew Pickering pushed to branch wip/gen-ci-fast at Glasgow Haskell Compiler / GHC Commits: 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -432,7 +432,7 @@ hadrian-multi: paths: - cabal-cache rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # stack-hadrian-build @@ -830,7 +830,7 @@ perf-nofib: - if: $CI_MERGE_REQUEST_ID - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' tags: - x86_64-linux before_script: @@ -897,7 +897,7 @@ perf: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # ABI testing @@ -937,7 +937,7 @@ abi-test: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -556,7 +556,8 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set +data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present @@ -578,7 +579,7 @@ false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String ruleString On FastCI = true -ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" +ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" @@ -767,17 +768,25 @@ delVariable k j = j { jobVariables = MonoidalMap $ Map.delete k $ unMonoidalMap validate :: Arch -> Opsys -> BuildConfig -> NamedJob Job validate = job +-- Nightly and release apply the FastCI configuration to all jobs so that they all run in +-- the pipeline (not conditional on the full-ci label) +nightlyRule :: Job -> Job +nightlyRule = addJobRule FastCI . addJobRule Nightly + +releaseRule :: Job -> Job +releaseRule = addJobRule FastCI . addJobRule ReleaseOnly + -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job nightly arch opsys bc = let NamedJob n j = job arch opsys bc - in NamedJob { name = "nightly-" ++ n, jobInfo = addJobRule Nightly . keepArtifacts "8 weeks" . highCompression $ j} + in NamedJob { name = "nightly-" ++ n, jobInfo = nightlyRule . keepArtifacts "8 weeks" . highCompression $ j} -- | Make a normal release CI job release :: Arch -> Opsys -> BuildConfig -> NamedJob Job release arch opsys bc = let NamedJob n j = job arch opsys (bc { buildFlavour = Release }) - in NamedJob { name = "release-" ++ n, jobInfo = addJobRule ReleaseOnly . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} + in NamedJob { name = "release-" ++ n, jobInfo = releaseRule . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} -- Specific job modification functions @@ -806,6 +815,7 @@ useHashUnitIds :: Job -> Job useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode +-- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job fastCI = modifyValidateJobs (addJobRule FastCI) @@ -888,7 +898,7 @@ job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf , validateBuilds Amd64 (Linux Debian10) nativeInt - , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) + , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure @@ -907,7 +917,7 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla)) -- Fedora33 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - , standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig + , fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) @@ -915,8 +925,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) - , standardBuilds AArch64 Darwin - , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) + , fastCI (standardBuilds AArch64 Darwin) + , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1558,7 +1558,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1622,7 +1622,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1687,7 +1687,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1749,7 +1749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1811,7 +1811,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1873,7 +1873,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1937,7 +1937,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2002,7 +2002,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2066,7 +2066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2129,7 +2129,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2191,7 +2191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2249,7 +2249,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2311,7 +2311,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2377,7 +2377,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2444,7 +2444,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2508,7 +2508,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2572,7 +2572,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2774,7 +2774,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2840,7 +2840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2904,7 +2904,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2968,7 +2968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3032,7 +3032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3096,7 +3096,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3160,7 +3160,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3224,7 +3224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3290,7 +3290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3356,7 +3356,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3486,7 +3486,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3550,7 +3550,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3610,7 +3610,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3673,7 +3673,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3740,7 +3740,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3808,7 +3808,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3871,7 +3871,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3935,7 +3935,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3999,7 +3999,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4063,7 +4063,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4126,7 +4126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4188,7 +4188,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4311,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4372,7 +4372,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4433,7 +4433,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4494,7 +4494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4556,7 +4556,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4619,7 +4619,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4682,7 +4682,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4746,7 +4746,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4807,7 +4807,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/808b55cf44660796894401624207a789aa7e49f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/808b55cf44660796894401624207a789aa7e49f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 12:35:58 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 19 Jul 2023 08:35:58 -0400 Subject: [Git][ghc/ghc][wip/test-primops] 42 commits: Fix deprecation of record fields Message-ID: <64b7d8aedf5d3_3a4b0f406ce404324a@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 76e8ea62 by Matthew Pickering at 2023-07-19T13:23:34+01:00 Add zstd suffix to jobs which rely on zstd This was causing some confusion as the job was named simply "x86_64-linux-deb10-validate", which implies a standard configuration rather than any dependency on libzstd. - - - - - b011cded by Matthew Pickering at 2023-07-19T13:23:34+01:00 ci: Always run project-version job This is needed for the downstream test-primops pipeline to workout what the version of a bindist produced by a pipeline is. - - - - - 7d3b933d by Matthew Pickering at 2023-07-19T13:23:34+01:00 gen_ci: Rework how jobs-metadata.json is generated * We now represent a job group a triple of Maybes, which makes it easier to work out when jobs are enabled/disabled on certain pipelines. ``` data JobGroup a = StandardTriple { v :: Maybe (NamedJob a) , n :: Maybe (NamedJob a) , r :: Maybe (NamedJob a) } ``` * `jobs-metadata.json` generation is reworked using the following algorithm. - For each pipeline type, find all the platforms we are doing builds for. - Select one build per platform - Zip together the results This way we can choose different pipelines for validate/nightly/release which makes the metadata also useful for validate pipelines. This feature is used by the test-primops downstream CI in order to select the right bindist for testing validate pipelines. This makes it easier to inspect which jobs are going to be enabled on a particular pipeline. - - - - - c3f0fb8c by Matthew Pickering at 2023-07-19T13:35:32+01:00 ci: Add support for triggering test-primops pipelines This commit adds 4 ways to trigger testing with test-primops. 1. Applying the ~test-primops label to a validate pipeline. 2. A manually triggered job on a validate pipeline 3. A nightly pipeline job 4. A release pipeline job Fixes #23695 - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62767cc1252e349f069607c2d3cc10e6aa8fd626...c3f0fb8cb8df995f277666871edbab5bc4fc02bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62767cc1252e349f069607c2d3cc10e6aa8fd626...c3f0fb8cb8df995f277666871edbab5bc4fc02bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 12:44:35 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 19 Jul 2023 08:44:35 -0400 Subject: [Git][ghc/ghc][wip/T23578] 73 commits: Drop circle-ci-job.sh Message-ID: <64b7dab3788bd_3a4b0fb74304374a0@gitlab.mail> Sylvain Henry pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 86c942dc by Jaro Reinders at 2023-07-19T12:44:29+00:00 Copy eftWord to eftWord64 - - - - - 129dbba2 by Jaro Reinders at 2023-07-19T12:44:29+00:00 Refactor more - - - - - 6acaefa2 by Jaro Reinders at 2023-07-19T12:44:29+00:00 Also change Enum Int64 - - - - - 21afc00d by Jaro Reinders at 2023-07-19T12:44:29+00:00 Fix indentation and alignment - - - - - 16 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/763326655933962029a27ca8454ea4a54392e0e7...21afc00d62cba9efad4a0f78c215cf0456361ec7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/763326655933962029a27ca8454ea4a54392e0e7...21afc00d62cba9efad4a0f78c215cf0456361ec7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 12:55:57 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 19 Jul 2023 08:55:57 -0400 Subject: [Git][ghc/ghc][wip/T21077] 2664 commits: Tag inference work. Message-ID: <64b7dd5d4561a_3a4b0fb74304420f0@gitlab.mail> Ryan Scott pushed to branch wip/T21077 at Glasgow Haskell Compiler / GHC Commits: 0e93023e by Andreas Klebinger at 2022-02-12T13:59:41+00:00 Tag inference work. This does three major things: * Enforce the invariant that all strict fields must contain tagged pointers. * Try to predict the tag on bindings in order to omit tag checks. * Allows functions to pass arguments unlifted (call-by-value). The former is "simply" achieved by wrapping any constructor allocations with a case which will evaluate the respective strict bindings. The prediction is done by a new data flow analysis based on the STG representation of a program. This also helps us to avoid generating redudant cases for the above invariant. StrictWorkers are created by W/W directly and SpecConstr indirectly. See the Note [Strict Worker Ids] Other minor changes: * Add StgUtil module containing a few functions needed by, but not specific to the tag analysis. ------------------------- Metric Decrease: T12545 T18698b T18140 T18923 LargeRecord Metric Increase: LargeRecord ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T15164 T18282 T18304 T18698a T1969 T20049 T3294 T4801 T5321FD T5321Fun T783 T9233 T9675 T9961 T19695 WWRec ------------------------- - - - - - 744f8a11 by Greg Steuck at 2022-02-12T17:13:55-05:00 Only check the exit code in derefnull & divbyzero tests on OpenBSD - - - - - eeead9fc by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/Adjustor: Ensure that allocateExecPage succeeded Previously we failed to handle the case that `allocateExecPage` failed. - - - - - afdfaff0 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Drop DEC Alpha adjustor implementation The last Alpha chip was produced in 2004. - - - - - 191dfd2d by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/adjustor: Split Windows path out of NativeAmd64 - - - - - be591e27 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Initial commit of AdjustorPool - - - - - d6d48b16 by Ben Gamari at 2022-02-13T03:26:14-05:00 Introduce initAdjustors - - - - - eab37902 by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64: Use AdjustorPool - - - - - 974e73af by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64Mingw: Use AdjustorPool - - - - - 95fab83f by Ben Gamari at 2022-02-13T03:26:14-05:00 configure: Fix result reporting of adjustors method check - - - - - ef5cf55d by nikshalark at 2022-02-13T03:26:16-05:00 (#21044) Documented arithmetic functions in base. Didn't get it right the ninth time. Now everything's formatted correctly. - - - - - acb482cc by Takenobu Tani at 2022-02-16T05:27:17-05:00 Relax load_load_barrier for aarch64 This patch relaxes the instruction for load_load_barrier(). Current load_load_barrier() implements full-barrier with `dmb sy`. It's too strong to order load-load instructions. We can relax it by using `dmb ld`. If current load_load_barrier() is used for full-barriers (load/store - load/store barrier), this patch is not suitable. See also linux-kernel's smp_rmb() implementation: https://github.com/torvalds/linux/blob/v5.14/arch/arm64/include/asm/barrier.h#L90 Hopefully, it's better to use `dmb ishld` rather than `dmb ld` to improve performance. However, I can't validate effects on a real many-core Arm machine. - - - - - 84eaa26f by Oleg Grenrus at 2022-02-16T05:27:56-05:00 Add test for #20562 - - - - - 2c28620d by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: remove struct StgRetry, it is never used - - - - - 74bf9bb5 by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: document some closure types - - - - - 316312ec by nineonine at 2022-02-16T05:29:08-05:00 ghci: fix -ddump-stg-cg (#21052) The pre-codegen Stg AST dump was not available in ghci because it was performed in 'doCodeGen'. This was now moved to 'coreToStg' area. - - - - - a6411d74 by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: mention -fprof-late-ccs in the release notes And note which compiler version it was added in. - - - - - 4127e86d by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: fix release notes formatting - - - - - 4e6c8019 by Matthew Pickering at 2022-02-17T05:25:28-05:00 Always define __GLASGOW_HASKELL_PATCHLEVEL1/2__ macros As #21076 reports if you are using `-Wcpp-undef` then you get warnings when using the `MIN_VERSION_GLASGOW_HASKELL` macro because __GLASGOW_HASKELL_PATCHLEVEL2__ is very rarely explicitliy set (as version numbers are not 4 components long). This macro was introduced in 3549c952b535803270872adaf87262f2df0295a4 and it seems the bug has existed ever since. Fixes #21076 - - - - - 67dd5724 by Ben Gamari at 2022-02-17T05:26:03-05:00 rts/AdjustorPool: Silence unused function warning bitmap_get is only used in the DEBUG RTS configuration. Fixes #21079. - - - - - 4b04f7e1 by Zubin Duggal at 2022-02-20T13:56:15-05:00 Track object file dependencies for TH accurately (#20604) `hscCompileCoreExprHook` is changed to return a list of `Module`s required by a splice. These modules are accumulated in the TcGblEnv (tcg_th_needed_mods). Dependencies on the object files of these modules are recording in the interface. The data structures in `LoaderState` are replaced with more efficient versions to keep track of all the information required. The MultiLayerModulesTH_Make allocations increase slightly but runtime is faster. Fixes #20604 ------------------------- Metric Increase: MultiLayerModulesTH_Make ------------------------- - - - - - 92ab3ff2 by sheaf at 2022-02-20T13:56:55-05:00 Use diagnostics for "missing signature" errors This patch makes the "missing signature" errors from "GHC.Rename.Names" use the diagnostic infrastructure. This encompasses missing type signatures for top-level bindings and pattern synonyms, as well as missing kind signatures for type constructors. This patch also renames TcReportMsg to TcSolverReportMsg, and adds a few convenience functions to compute whether such a TcSolverReportMsg is an expected/actual message. - - - - - 845284a5 by sheaf at 2022-02-20T13:57:34-05:00 Generically: remove redundant Semigroup constraint This patch removes a redundant Semigroup constraint on the Monoid instance for Generically. This constraint can cause trouble when one wants to derive a Monoid instance via Generically through a type that doesn't itself have a Semigroup instance, for example: data Point2D a = Point2D !a !a newtype Vector2D a = Vector2D { tip :: Point2D a } deriving ( Semigroup, Monoid ) via Generically ( Point2D ( Sum a ) ) In this case, we should not require there to be an instance Semigroup ( Point2D ( Sum a ) ) as all we need is an instance for the generic representation of Point2D ( Sum a ), i.e. Semigroup ( Rep ( Point2D ( Sum a) ) () ). - - - - - 6b468f7f by Ben Gamari at 2022-02-20T13:58:10-05:00 Bump time submodule to 1.12.1 - - - - - 2f0ceecc by Zubin Duggal at 2022-02-20T19:06:19+00:00 hadrian: detect if 'main' is not a haskell file and add it to appropriate list of sources - - - - - 7ce1b694 by Zubin Duggal at 2022-02-21T11:18:58+00:00 Reinstallable GHC This patch allows ghc and its dependencies to be built using a normal invocation of cabal-install. Each componenent which relied on generated files or additional configuration now has a Setup.hs file. There are also various fixes to the cabal files to satisfy cabal-install. There is a new hadrian command which will build a stage2 compiler and then a stage3 compiler by using cabal. ``` ./hadrian/build build-cabal ``` There is also a new CI job which tests running this command. For the 9.4 release we will upload all the dependent executables to hackage and then end users will be free to build GHC and GHC executables via cabal. There are still some unresolved questions about how to ensure soundness when loading plugins into a reinstalled GHC (#20742) which will be tighted up in due course. Fixes #19896 - - - - - 78fbc3a3 by Matthew Pickering at 2022-02-21T15:14:28-05:00 hadrian: Enable late-ccs when building profiled_ghc - - - - - 2b890c89 by Matthew Pickering at 2022-02-22T15:59:33-05:00 testsuite: Don't print names of all fragile tests on all runs This information about fragile tests is pretty useless but annoying on CI where you have to scroll up a long way to see the actual issues. - - - - - 0b36801f by sheaf at 2022-02-22T16:00:14-05:00 Forbid standalone instances for built-in classes `check_special_inst_head` includes logic that disallows hand-written instances for built-in classes such as Typeable, KnownNat and KnownSymbol. However, it also allowed standalone deriving declarations. This was because we do want to allow standalone deriving instances with Typeable as they are harmless, but we certainly don't want to allow instances for e.g. KnownNat. This patch ensures that we don't allow derived instances for KnownNat, KnownSymbol (and also KnownChar, which was previously omitted entirely). Fixes #21087 - - - - - ace66dec by Krzysztof Gogolewski at 2022-02-22T16:30:59-05:00 Remove -Wunticked-promoted-constructors from -Wall Update manual; explain ticks as optional disambiguation rather than the preferred default. This is a part of #20531. - - - - - 558c7d55 by Hugo at 2022-02-22T16:31:01-05:00 docs: fix error in annotation guide code snippet - - - - - a599abba by Richard Eisenberg at 2022-02-23T08:16:07-05:00 Kill derived constraints Co-authored by: Sam Derbyshire Previously, GHC had three flavours of constraint: Wanted, Given, and Derived. This removes Derived constraints. Though serving a number of purposes, the most important role of Derived constraints was to enable better error messages. This job has been taken over by the new RewriterSets, as explained in Note [Wanteds rewrite wanteds] in GHC.Tc.Types.Constraint. Other knock-on effects: - Various new Notes as I learned about under-described bits of GHC - A reshuffling around the AST for implicit-parameter bindings, with better integration with TTG. - Various improvements around fundeps. These were caused by the fact that, previously, fundep constraints were all Derived, and Derived constraints would get dropped. Thus, an unsolved Derived didn't stop compilation. Without Derived, this is no longer possible, and so we have to be considerably more careful around fundeps. - A nice little refactoring in GHC.Tc.Errors to center the work on a new datatype called ErrorItem. Constraints are converted into ErrorItems at the start of processing, and this allows for a little preprocessing before the main classification. - This commit also cleans up the behavior in generalisation around functional dependencies. Now, if a variable is determined by functional dependencies, it will not be quantified. This change is user facing, but it should trim down GHC's strange behavior around fundeps. - Previously, reportWanteds did quite a bit of work, even on an empty WantedConstraints. This commit adds a fast path. - Now, GHC will unconditionally re-simplify constraints during quantification. See Note [Unconditionally resimplify constraints when quantifying], in GHC.Tc.Solver. Close #18398. Close #18406. Solve the fundep-related non-confluence in #18851. Close #19131. Close #19137. Close #20922. Close #20668. Close #19665. ------------------------- Metric Decrease: LargeRecord T9872b T9872b_defer T9872d TcPlugin_RewritePerf ------------------------- - - - - - 2ed22ba1 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Introduce predicate for when to enable source notes (needSourceNotes) There were situations where we were using debugLevel == 0 as a proxy for whether to retain source notes but -finfo-table-map also enables and needs source notes so we should act consistently in both cases. Ticket #20847 - - - - - 37deb893 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Use SrcSpan from the binder as initial source estimate There are some situations where we end up with no source notes in useful positions in an expression. In this case we currently fail to provide any source information about where an expression came from. This patch improves the initial estimate by using the position from the top-binder as the guess for the location of the whole inner expression. It provides quite a course estimate but it's better than nothing. Ticket #20847 - - - - - 59b7f764 by Cheng Shao at 2022-02-23T08:17:24-05:00 Don't emit foreign exports initialiser code for empty CAF list - - - - - c7f32f76 by John Ericson at 2022-02-23T13:58:36-05:00 Prepare rechecking logic for new type in a few ways Combine `MustCompile and `NeedsCompile` into a single case. `CompileReason` is put inside to destinguish the two. This makes a number of things easier. `Semigroup RecompileRequired` is no longer used, to make sure we skip doing work where possible. `recompThen` is very similar, but helps remember. `checkList` is rewritten with `recompThen`. - - - - - e60d8df8 by John Ericson at 2022-02-23T13:58:36-05:00 Introduce `MaybeValidated` type to remove invalid states The old return type `(RecompRequired, Maybe _)`, was confusing because it was inhabited by values like `(UpToDate, Nothing)` that made no sense. The new type ensures: - you must provide a value if it is up to date. - you must provide a reason if you don't provide a value. it is used as the return value of: - `checkOldIface` - `checkByteCode` - `checkObjects` - - - - - f07b13e3 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor X86 codegen Preliminary work done to make working on #5444 easier. Mostly make make control-flow easier to follow: * renamed genCCall into genForeignCall * split genForeignCall into the part dispatching on PrimTarget (genPrim) and the one really generating code for a C call (cf ForeignTarget and genCCall) * made genPrim/genSimplePrim only dispatch on MachOp: each MachOp now has its own code generation function. * out-of-line primops are not handled in a partial `outOfLineCmmOp` anymore but in the code generation functions directly. Helper functions have been introduced (e.g. genLibCCall) for code sharing. * the latter two bullets make code generated for primops that are only sometimes out-of-line (e.g. Pdep or Memcpy) and the logic to select between inline/out-of-line much more localized * avoided passing is32bit as an argument as we can easily get it from NatM state when we really need it * changed genCCall type to avoid it being partial (it can't handle PrimTarget) * globally removed 12 calls to `panic` thanks to better control flow and types ("parse, don't validate" ftw!). - - - - - 6fa7591e by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor the way registers are handled * add getLocalRegReg to avoid allocating a CmmLocal just to call getRegisterReg * 64-bit registers: in the general case we must always use the virtual higher part of the register, so we might as well always return it with the lower part. The only exception is to implement 64-bit to 32-bit conversions. We now have to explicitly discard the higher part when matching on Reg64/RegCode64 datatypes instead of explicitly fetching the higher part from the lower part: much safer default. - - - - - bc8de322 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: inline some 64-bit primops on x86/32-bit (#5444) Several 64-bit operation were implemented with FFI calls on 32-bit architectures but we can easily implement them with inline assembly code. Also remove unused hs_int64ToWord64 and hs_word64ToInt64 C functions. - - - - - 7b7c6b95 by Matthew Pickering at 2022-02-23T14:00:00-05:00 Simplify/correct implementation of getModuleInfo - - - - - 6215b04c by Matthew Pickering at 2022-02-23T14:00:00-05:00 Remove mg_boot field from ModuleGraph It was unused in the compiler so I have removed it to streamline ModuleGraph. - - - - - 818ff2ef by Matthew Pickering at 2022-02-23T14:00:01-05:00 driver: Remove needsTemplateHaskellOrQQ from ModuleGraph The idea of the needsTemplateHaskellOrQQ query is to check if any of the modules in a module graph need Template Haskell then enable -dynamic-too if necessary. This is quite imprecise though as it will enable -dynamic-too for all modules in the module graph even if only one module uses template haskell, with multiple home units, this is obviously even worse. With -fno-code we already have similar logic to enable code generation just for the modules which are dependeded on my TemplateHaskell modules so we use the same code path to decide whether to enable -dynamic-too rather than using this big hammer. This is part of the larger overall goal of moving as much statically known configuration into the downsweep as possible in order to have fully decided the build plan and all the options before starting to build anything. I also included a fix to #21095, a long standing bug with with the logic which is supposed to enable the external interpreter if we don't have the internal interpreter. Fixes #20696 #21095 - - - - - b6670af6 by Matthew Pickering at 2022-02-23T14:00:40-05:00 testsuite: Normalise output of ghci011 and T7627 The outputs of these tests vary on the order interface files are loaded so we normalise the output to correct for these inconsequential differences. Fixes #21121 - - - - - 9ed3bc6e by Peter Trommler at 2022-02-23T14:01:16-05:00 testsuite: Fix ipeMap test Pointers to closures must be untagged before use. Produce closures of different types so we get different info tables. Fixes #21112 - - - - - 7d426148 by Ziyang Liu at 2022-02-24T04:53:34-05:00 Allow `return` in more cases in ApplicativeDo The doc says that the last statement of an ado-block can be one of `return E`, `return $ E`, `pure E` and `pure $ E`. But `return` is not accepted in a few cases such as: ```haskell -- The ado-block only has one statement x :: F () x = do return () -- The ado-block only has let-statements besides the `return` y :: F () y = do let a = True return () ``` These currently require `Monad` instances. This MR fixes it. Normally `return` is accepted as the last statement because it is stripped in constructing an `ApplicativeStmt`, but this cannot be done in the above cases, so instead we replace `return` by `pure`. A similar but different issue (when the ado-block contains `BindStmt` or `BodyStmt`, the second last statement cannot be `LetStmt`, even if the last statement uses `pure`) is fixed in !6786. - - - - - a5ea7867 by John Ericson at 2022-02-24T20:23:49-05:00 Clarify laws of TestEquality It is unclear what `TestEquality` is for. There are 3 possible choices. Assuming ```haskell data Tag a where TagInt1 :: Tag Int TagInt2 :: Tag Int ``` Weakest -- type param equality semi-decidable --------------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params may or may not be not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Nothing -- oopsie is allowed testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` This option is better demonstrated with a different type: ```haskell data Tag' a where TagInt1 :: Tag Int TagInt2 :: Tag a ``` ```haskell instance TestEquality Tag' where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Nothing -- can't be sure testEquality TagInt2 TagInt1 = Nothing -- can't be sure testEquality TagInt2 TagInt2 = Nothing -- can't be sure ``` Weaker -- type param equality decidable --------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params are not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` Strong -- Like `Eq` ------------------- `Just Refl` means the type params are equal, and the values are equal according to `Eq`. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl testEquality _ _ = Nothing ``` Strongest -- unique value concrete type --------------------------------------- `Just Refl` means the type params are equal, and the values are equal, and the class assume if the type params are equal the values must also be equal. In other words, the type is a singleton type when the type parameter is a closed term. ```haskell -- instance TestEquality -- invalid instance because two variants for `Int` ``` ------ The discussion in https://github.com/haskell/core-libraries-committee/issues/21 has decided on the "Weaker" option (confusingly formerly called the "Weakest" option). So that is what is implemented. - - - - - 06c18990 by Zubin Duggal at 2022-02-24T20:24:25-05:00 TH: fix pretty printing of GADTs with multiple constuctors (#20842) - - - - - 6555b68c by Matthew Pickering at 2022-02-24T20:25:06-05:00 Move linters into the tree This MR moves the GHC linters into the tree, so that they can be run directly using Hadrian. * Query all files tracked by Git instead of using changed files, so that we can run the exact same linting step locally and in a merge request. * Only check that the changelogs don't contain TBA when RELEASE=YES. * Add hadrian/lint script, which runs all the linting steps. * Ensure the hlint job exits with a failure if hlint is not installed (otherwise we were ignoring the failure). Given that hlint doesn't seem to be available in CI at the moment, I've temporarily allowed failure in the hlint job. * Run all linting tests in CI using hadrian. - - - - - b99646ed by Matthew Pickering at 2022-02-24T20:25:06-05:00 Add rule for generating HsBaseConfig.h If you are running the `lint:{base/compiler}` command locally then this improves the responsiveness because we don't re-run configure everytime if the header file already exists. - - - - - d0deaaf4 by Matthew Pickering at 2022-02-24T20:25:06-05:00 Suggestions due to hlint It turns out this job hasn't been running for quite a while (perhaps ever) so there are quite a few failures when running the linter locally. - - - - - 70bafefb by nineonine at 2022-02-24T20:25:42-05:00 ghci: show helpful error message when loading module with SIMD vector operations (#20214) Previously, when trying to load module with SIMD vector operations, ghci would panic in 'GHC.StgToByteCode.findPushSeq'. Now, a more helpful message is displayed. - - - - - 8ed3d5fd by Matthew Pickering at 2022-02-25T10:24:12+00:00 Remove test-bootstrap and cabal-reinstall jobs from fast-ci [skip ci] - - - - - 8387dfbe by Mario Blažević at 2022-02-25T21:09:41-05:00 template-haskell: Fix two prettyprinter issues Fix two issues regarding printing numeric literals. Fixing #20454. - - - - - 4ad8ce0b by sheaf at 2022-02-25T21:10:22-05:00 GHCi: don't normalise partially instantiated types This patch skips performing type normalisation when we haven't fully instantiated the type. That is, in tcRnExpr (used only for :type in GHCi), skip normalisation if the result type responds True to isSigmaTy. Fixes #20974 - - - - - f35aca4d by Ben Gamari at 2022-02-25T21:10:57-05:00 rts/adjustor: Always place adjustor templates in data section @nrnrnr points out that on his machine ld.lld rejects text relocations. Generalize the Darwin text-relocation avoidance logic to account for this. - - - - - cddb040a by Andreas Klebinger at 2022-02-25T21:11:33-05:00 Ticky: Gate tag-inference dummy ticky-counters behind a flag. Tag inference included a way to collect stats about avoided tag-checks. This was dony by emitting "dummy" ticky entries with counts corresponding to predicted/unpredicated tag checks. This behaviour for ticky is now gated behind -fticky-tag-checks. I also documented ticky-LNE in the process. - - - - - 948bf2d0 by Ben Gamari at 2022-02-25T21:12:09-05:00 Fix comment reference to T4818 - - - - - 9c3edeb8 by Ben Gamari at 2022-02-25T21:12:09-05:00 simplCore: Correctly extend in-scope set in rule matching Note [Matching lets] in GHC.Core.Rules claims the following: > We use GHC.Core.Subst.substBind to freshen the binding, using an > in-scope set that is the original in-scope variables plus the > rs_bndrs (currently floated let-bindings). However, previously the implementation didn't actually do extend the in-scope set with rs_bndrs. This appears to be a regression which was introduced by 4ff4d434e9a90623afce00b43e2a5a1ccbdb4c05. Moreover, the originally reasoning was subtly wrong: we must rather use the in-scope set from rv_lcl, extended with rs_bndrs, not that of `rv_fltR` Fixes #21122. - - - - - 7f9f49c3 by sheaf at 2022-02-25T21:12:47-05:00 Derive some stock instances for OverridingBool This patch adds some derived instances to `GHC.Data.Bool.OverridingBool`. It also changes the order of the constructors, so that the derived `Ord` instance matches the behaviour for `Maybe Bool`. Fixes #20326 - - - - - 140438a8 by nineonine at 2022-02-25T21:13:23-05:00 Add test for #19271 - - - - - ac9f4606 by sheaf at 2022-02-25T21:14:04-05:00 Allow qualified names in COMPLETE pragmas The parser didn't allow qualified constructor names to appear in COMPLETE pragmas. This patch fixes that. Fixes #20551 - - - - - 677c6c91 by Sylvain Henry at 2022-02-25T21:14:44-05:00 Testsuite: remove arch conditional in T8832 Taken from !3658 - - - - - ad04953b by Sylvain Henry at 2022-02-25T21:15:23-05:00 Allow hscGenHardCode to not return CgInfos This is a minor change in preparation for the JS backend: CgInfos aren't mandatory and the JS backend won't return them. - - - - - 929c280f by Sylvain Henry at 2022-02-25T21:15:24-05:00 Derive Enum instances for CCallConv and Safety This is used by the JS backend for serialization. - - - - - 75e4e090 by Sebastian Graf at 2022-02-25T21:15:59-05:00 base: Improve documentation of `throwIO` (#19854) Now it takes a better account of precise vs. imprecise exception semantics. Fixes #19854. - - - - - 61a203ba by Matthew Pickering at 2022-02-26T02:06:51-05:00 Make typechecking unfoldings from interfaces lazier The old logic was unecessarily strict in loading unfoldings because when reading the unfolding we would case on the result of attempting to load the template before commiting to which type of unfolding we were producing. Hence trying to inspect any of the information about an unfolding would force the template to be loaded. This also removes a potentially hard to discover bug where if the template failed to be typechecked for some reason then we would just not return an unfolding. Instead we now panic so these bad situations which should never arise can be identified. - - - - - 2be74460 by Matthew Pickering at 2022-02-26T02:06:51-05:00 Use a more up-to-date snapshot of the current rules in the simplifier As the prescient (now deleted) note warns in simplifyPgmIO we have to be a bit careful about when we gather rules from the EPS so that we get the rules for imported bindings. ``` -- Get any new rules, and extend the rule base -- See Note [Overall plumbing for rules] in GHC.Core.Rules -- We need to do this regularly, because simplification can -- poke on IdInfo thunks, which in turn brings in new rules -- behind the scenes. Otherwise there's a danger we'll simply -- miss the rules for Ids hidden inside imported inlinings ``` Given the previous commit, the loading of unfoldings is now even more delayed so we need to be more careful to read the EPS rule base closer to the point where we decide to try rules. Without this fix GHC performance regressed by a noticeably amount because the `zip` rule was not brought into scope eagerly enough which led to a further series of unfortunate events in the simplifer which tipped `substTyWithCoVars` over the edge of the size threshold, stopped it being inlined and increased allocations by 10% in some cases. Furthermore, this change is noticeably in the testsuite as it changes T19790 so that the `length` rules from GHC.List fires earlier. ------------------------- Metric Increase: T9961 ------------------------- - - - - - b8046195 by Matthew Pickering at 2022-02-26T02:06:52-05:00 Improve efficiency of extending a RuleEnv with a new RuleBase Essentially we apply the identity: > lookupNameEnv n (plusNameEnv_C (++) rb1 rb2) > = lookupNameEnv n rb1 ++ lookupNameEnv n rb2 The latter being more efficient as we don't construct an intermediate map. This is now quite important as each time we try and apply rules we need to combine the current EPS RuleBase with the HPT and ModGuts rule bases. - - - - - 033e9f0f by sheaf at 2022-02-26T02:07:30-05:00 Error on anon wildcards in tcAnonWildCardOcc The code in tcAnonWildCardOcc assumed that it could never encounter anonymous wildcards in illegal positions, because the renamer would have ruled them out. However, it's possible to sneak past the checks in the renamer by using Template Haskell. It isn't possible to simply pass on additional information when renaming Template Haskell brackets, because we don't know in advance in what context the bracket will be spliced in (see test case T15433b). So we accept that we might encounter these bogus wildcards in the typechecker and throw the appropriate error. This patch also migrates the error messages for illegal wildcards in types to use the diagnostic infrastructure. Fixes #15433 - - - - - 32d8fe3a by sheaf at 2022-02-26T14:15:33+01:00 Core Lint: ensure primops can be eta-expanded This patch adds a check to Core Lint, checkCanEtaExpand, which ensures that primops and other wired-in functions with no binding such as unsafeCoerce#, oneShot, rightSection... can always be eta-expanded, by checking that the remaining argument types have a fixed RuntimeRep. Two subtleties came up: - the notion of arity in Core looks through newtypes, so we may need to unwrap newtypes in this check, - we want to avoid calling hasNoBinding on something whose unfolding we are in the process of linting, as this would cause a loop; to avoid this we add some information to the Core Lint environment that holds this information. Fixes #20480 - - - - - 0a80b436 by Peter Trommler at 2022-02-26T17:21:59-05:00 testsuite: Require LLVM for T15155l - - - - - 38cb920e by Oleg Grenrus at 2022-02-28T07:14:04-05:00 Add Monoid a => Monoid (STM a) instance - - - - - d734ef8f by Hécate Moonlight at 2022-02-28T07:14:42-05:00 Make modules in base stable. fix #18963 - - - - - fbf005e9 by Sven Tennie at 2022-02-28T19:16:01-05:00 Fix some hlint issues in ghc-heap This does not fix all hlint issues as the criticised index and length expressions seem to be fine in context. - - - - - adfddf7d by Matthew Pickering at 2022-02-28T19:16:36-05:00 hadrian: Suggest to the user to run ./configure if missing a setting If a setting is missing from the configuration file it's likely the user needs to reconfigure. Fixes #20476 - - - - - 4f0208e5 by Andreas Klebinger at 2022-02-28T19:17:12-05:00 CLabel cleanup: Remove these smart constructors for these reasons: * mkLocalClosureTableLabel : Does the same as the non-local variant. * mkLocalClosureLabel : Does the same as the non-local variant. * mkLocalInfoTableLabel : Decide if we make a local label based on the name and just use mkInfoTableLabel everywhere. - - - - - 065419af by Matthew Pickering at 2022-02-28T19:17:47-05:00 linking: Don't pass --hash-size and --reduce-memory-overhead to ld These flags were added to help with the high linking cost of the old split-objs mode. Now we are using split-sections these flags appear to make no difference to memory usage or time taken to link. I tested various configurations linking together the ghc library with -split-sections enabled. | linker | time (s) | | ------ | ------ | | gold | 0.95 | | ld | 1.6 | | ld (hash-size = 31, reduce-memory-overheads) | 1.6 | | ldd | 0.47 | Fixes #20967 - - - - - 3e65ef05 by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix typo in docstring for Overlap - - - - - 80f9133e by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix docstring for Bytes It seems like a commented out section of code was accidentally included in the docstring for a field. - - - - - 54774268 by Matthew Pickering at 2022-03-01T16:23:10-05:00 Fix longstanding issue with moduleGraphNodes - no hs-boot files case In the case when we tell moduleGraphNodes to drop hs-boot files the idea is to collapse hs-boot files into their hs file nodes. In the old code * nodeDependencies changed edges from IsBoot to NonBoot * moduleGraphNodes just dropped boot file nodes The net result is that any dependencies of the hs-boot files themselves were dropped. The correct thing to do is * nodeDependencies changes edges from IsBoot to NonBoot * moduleGraphNodes merges dependencies of IsBoot and NonBoot nodes. The result is a properly quotiented dependency graph which contains no hs-boot files nor hs-boot file edges. Why this didn't cause endless issues when compiling with boot files, we will never know. - - - - - c84dc506 by Matthew Pickering at 2022-03-01T16:23:10-05:00 driver: Properly add an edge between a .hs and its hs-boot file As noted in #21071 we were missing adding this edge so there were situations where the .hs file would get compiled before the .hs-boot file which leads to issues with -j. I fixed this properly by adding the edge in downsweep so the definition of nodeDependencies can be simplified to avoid adding this dummy edge in. There are plenty of tests which seem to have these redundant boot files anyway so no new test. #21094 tracks the more general issue of identifying redundant hs-boot and SOURCE imports. - - - - - 7aeb6d29 by sheaf at 2022-03-01T16:23:51-05:00 Core Lint: collect args through floatable ticks We were not looking through floatable ticks when collecting arguments in Core Lint, which caused `checkCanEtaExpand` to fail on something like: ```haskell reallyUnsafePtrEquality = \ @a -> (src<loc> reallyUnsafePtrEquality#) @Lifted @a @Lifted @a ``` We fix this by using `collectArgsTicks tickishFloatable` instead of `collectArgs`, to be consistent with the behaviour of eta expansion outlined in Note [Eta expansion and source notes] in GHC.Core.Opt.Arity. Fixes #21152. - - - - - 75caafaa by Matthew Pickering at 2022-03-02T01:14:59-05:00 Ticky profiling improvements. This adds a number of changes to ticky-ticky profiling. When an executable is profiled with IPE profiling it's now possible to associate id-related ticky counters to their source location. This works by emitting the info table address as part of the counter which can be looked up in the IPE table. Add a `-ticky-ap-thunk` flag. This flag prevents the use of some standard thunks which are precompiled into the RTS. This means reduced cache locality and increased code size. But it allows better attribution of execution cost to specific source locations instead of simple attributing it to the standard thunk. ticky-ticky now uses the `arg` field to emit additional information about counters in json format. When ticky-ticky is used in combination with the eventlog eventlog2html can be used to generate a html table from the eventlog similar to the old text output for ticky-ticky. - - - - - aeea6bd5 by doyougnu at 2022-03-02T01:15:39-05:00 StgToCmm.cgTopBinding: no isNCG, use binBlobThresh This is a one line change. It is a fixup from MR!7325, was pointed out in review of MR!7442, specifically: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7442#note_406581 The change removes isNCG check from cgTopBinding. Instead it changes the type of binBlobThresh in DynFlags from Word to Maybe Word, where a Just 0 or a Nothing indicates an infinite threshold and thus the disable CmmFileEmbed case in the original check. This improves the cohesion of the module because more NCG related Backend stuff is moved into, and checked in, StgToCmm.Config. Note, that the meaning of a Just 0 or a Nothing in binBlobThresh is indicated in a comment next to its field in GHC.StgToCmm.Config. DynFlags: binBlobThresh: Word -> Maybe Word StgToCmm.Config: binBlobThesh add not ncg check DynFlags.binBlob: move Just 0 check to dflags init StgToCmm.binBlob: only check isNCG, Just 0 check to dflags StgToCmm.Config: strictify binBlobThresh - - - - - b27b2af3 by sheaf at 2022-03-02T14:08:36-05:00 Introduce ConcreteTv metavariables This patch introduces a new kind of metavariable, by adding the constructor `ConcreteTv` to `MetaInfo`. A metavariable with `ConcreteTv` `MetaInfo`, henceforth a concrete metavariable, can only be unified with a type that is concrete (that is, a type that answers `True` to `GHC.Core.Type.isConcrete`). This solves the problem of dangling metavariables in `Concrete#` constraints: instead of emitting `Concrete# ty`, which contains a secret existential metavariable, we simply emit a primitive equality constraint `ty ~# concrete_tv` where `concrete_tv` is a fresh concrete metavariable. This means we can avoid all the complexity of canonicalising `Concrete#` constraints, as we can just re-use the existing machinery for `~#`. To finish things up, this patch then removes the `Concrete#` special predicate, and instead introduces the special predicate `IsRefl#` which enforces that a coercion is reflexive. Such a constraint is needed because the canonicaliser is quite happy to rewrite an equality constraint such as `ty ~# concrete_tv`, but such a rewriting is not handled by the rest of the compiler currently, as we need to make use of the resulting coercion, as outlined in the FixedRuntimeRep plan. The big upside of this approach (on top of simplifying the code) is that we can now selectively implement PHASE 2 of FixedRuntimeRep, by changing individual calls of `hasFixedRuntimeRep_MustBeRefl` to `hasFixedRuntimeRep` and making use of the obtained coercion. - - - - - 81b7c436 by Matthew Pickering at 2022-03-02T14:09:13-05:00 Make -dannot-lint not panic on let bound type variables After certain simplifier passes we end up with let bound type variables which are immediately inlined in the next pass. The core diff utility implemented by -dannot-lint failed to take these into account and paniced. Progress towards #20965 - - - - - f596c91a by sheaf at 2022-03-02T14:09:51-05:00 Improve out-of-order inferred type variables Don't instantiate type variables for :type in `GHC.Tc.Gen.App.tcInstFun`, to avoid inconsistently instantianting `r1` but not `r2` in the type forall {r1} (a :: TYPE r1) {r2} (b :: TYPE r2). ... This fixes #21088. This patch also changes the primop pretty-printer to ensure that we put all the inferred type variables first. For example, the type of reallyUnsafePtrEquality# is now forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> Int# This means we avoid running into issue #21088 entirely with the types of primops. Users can still write a type signature where the inferred type variables don't come first, however. This change to primops had a knock-on consequence, revealing that we were sometimes performing eta reduction on keepAlive#. This patch updates tryEtaReduce to avoid eta reducing functions with no binding, bringing it in line with tryEtaReducePrep, and thus fixing #21090. - - - - - 1617fed3 by Richard Eisenberg at 2022-03-02T14:10:28-05:00 Make inert_cycle_breakers into a stack. Close #20231. - - - - - c8652a0a by Richard Eisenberg at 2022-03-02T14:11:03-05:00 Make Constraint not *apart* from Type. More details in Note [coreView vs tcView] Close #21092. - - - - - 91a10cb0 by doyougnu at 2022-03-02T14:11:43-05:00 GenStgAlt 3-tuple synonym --> Record type This commit alters GenStgAlt from a type synonym to a Record with field accessors. In pursuit of #21078, this is not a required change but cleans up several areas for nicer code in the upcoming js-backend, and in GHC itself. GenStgAlt: 3-tuple -> record Stg.Utils: GenStgAlt 3-tuple -> record Stg.Stats: StgAlt 3-tuple --> record Stg.InferTags.Rewrite: StgAlt 3-tuple -> record Stg.FVs: GenStgAlt 3-tuple -> record Stg.CSE: GenStgAlt 3-tuple -> record Stg.InferTags: GenStgAlt 3-tuple --> record Stg.Debug: GenStgAlt 3-tuple --> record Stg.Lift.Analysis: GenStgAlt 3-tuple --> record Stg.Lift: GenStgAlt 3-tuple --> record ByteCode.Instr: GenStgAlt 3-tuple --> record Stg.Syntax: add GenStgAlt helper functions Stg.Unarise: GenStgAlt 3-tuple --> record Stg.BcPrep: GenStgAlt 3-tuple --> record CoreToStg: GenStgAlt 3-tuple --> record StgToCmm.Expr: GenStgAlt 3-tuple --> record StgToCmm.Bind: GenStgAlt 3-tuple --> record StgToByteCode: GenStgAlt 3-tuple --> record Stg.Lint: GenStgAlt 3-tuple --> record Stg.Syntax: strictify GenStgAlt GenStgAlt: add haddock, some cleanup fixup: remove calls to pure, single ViewPattern StgToByteCode: use case over viewpatterns - - - - - 73864f00 by Matthew Pickering at 2022-03-02T14:12:19-05:00 base: Remove default method from bitraversable The default instance leads to an infinite loop. bisequenceA is defined in terms of bisquence which is defined in terms of bitraverse. ``` bitraverse f g = (defn of bitraverse) bisequenceA . bimap f g = (defn of bisequenceA) bitraverse id id . bimap f g = (defn of bitraverse) ... ``` Any instances defined without an explicitly implementation are currently broken, therefore removing it will alert users to an issue in their code. CLC issue: https://github.com/haskell/core-libraries-committee/issues/47 Fixes #20329 #18901 - - - - - 9579bf35 by Matthew Pickering at 2022-03-02T14:12:54-05:00 ci: Add check to CI to ensure compiler uses correct BIGNUM_BACKEND - - - - - c48a7c3a by Sylvain Henry at 2022-03-03T07:37:12-05:00 Use Word64# primops in Word64 Num instance Taken froù!3658 - - - - - ce65d0cc by Matthew Pickering at 2022-03-03T07:37:48-05:00 hadrian: Correctly set whether we have a debug compiler when running tests For example, running the `slow-validate` flavour would incorrectly run the T16135 test which would fail with an assertion error, despite the fact that is should be skipped when we have a debug compiler. - - - - - e0c3e757 by Matthew Pickering at 2022-03-03T13:48:41-05:00 docs: Add note to unsafeCoerce function that you might want to use coerce [skip ci] Fixes #15429 - - - - - 559d4cf3 by Matthew Pickering at 2022-03-03T13:49:17-05:00 docs: Add note to RULES documentation about locally bound variables [skip ci] Fixes #20100 - - - - - c534b3dd by Matthew Pickering at 2022-03-03T13:49:53-05:00 Replace ad-hoc CPP with constant from GHC.Utils.Constant Fixes #21154 - - - - - de56cc7e by Krzysztof Gogolewski at 2022-03-04T12:44:26-05:00 Update documentation of LiberalTypeSynonyms We no longer require LiberalTypeSynonyms to use 'forall' or an unboxed tuple in a synonym. I also removed that kind checking before expanding synonyms "could be changed". This was true when type synonyms were thought of macros, but with the extensions such as SAKS or matchability I don't see it changing. - - - - - c0a39259 by Simon Jakobi at 2022-03-04T12:45:01-05:00 base: Mark GHC.Bits not-home for haddock Most (all) of the exports are re-exported from the preferable Data.Bits. - - - - - 3570eda5 by Sylvain Henry at 2022-03-04T12:45:42-05:00 Fix comments about Int64/Word64 primops - - - - - 6f84ee33 by Artem Pelenitsyn at 2022-03-05T01:06:47-05:00 remove MonadFail instances of ST CLC proposal: https://github.com/haskell/core-libraries-committee/issues/33 The instances had `fail` implemented in terms of `error`, whereas the idea of the `MonadFail` class is that the `fail` method should be implemented in terms of the monad itself. - - - - - 584cd5ae by sheaf at 2022-03-05T01:07:25-05:00 Don't allow Float#/Double# literal patterns This patch does the following two things: 1. Fix the check in Core Lint to properly throw an error when it comes across Float#/Double# literal patterns. The check was incorrect before, because it expected the type to be Float/Double instead of Float#/Double#. 2. Add an error in the parser when the user writes a floating-point literal pattern such as `case x of { 2.0## -> ... }`. Fixes #21115 - - - - - 706deee0 by Greg Steuck at 2022-03-05T17:44:10-08:00 Make T20214 terminate promptly be setting input to /dev/null It was hanging and timing out on OpenBSD before. - - - - - 14e90098 by Simon Peyton Jones at 2022-03-07T14:05:41-05:00 Always generalise top-level bindings Fix #21023 by always generalising top-level binding; change the documentation of -XMonoLocalBinds to match. - - - - - c9c31c3c by Matthew Pickering at 2022-03-07T14:06:16-05:00 hadrian: Add little flavour transformer to build stage2 with assertions This can be useful to build a `perf+assertions` build or even better `default+no_profiled_libs+omit_pragmas+assertions`. - - - - - 89c14a6c by Matthew Pickering at 2022-03-07T14:06:16-05:00 ci: Convert all deb10 make jobs into hadrian jobs This is the first step in converting all the CI configs to use hadrian rather than make. (#21129) The metrics increase due to hadrian using --hyperlinked-source for haddock builds. (See #21156) ------------------------- Metric Increase: haddock.Cabal haddock.base haddock.compiler ------------------------- - - - - - 7bfae2ee by Matthew Pickering at 2022-03-07T14:06:16-05:00 Replace use of BIN_DIST_PREP_TAR_COMP with BIN_DIST_NAME And adds a check to make sure we are not accidently settings BIN_DIST_PREP_TAR_COMP when using hadrian. - - - - - 5b35ca58 by Matthew Pickering at 2022-03-07T14:06:16-05:00 Fix gen_contents_index logic for hadrian bindist - - - - - 273bc133 by Krzysztof Gogolewski at 2022-03-07T14:06:52-05:00 Fix reporting constraints in pprTcSolverReportMsg 'no_instance_msg' and 'no_deduce_msg' were omitting the first wanted. - - - - - 5874a30a by Simon Jakobi at 2022-03-07T14:07:28-05:00 Improve setBit for Natural Previously the default definition was used, which involved allocating intermediate Natural values. Fixes #21173. - - - - - 7a02aeb8 by Matthew Pickering at 2022-03-07T14:08:03-05:00 Remove leftover trace in testsuite - - - - - 6ce6c250 by Andreas Klebinger at 2022-03-07T23:48:56-05:00 Expand and improve the Note [Strict Worker Ids]. I've added an explicit mention of the invariants surrounding those. As well as adding more direct cross references to the Strict Field Invariant. - - - - - d0f892fe by Ryan Scott at 2022-03-07T23:49:32-05:00 Delete GenericKind_ in favor of GenericKind_DC When deriving a `Generic1` instance, we need to know what the last type variable of a data type is. Previously, there were two mechanisms to determine this information: * `GenericKind_`, where `Gen1_` stored the last type variable of a data type constructor (i.e., the `tyConTyVars`). * `GenericKind_DC`, where `Gen1_DC` stored the last universally quantified type variable in a data constructor (i.e., the `dataConUnivTyVars`). These had different use cases, as `GenericKind_` was used for generating `Rep(1)` instances, while `GenericKind_DC` was used for generating `from(1)` and `to(1)` implementations. This was already a bit confusing, but things went from confusing to outright wrong after !6976. This is because after !6976, the `deriving` machinery stopped using `tyConTyVars` in favor of `dataConUnivTyVars`. Well, everywhere with the sole exception of `GenericKind_`, which still continued to use `tyConTyVars`. This lead to disaster when deriving a `Generic1` instance for a GADT family instance, as the `tyConTyVars` do not match the `dataConUnivTyVars`. (See #21185.) The fix is to stop using `GenericKind_` and replace it with `GenericKind_DC`. For the most part, this proves relatively straightforward. Some highlights: * The `forgetArgVar` function was deleted entirely, as it no longer proved necessary after `GenericKind_`'s demise. * The substitution that maps from the last type variable to `Any` (see `Note [Generating a correctly typed Rep instance]`) had to be moved from `tc_mkRepTy` to `tc_mkRepFamInsts`, as `tc_mkRepTy` no longer has access to the last type variable. Fixes #21185. - - - - - a60ddffd by Matthew Pickering at 2022-03-08T22:51:37+00:00 Move bootstrap and cabal-reinstall test jobs to nightly CI is creaking under the pressure of too many jobs so attempt to reduce the strain by removing a couple of jobs. - - - - - 7abe3288 by Matthew Pickering at 2022-03-09T10:24:15+00:00 Add 10 minute timeout to linters job - - - - - 3cf75ede by Matthew Pickering at 2022-03-09T10:24:16+00:00 Revert "hadrian: Correctly set whether we have a debug compiler when running tests" Needing the arguments for "GHC/Utils/Constant.hs" implies a dependency on the previous stage compiler. Whilst we work out how to get around this I will just revert this commit (as it only affects running the testsuite in debug way). This reverts commit ce65d0cceda4a028f30deafa3c39d40a250acc6a. - - - - - 18b9ba56 by Matthew Pickering at 2022-03-09T11:07:23+00:00 ci: Fix save_cache function Each interation of saving the cache would copy the whole `cabal` store into a subfolder in the CACHE_DIR rather than copying the contents of the cabal store into the cache dir. This resulted in a cache which looked like: ``` /builds/ghc/ghc/cabal-cache/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/ ``` So it would get one layer deeper every CI run and take longer and longer to compress. - - - - - bc684dfb by Ben Gamari at 2022-03-10T03:20:07-05:00 mr-template: Mention timeframe for review - - - - - 7f5f4ede by Vladislav Zavialov at 2022-03-10T03:20:43-05:00 Bump submodules: containers, exceptions GHC Proposal #371 requires TypeOperators to use type equality a~b. This submodule update pulls in the appropriate forward-compatibility changes in 'libraries/containers' and 'libraries/exceptions' - - - - - 8532b8a9 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Add an inline pragma to lookupVarEnv The containers bump reduced the size of the Data.IntMap.Internal.lookup function so that it no longer experienced W/W. This means that the size of lookupVarEnv increased over the inlining threshold and it wasn't inlined into the hot code path in substTyVar. See containers#821, #21159 and !7638 for some more explanation. ------------------------- Metric Decrease: LargeRecord T12227 T13386 T15703 T18223 T5030 T8095 T9872a T9872b T9872c TcPlugin_RewritePerf ------------------------- - - - - - 844cf1e1 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Normalise output of T10970 test The output of this test changes each time the containers submodule version updates. It's easier to apply the version normaliser so that the test checks that there is a version number, but not which one it is. - - - - - 24b6af26 by Ryan Scott at 2022-03-11T19:56:28-05:00 Refactor tcDeriving to generate tyfam insts before any bindings Previously, there was an awful hack in `genInst` (now called `genInstBinds` after this patch) where we had to return a continutation rather than directly returning the bindings for a derived instance. This was done for staging purposes, as we had to first infer the instance contexts for derived instances and then feed these contexts into the continuations to ensure the generated instance bindings had accurate instance contexts. `Note [Staging of tcDeriving]` in `GHC.Tc.Deriving` described this confusing state of affairs. The root cause of this confusing design was the fact that `genInst` was trying to generate instance bindings and associated type family instances for derived instances simultaneously. This really isn't possible, however: as `Note [Staging of tcDeriving]` explains, one needs to have access to the associated type family instances before one can properly infer the instance contexts for derived instances. The use of continuation-returning style was an attempt to circumvent this dependency, but it did so in an awkward way. This patch detangles this awkwardness by splitting up `genInst` into two functions: `genFamInsts` (for associated type family instances) and `genInstBinds` (for instance bindings). Now, the `tcDeriving` function calls `genFamInsts` and brings all the family instances into scope before calling `genInstBinds`. This removes the need for the awkward continuation-returning style seen in the previous version of `genInst`, making the code easier to understand. There are some knock-on changes as well: 1. `hasStockDeriving` now needs to return two separate functions: one that describes how to generate family instances for a stock-derived instance, and another that describes how to generate the instance bindings. I factored out this pattern into a new `StockGenFns` data type. 2. While documenting `StockGenFns`, I realized that there was some inconsistency regarding which `StockGenFns` functions needed which arguments. In particular, the function in `GHC.Tc.Deriv.Generics` which generates `Rep(1)` instances did not take a `SrcSpan` like other `gen_*` functions did, and it included an extra `[Type]` argument that was entirely redundant. As a consequence, I refactored the code in `GHC.Tc.Deriv.Generics` to more closely resemble other `gen_*` functions. A happy result of all this is that all `StockGenFns` functions now take exactly the same arguments, which makes everything more uniform. This is purely a refactoring that should not have any effect on user-observable behavior. The new design paves the way for an eventual fix for #20719. - - - - - 62caaa9b by Ben Gamari at 2022-03-11T19:57:03-05:00 gitlab-ci: Use the linters image in hlint job As the `hlint` executable is only available in the linters image. Fixes #21146. - - - - - 4abd7eb0 by Matthew Pickering at 2022-03-11T19:57:38-05:00 Remove partOfGhci check in the loader This special logic has been part of GHC ever since template haskell was introduced in 9af77fa423926fbda946b31e174173d0ec5ebac8. It's hard to believe in any case that this special logic pays its way at all. Given * The list is out-of-date, which has potential to lead to miscompilation when using "editline", which was removed in 2010 (46aed8a4). * The performance benefit seems negligable as each load only happens once anyway and packages specified by package flags are preloaded into the linker state at the start of compilation. Therefore we just remove this logic. Fixes #19791 - - - - - c40cbaa2 by Andreas Klebinger at 2022-03-11T19:58:14-05:00 Improve -dtag-inference-checks checks. FUN closures don't get tagged when evaluated. So no point in checking their tags. - - - - - ab00d23b by Simon Jakobi at 2022-03-11T19:58:49-05:00 Improve clearBit and complementBit for Natural Also optimize bigNatComplementBit#. Fixes #21175, #21181, #21194. - - - - - a6d8facb by Sebastian Graf at 2022-03-11T19:59:24-05:00 gitignore all (build) directories headed by _ - - - - - 524795fe by Sebastian Graf at 2022-03-11T19:59:24-05:00 Demand: Document why we need three additional equations of multSubDmd - - - - - 6bdcd557 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make 64-bit word splitting for 32-bit targets respect target endianness This used to been broken for little-endian targets. - - - - - 9e67c69e by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix Double# literal payload for 32-bit targets Contrary to the legacy comment, the splitting didn't happen and we ended up with a single StgWord64 literal in the output code! Let's just do the splitting here. - - - - - 1eee2e28 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: use __builtin versions of memcpyish functions to fix type mismatch Our memcpyish primop's type signatures doesn't match the C type signatures. It's not a problem for typical archs, since their C ABI permits dropping the result, but it doesn't work for wasm. The previous logic would cast the memcpyish function pointer to an incorrect type and perform an indirect call, which results in a runtime trap on wasm. The most straightforward fix is: don't emit EFF_ for memcpyish functions. Since we don't want to include extra headers in .hc to bring in their prototypes, we can just use the __builtin versions. - - - - - 9d8d4837 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: emit __builtin_unreachable() when CmmSwitch doesn't contain fallback case Otherwise the C compiler may complain "warning: non-void function does not return a value in all control paths [-Wreturn-type]". - - - - - 27da5540 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make floatToWord32/doubleToWord64 faster Use castFloatToWord32/castDoubleToWord64 in base to perform the reinterpret cast. - - - - - c98e8332 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix -Wunused-value warning in ASSIGN_BaseReg When ASSIGN_BaseReg is a no-op, we shouldn't generate any C code, otherwise C compiler complains a bunch of -Wunused-value warnings when doing unregisterised codegen. - - - - - 5932247c by Ben Gamari at 2022-03-11T20:00:36-05:00 users guide: Eliminate spurious \spxentry mentions We were failing to pass the style file to `makeindex`, as is done by the mklatex configuration generated by Sphinx. Fixes #20913. - - - - - e40cf4ef by Simon Jakobi at 2022-03-11T20:01:11-05:00 ghc-bignum: Tweak integerOr The result of ORing two BigNats is always greater or equal to the larger of the two. Therefore it is safe to skip the magnitude checks of integerFromBigNat#. - - - - - cf081476 by Vladislav Zavialov at 2022-03-12T07:02:40-05:00 checkUnboxedLitPat: use non-fatal addError This enables GHC to report more parse errors in a single pass. - - - - - 7fe07143 by Andreas Klebinger at 2022-03-12T07:03:16-05:00 Rename -fprof-late-ccs to -fprof-late - - - - - 88a94541 by Sylvain Henry at 2022-03-12T07:03:56-05:00 Hadrian: avoid useless allocations in trackArgument Cf ticky report before the change: Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 696987 29044128 0 1 L main:Target.trackArgument_go5{v r24kY} (fun) - - - - - 2509d676 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: avoid allocating in stageString (#19209) - - - - - c062fac0 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: remove useless imports Added for no reason in 7ce1b694f7be7fbf6e2d7b7eb0639e61fbe358c6 - - - - - c82fb934 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: avoid allocations in WayUnit's Read instance (#19209) - - - - - ed04aed2 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: use IntSet Binary instance for Way (#19209) - - - - - ad835531 by Simon Peyton Jones at 2022-03-13T18:12:12-04:00 Fix bug in weak loop-breakers in OccurAnal Note [Weak loop breakers] explains why we need to track variables free in RHS of rules. But we need to do this for /inactive/ rules as well as active ones, unlike the rhs_fv_env stuff. So we now have two fields in node Details, one for free vars of active rules, and one for free vars of all rules. This was shown up by #20820, which is now fixed. - - - - - 76b94b72 by Sebastian Graf at 2022-03-13T18:12:48-04:00 Worker/wrapper: Preserve float barriers (#21150) Issue #21150 shows that worker/wrapper allocated a worker function for a function with multiple calls that said "called at most once" when the first argument was absent. That's bad! This patch makes it so that WW preserves at least one non-one-shot value lambda (see `Note [Preserving float barriers]`) by passing around `void#` in place of absent arguments. Fixes #21150. Since the fix is pretty similar to `Note [Protecting the last value argument]`, I put the logic in `mkWorkerArgs`. There I realised (#21204) that `-ffun-to-thunk` is basically useless with `-ffull-laziness`, so I deprecated the flag, simplified and split into `needsVoidWorkerArg`/`addVoidWorkerArg`. SpecConstr is another client of that API. Fixes #21204. Metric Decrease: T14683 - - - - - 97db789e by romes at 2022-03-14T11:36:39-04:00 Fix up Note [Bind free vars] Move GHC-specific comments from Language.Haskell.Syntax.Binds to GHC.Hs.Binds It looks like the Note was deleted but there were actually two copies of it. L.H.S.B no longer references it, and GHC.Hs.Binds keeps an updated copy. (See #19252) There are other duplicated notes -- they will be fixed in the next commit - - - - - 135888dd by romes at 2022-03-14T11:36:39-04:00 TTG Pull AbsBinds and ABExport out of the main AST AbsBinds and ABExport both depended on the typechecker, and were thus removed from the main AST Expr. CollectPass now has a new function `collectXXHsBindsLR` used for the new HsBinds extension point Bumped haddock submodule to work with AST changes. The removed Notes from Language.Haskell.Syntax.Binds were duplicated (and not referenced) and the copies in GHC.Hs.Binds are kept (and referenced there). (See #19252) - - - - - 106413f0 by sheaf at 2022-03-14T11:37:21-04:00 Add two coercion optimisation perf tests - - - - - 8eadea67 by sheaf at 2022-03-14T15:08:24-04:00 Fix isLiftedType_maybe and handle fallout As #20837 pointed out, `isLiftedType_maybe` returned `Just False` in many situations where it should return `Nothing`, because it didn't take into account type families or type variables. In this patch, we fix this issue. We rename `isLiftedType_maybe` to `typeLevity_maybe`, which now returns a `Levity` instead of a boolean. We now return `Nothing` for types with kinds of the form `TYPE (F a1 ... an)` for a type family `F`, as well as `TYPE (BoxedRep l)` where `l` is a type variable. This fix caused several other problems, as other parts of the compiler were relying on `isLiftedType_maybe` returning a `Just` value, and were now panicking after the above fix. There were two main situations in which panics occurred: 1. Issues involving the let/app invariant. To uphold that invariant, we need to know whether something is lifted or not. If we get an answer of `Nothing` from `isLiftedType_maybe`, then we don't know what to do. As this invariant isn't particularly invariant, we can change the affected functions to not panic, e.g. by behaving the same in the `Just False` case and in the `Nothing` case (meaning: no observable change in behaviour compared to before). 2. Typechecking of data (/newtype) constructor patterns. Some programs involving patterns with unknown representations were accepted, such as T20363. Now that we are stricter, this caused further issues, culminating in Core Lint errors. However, the behaviour was incorrect the whole time; the incorrectness only being revealed by this change, not triggered by it. This patch fixes this by overhauling where the representation polymorphism involving pattern matching are done. Instead of doing it in `tcMatches`, we instead ensure that the `matchExpected` functions such as `matchExpectedFunTys`, `matchActualFunTySigma`, `matchActualFunTysRho` allow return argument pattern types which have a fixed RuntimeRep (as defined in Note [Fixed RuntimeRep]). This ensures that the pattern matching code only ever handles types with a known runtime representation. One exception was that patterns with an unknown representation type could sneak in via `tcConPat`, which points to a missing representation-polymorphism check, which this patch now adds. This means that we now reject the program in #20363, at least until we implement PHASE 2 of FixedRuntimeRep (allowing type families in RuntimeRep positions). The aforementioned refactoring, in which checks have been moved to `matchExpected` functions, is a first step in implementing PHASE 2 for patterns. Fixes #20837 - - - - - 8ff32124 by Sebastian Graf at 2022-03-14T15:09:01-04:00 DmdAnal: Don't unbox recursive data types (#11545) As `Note [Demand analysis for recursive data constructors]` describes, we now refrain from unboxing recursive data type arguments, for two reasons: 1. Relating to run/alloc perf: Similar to `Note [CPR for recursive data constructors]`, it seldomly improves run/alloc performance if we just unbox a finite number of layers of a potentially huge data structure. 2. Relating to ghc/alloc perf: Inductive definitions on single-product recursive data types like the one in T11545 will (diverge, and) have very deep demand signatures before any other abortion mechanism in Demand analysis is triggered. That leads to great and unnecessary churn on Demand analysis when ultimately we will never make use of any nested strictness information anyway. Conclusion: Discard nested demand and boxity information on such recursive types with the help of `Note [Detecting recursive data constructors]`. I also implemented `GHC.Types.Unique.MemoFun.memoiseUniqueFun` in order to avoid the overhead of repeated calls to `GHC.Core.Opt.WorkWrap.Utils.isRecDataCon`. It's nice and simple and guards against some smaller regressions in T9233 and T16577. ghc/alloc performance-wise, this patch is a very clear win: Test Metric value New value Change --------------------------------------------------------------------------------------- LargeRecord(normal) ghc/alloc 6,141,071,720 6,099,871,216 -0.7% MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,740,973,040 2,705,146,640 -1.3% T11545(normal) ghc/alloc 945,475,492 85,768,928 -90.9% GOOD T13056(optasm) ghc/alloc 370,245,880 326,980,632 -11.7% GOOD T18304(normal) ghc/alloc 90,933,944 76,998,064 -15.3% GOOD T9872a(normal) ghc/alloc 1,800,576,840 1,792,348,760 -0.5% T9872b(normal) ghc/alloc 2,086,492,432 2,073,991,848 -0.6% T9872c(normal) ghc/alloc 1,750,491,240 1,737,797,832 -0.7% TcPlugin_RewritePerf(normal) ghc/alloc 2,286,813,400 2,270,957,896 -0.7% geo. mean -2.9% No noteworthy change in run/alloc either. NoFib results show slight wins, too: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- constraints -1.9% -1.4% fasta -3.6% -2.7% reverse-complem -0.3% -0.9% treejoin -0.0% -0.3% -------------------------------------------------------------------------------- Min -3.6% -2.7% Max +0.1% +0.1% Geometric Mean -0.1% -0.1% Metric Decrease: T11545 T13056 T18304 - - - - - ab618309 by Vladislav Zavialov at 2022-03-15T18:34:38+03:00 Export (~) from Data.Type.Equality (#18862) * Users can define their own (~) type operator * Haddock can display documentation for the built-in (~) * New transitional warnings implemented: -Wtype-equality-out-of-scope -Wtype-equality-requires-operators Updates the haddock submodule. - - - - - 577135bf by Aaron Allen at 2022-03-16T02:27:48-04:00 Convert Diagnostics in GHC.Tc.Gen.Foreign Converts all uses of 'TcRnUnknownMessage' to proper diagnostics. - - - - - c1fed9da by Aaron Allen at 2022-03-16T02:27:48-04:00 Suggest FFI extensions as hints (#20116) - Use extension suggestion hints instead of suggesting extensions in the error message body for several FFI errors. - Adds a test case for `TcRnForeignImportPrimExtNotSet` - - - - - a33d1045 by Zubin Duggal at 2022-03-16T02:28:24-04:00 TH: allow negative patterns in quotes (#20711) We still don't allow negative overloaded patterns. Earler all negative patterns were treated as negative overloaded patterns. Now, we expliclty check the extension field to see if the pattern is actually a negative overloaded pattern - - - - - 1575c4a5 by Sebastian Graf at 2022-03-16T02:29:03-04:00 Demand: Let `Boxed` win in `lubBoxity` (#21119) Previously, we let `Unboxed` win in `lubBoxity`, which is unsoundly optimistic in terms ob Boxity analysis. "Unsoundly" in the sense that we sometimes unbox parameters that we better shouldn't unbox. Examples are #18907 and T19871.absent. Until now, we thought that this hack pulled its weight becuase it worked around some shortcomings of the phase separation between Boxity analysis and CPR analysis. But it is a gross hack which caused regressions itself that needed all kinds of fixes and workarounds. See for example #20767. It became impossible to work with in !7599, so I want to remove it. For example, at the moment, `lubDmd B dmd` will not unbox `dmd`, but `lubDmd A dmd` will. Given that `B` is supposed to be the bottom element of the lattice, it's hardly justifiable to get a better demand when `lub`bing with `A`. The consequence of letting `Boxed` win in `lubBoxity` is that we *would* regress #2387, #16040 and parts of #5075 and T19871.sumIO, until Boxity and CPR are able to communicate better. Fortunately, that is not the case since I could tweak the other source of optimism in Boxity analysis that is described in `Note [Unboxed demand on function bodies returning small products]` so that we *recursively* assume unboxed demands on function bodies returning small products. See the updated Note. `Note [Boxity for bottoming functions]` describes why we need bottoming functions to have signatures that say that they deeply unbox their arguments. In so doing, I had to tweak `finaliseArgBoxities` so that it will never unbox recursive data constructors. This is in line with our handling of them in CPR. I updated `Note [Which types are unboxed?]` to reflect that. In turn we fix #21119, #20767, #18907, T19871.absent and get a much simpler implementation (at least to think about). We can also drop the very ad-hoc definition of `deferAfterPreciseException` and its Note in favor of the simple, intuitive definition we used to have. Metric Decrease: T16875 T18223 T18698a T18698b hard_hole_fits Metric Increase: LargeRecord MultiComponentModulesRecomp T15703 T8095 T9872d Out of all the regresions, only the one in T9872d doesn't vanish in a perf build, where the compiler is bootstrapped with -O2 and thus SpecConstr. Reason for regressions: * T9872d is due to `ty_co_subst` taking its `LiftingContext` boxed. That is because the context is passed to a function argument, for example in `liftCoSubstTyVarBndrUsing`. * In T15703, LargeRecord and T8095, we get a bit more allocations in `expand_syn` and `piResultTys`, because a `TCvSubst` isn't unboxed. In both cases that guards against reboxing in some code paths. * The same is true for MultiComponentModulesRecomp, where we get less unboxing in `GHC.Unit.Finder.$wfindInstalledHomeModule`. In a perf build, allocations actually *improve* by over 4%! Results on NoFib: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- awards -0.4% +0.3% cacheprof -0.3% +2.4% fft -1.5% -5.1% fibheaps +1.2% +0.8% fluid -0.3% -0.1% ida +0.4% +0.9% k-nucleotide +0.4% -0.1% last-piece +10.5% +13.9% lift -4.4% +3.5% mandel2 -99.7% -99.8% mate -0.4% +3.6% parser -1.0% +0.1% puzzle -11.6% +6.5% reverse-complem -3.0% +2.0% scs -0.5% +0.1% sphere -0.4% -0.2% wave4main -8.2% -0.3% -------------------------------------------------------------------------------- Summary excludes mandel2 because of excessive bias Min -11.6% -5.1% Max +10.5% +13.9% Geometric Mean -0.2% +0.3% -------------------------------------------------------------------------------- Not bad for a bug fix. The regression in `last-piece` could become a win if SpecConstr would work on non-recursive functions. The regression in `fibheaps` is due to `Note [Reboxed crud for bottoming calls]`, e.g., #21128. - - - - - bb779b90 by sheaf at 2022-03-16T02:29:42-04:00 Add a regression test for #21130 This problem was due to a bug in cloneWanted, which was incorrectly creating a coercion hole to hold an evidence variable. This bug was introduced by 8bb52d91 and fixed in 81740ce8. Fixes #21130 - - - - - 0f0e2394 by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Initial Windows C++ exception unwinding support - - - - - 36d20d4d by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Fix ADDR32NB relocations on Windows - - - - - 8a516527 by Tamar Christina at 2022-03-17T10:16:37-04:00 testsuite: properly escape string paths - - - - - 1a0dd008 by sheaf at 2022-03-17T10:17:13-04:00 Hadrian: account for change in late-ccs flag The late cost centre flag was renamed from -fprof-late-ccs to -fprof-late in 7fe07143, but this change hadn't been propagated to Hadrian. - - - - - 8561c1af by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor HsBracket - - - - - 19163397 by romes at 2022-03-18T05:10:58-04:00 Type-checking untyped brackets When HsExpr GhcTc, the HsBracket constructor should hold a HsBracket GhcRn, rather than an HsBracket GhcTc. We make use of the HsBracket p extension constructor (XBracket (XXBracket p)) to hold an HsBracket GhcRn when the pass is GhcTc See !4782 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - 310890a5 by romes at 2022-03-18T05:10:58-04:00 Separate constructors for typed and untyped brackets Split HsBracket into HsTypedBracket and HsUntypedBracket. Unfortunately, we still cannot get rid of instance XXTypedBracket GhcTc = HsTypedBracket GhcRn despite no longer requiring it for typechecking, but rather because the TH desugarer works on GhcRn rather than GhcTc (See GHC.HsToCore.Quote) - - - - - 4a2567f5 by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor bracket for desugaring during tc When desugaring a bracket we want to desugar /renamed/ rather than /typechecked/ code; So in (HsExpr GhcTc) tree, we must have a (HsExpr GhcRn) for the quotation itself. This commit reworks the TTG refactor on typed and untyped brackets by storing the /renamed/ code in the bracket field extension rather than in the constructor extension in `HsQuote` (previously called `HsUntypedBracket`) See Note [The life cycle of a TH quotation] and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - b056adc8 by romes at 2022-03-18T05:10:58-04:00 TTG: Make HsQuote GhcTc isomorphic to NoExtField An untyped bracket `HsQuote p` can never be constructed with `p ~ GhcTc`. This is because we don't typecheck `HsQuote` at all. That's OK, because we also never use `HsQuote GhcTc`. To enforce this at the type level we make `HsQuote GhcTc` isomorphic to `NoExtField` and impossible to construct otherwise, by using TTG field extensions to make all constructors, except for `XQuote` (which takes `NoExtField`), unconstructable, with `DataConCantHappen` This is explained more in detail in Note [The life cycle of a TH quotation] Related discussion: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - ac3b2e7d by romes at 2022-03-18T05:10:58-04:00 TTG: TH brackets finishing touches Rewrite the critical notes and fix outdated ones, use `HsQuote GhcRn` (in `HsBracketTc`) for desugaring regardless of the bracket being typed or untyped, remove unused `EpAnn` from `Hs*Bracket GhcRn`, zonkExpr factor out common brackets code, ppr_expr factor out common brackets code, and fix tests, to finish MR https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782. ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - d147428a by Ben Gamari at 2022-03-18T05:11:35-04:00 codeGen: Fix signedness of jump table indexing Previously while constructing the jump table index we would zero-extend the discriminant before subtracting the start of the jump-table. This goes subtly wrong in the case of a sub-word, signed discriminant, as described in the included Note. Fix this in both the PPC and X86 NCGs. Fixes #21186. - - - - - 435a3d5d by Ben Gamari at 2022-03-18T05:11:35-04:00 testsuite: Add test for #21186 - - - - - e9d8de93 by Zubin Duggal at 2022-03-19T07:35:49-04:00 TH: Fix pretty printing of newtypes with operators and GADT syntax (#20868) The pretty printer for regular data types already accounted for these, and had some duplication with the newtype pretty printer. Factoring the logic out into a common function and using it for both newtypes and data declarations is enough to fix the bug. - - - - - 244da9eb by sheaf at 2022-03-19T07:36:24-04:00 List GHC.Event.Internal in base.cabal on Windows GHC.Event.Internal was not listed in base.cabal on Windows. This caused undefined reference errors. This patch adds it back, by moving it out of the OS-specific logic in base.cabal. Fixes #21245. - - - - - d1c03719 by Andreas Klebinger at 2022-03-19T07:37:00-04:00 Compact regions: Maintain tags properly Fixes #21251 - - - - - d45bb701 by romes at 2022-03-19T07:37:36-04:00 Remove dead code HsDoRn - - - - - c842611f by nineonine at 2022-03-20T21:16:06-04:00 Revamp derived Eq instance code generation (#17240) This patch improves code generation for derived Eq instances. The idea is to use 'dataToTag' to evaluate both arguments. This allows to 'short-circuit' when tags do not match. Unfortunately, inner evals are still present when we branch on tags. This is due to the way 'dataToTag#' primop evaluates its argument in the code generator. #21207 was created to explore further optimizations. Metric Decrease: LargeRecord - - - - - 52ffd38c by Sylvain Henry at 2022-03-20T21:16:46-04:00 Avoid some SOURCE imports - - - - - b91798be by Zubin Duggal at 2022-03-23T13:39:39-04:00 hi haddock: Lex and store haddock docs in interface files Names appearing in Haddock docstrings are lexed and renamed like any other names appearing in the AST. We currently rename names irrespective of the namespace, so both type and constructor names corresponding to an identifier will appear in the docstring. Haddock will select a given name as the link destination based on its own heuristics. This patch also restricts the limitation of `-haddock` being incompatible with `Opt_KeepRawTokenStream`. The export and documenation structure is now computed in GHC and serialised in .hi files. This can be used by haddock to directly generate doc pages without reparsing or renaming the source. At the moment the operation of haddock is not modified, that's left to a future patch. Updates the haddock submodule with the minimum changes needed. - - - - - 78db231f by Cheng Shao at 2022-03-23T13:40:17-04:00 configure: bump LlvmMaxVersion to 14 LLVM 13.0.0 is released in Oct 2021, and latest head validates against LLVM 13 just fine if LlvmMaxVersion is bumped. - - - - - b06e5dd8 by Adam Sandberg Ericsson at 2022-03-23T13:40:54-04:00 docs: clarify the eventlog format documentation a little bit - - - - - 4dc62498 by Matthew Pickering at 2022-03-23T13:41:31-04:00 Fix behaviour of -Wunused-packages in ghci Ticket #21110 points out that -Wunused-packages behaves a bit unusually in GHCi. Now we define the semantics for -Wunused-packages in interactive mode as follows: * If you use -Wunused-packages on an initial load then the warning is reported. * If you explicitly set -Wunused-packages on the command line then the warning is displayed (until it is disabled) * If you then subsequently modify the set of available targets by using :load or :cd (:cd unloads everything) then the warning is (silently) turned off. This means that every :r the warning is printed if it's turned on (but you did ask for it). Fixes #21110 - - - - - fed05347 by Ben Gamari at 2022-03-23T13:42:07-04:00 rts/adjustor: Place adjustor templates in data section on all OSs In !7604 we started placing adjustor templates in the data section on Linux as some toolchains there reject relocations in the text section. However, it turns out that OpenBSD also exhibits this restriction. Fix this by *always* placing adjustor templates in the data section. Fixes #21155. - - - - - db32bb8c by Zubin Duggal at 2022-03-23T13:42:44-04:00 Improve error message when warning about unsupported LLVM version (#20958) Change the wording to make it clear that the upper bound is non-inclusive. - - - - - f214349a by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Untag function field in scavenge_PAP_payload Previously we failed to untag the function closure when scavenging the payload of a PAP, resulting in an invalid closure pointer being passed to scavenge_large_bitmap and consequently #21254. Fix this. Fixes #21254 - - - - - e6d0e287 by Ben Gamari at 2022-03-23T13:43:20-04:00 rts: Don't mark object code in markCAFs unless necessary Previously `markCAFs` would call `markObjectCode` even in non-major GCs. This is problematic since `prepareUnloadCheck` is not called in such GCs, meaning that the section index has not been updated. Fixes #21254 - - - - - 1a7cf096 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Avoid redundant imports of GHC.Driver.Session Remove GHC.Driver.Session imports that weren't considered as redundant because of the reexport of PlatformConstants. Also remove this reexport as modules using this datatype should import GHC.Platform instead. - - - - - e3f60577 by Sylvain Henry at 2022-03-23T13:44:05-04:00 Reverse dependency between StgToCmm and Runtime.Heap.Layout - - - - - e6585ca1 by Sylvain Henry at 2022-03-23T13:44:46-04:00 Define filterOut with filter filter has fusion rules that filterOut lacks - - - - - c58d008c by Ryan Scott at 2022-03-24T06:10:43-04:00 Fix and simplify DeriveAnyClass's context inference using SubTypePredSpec As explained in `Note [Gathering and simplifying constraints for DeriveAnyClass]` in `GHC.Tc.Deriv.Infer`, `DeriveAnyClass` infers instance contexts by emitting implication constraints. Previously, these implication constraints were constructed by hand. This is a terribly trick thing to get right, as it involves a delicate interplay of skolemisation, metavariable instantiation, and `TcLevel` bumping. Despite much effort, we discovered in #20719 that the implementation was subtly incorrect, leading to valid programs being rejected. While we could scrutinize the code that manually constructs implication constraints and repair it, there is a better, less error-prone way to do things. After all, the heart of `DeriveAnyClass` is generating code which fills in each class method with defaults, e.g., `foo = $gdm_foo`. Typechecking this sort of code is tantamount to calling `tcSubTypeSigma`, as we much ensure that the type of `$gdm_foo` is a subtype of (i.e., more polymorphic than) the type of `foo`. As an added bonus, `tcSubTypeSigma` is a battle-tested function that handles skolemisation, metvariable instantiation, `TcLevel` bumping, and all other means of tricky bookkeeping correctly. With this insight, the solution to the problems uncovered in #20719 is simple: use `tcSubTypeSigma` to check if `$gdm_foo`'s type is a subtype of `foo`'s type. As a side effect, `tcSubTypeSigma` will emit exactly the implication constraint that we were attempting to construct by hand previously. Moreover, it does so correctly, fixing #20719 as a consequence. This patch implements the solution thusly: * The `PredSpec` data type (previously named `PredOrigin`) is now split into `SimplePredSpec`, which directly stores a `PredType`, and `SubTypePredSpec`, which stores the actual and expected types in a subtype check. `SubTypePredSpec` is only used for `DeriveAnyClass`; all other deriving strategies use `SimplePredSpec`. * Because `tcSubTypeSigma` manages the finer details of type variable instantiation and constraint solving under the hood, there is no longer any need to delicately split apart the method type signatures in `inferConstraintsAnyclass`. This greatly simplifies the implementation of `inferConstraintsAnyclass` and obviates the need to store skolems, metavariables, or given constraints in a `ThetaSpec` (previously named `ThetaOrigin`). As a bonus, this means that `ThetaSpec` now simply becomes a synonym for a list of `PredSpec`s, which is conceptually much simpler than it was before. * In `simplifyDeriv`, each `SubTypePredSpec` results in a call to `tcSubTypeSigma`. This is only performed for its side effect of emitting an implication constraint, which is fed to the rest of the constraint solving machinery in `simplifyDeriv`. I have updated `Note [Gathering and simplifying constraints for DeriveAnyClass]` to explain this in more detail. To make the changes in `simplifyDeriv` more manageable, I also performed some auxiliary refactoring: * Previously, every iteration of `simplifyDeriv` was skolemising the type variables at the start, simplifying, and then performing a reverse substitution at the end to un-skolemise the type variables. This is not necessary, however, since we can just as well skolemise once at the beginning of the `deriving` pipeline and zonk the `TcTyVar`s after `simplifyDeriv` is finished. This patch does just that, having been made possible by prior work in !7613. I have updated `Note [Overlap and deriving]` in `GHC.Tc.Deriv.Infer` to explain this, and I have also left comments on the relevant data structures (e.g., `DerivEnv` and `DerivSpec`) to explain when things might be `TcTyVar`s or `TyVar`s. * All of the aforementioned cleanup allowed me to remove an ad hoc deriving-related in `checkImplicationInvariants`, as all of the skolems in a `tcSubTypeSigma`–produced implication constraint should now be `TcTyVar` at the time the implication is created. * Since `simplifyDeriv` now needs a `SkolemInfo` and `UserTypeCtxt`, I have added `ds_skol_info` and `ds_user_ctxt` fields to `DerivSpec` to store these. Similarly, I have also added a `denv_skol_info` field to `DerivEnv`, which ultimately gets used to initialize the `ds_skol_info` in a `DerivSpec`. Fixes #20719. - - - - - 21680fb0 by Sebastian Graf at 2022-03-24T06:11:19-04:00 WorkWrap: Handle partial FUN apps in `isRecDataCon` (#21265) Partial FUN apps like `(->) Bool` aren't detected by `splitFunTy_maybe`. A silly oversight that is easily fixed by replacing `splitFunTy_maybe` with a guard in the `splitTyConApp_maybe` case. But fortunately, Simon nudged me into rewriting the whole `isRecDataCon` function in a way that makes it much shorter and hence clearer which DataCons are actually considered as recursive. Fixes #21265. - - - - - a2937e2b by Matthew Pickering at 2022-03-24T17:13:22-04:00 Add test for T21035 This test checks that you are allowed to explicitly supply object files for dependencies even if you haven't got the shared object for that library yet. Fixes #21035 - - - - - 1756d547 by Matthew Pickering at 2022-03-24T17:13:58-04:00 Add check to ensure we are not building validate jobs for releases - - - - - 99623358 by Matthew Pickering at 2022-03-24T17:13:58-04:00 hadrian: Correct generation of hsc2hs wrapper If you inspect the inside of a wrapper script for hsc2hs you will see that the cflag and lflag values are concatenated incorrectly. ``` HSC2HS_EXTRA="--cflag=-U__i686--lflag=-fuse-ld=gold" ``` It should instead be ``` HSC2HS_EXTRA="--cflag=-U__i686 --lflag=-fuse-ld=gold" ``` Fixes #21221 - - - - - fefd4e31 by Matthew Pickering at 2022-03-24T17:13:59-04:00 testsuite: Remove library dependenices from T21119 These dependencies would affect the demand signature depending on various rules and so on. Fixes #21271 - - - - - 5ff690b8 by Matthew Pickering at 2022-03-24T17:13:59-04:00 ci: Generate jobs for all normal builds and use hadrian for all builds This commit introduces a new script (.gitlab/gen_ci.hs) which generates a yaml file (.gitlab/jobs.yaml) which contains explicit descriptions for all the jobs we want to run. The jobs are separated into three categories: * validate - jobs run on every MR * nightly - jobs run once per day on the master branch * release - jobs for producing release artifacts The generation script is a Haskell program which includes a DSL for specifying the different jobs. The hope is that it's easier to reason about the different jobs and how the variables are merged together rather than the unclear and opaque yaml syntax. The goal is to fix issues like #21190 once and for all.. The `.gitlab/jobs.yaml` can be generated by running the `.gitlab/generate_jobs` script. You have to do this manually. Another consequence of this patch is that we use hadrian for all the validate, nightly and release builds on all platforms. - - - - - 1d673aa2 by Christiaan Baaij at 2022-03-25T11:35:49-04:00 Add the OPAQUE pragma A new pragma, `OPAQUE`, that ensures that every call of a named function annotated with an `OPAQUE` pragma remains a call of that named function, not some name-mangled variant. Implements GHC proposal 0415: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0415-opaque-pragma.rst This commit also updates the haddock submodule to handle the newly introduced lexer tokens corresponding to the OPAQUE pragma. - - - - - 83f5841b by Bodigrim at 2022-03-25T11:36:31-04:00 Add instance Lift ByteArray - - - - - 7cc1184a by Matthew Pickering at 2022-03-25T11:37:07-04:00 Make -ddump-rn-ast and -ddump-tc-ast work in GHCi Fixes #17830 - - - - - 940feaf3 by Sylvain Henry at 2022-03-25T11:37:47-04:00 Modularize Tidy (#17957) - Factorize Tidy options into TidyOpts datatype. Initialize it in GHC.Driver.Config.Tidy - Same thing for StaticPtrOpts - Perform lookups of unpackCString[Utf8]# once in initStaticPtrOpts instead of for every use of mkStringExprWithFS - - - - - 25101813 by Takenobu Tani at 2022-03-28T01:16:02-04:00 users-guide: Correct markdown for profiling This patch corrects some markdown. [skip ci] - - - - - c832ae93 by Matthew Pickering at 2022-03-28T01:16:38-04:00 hadrian: Flag cabal flag handling This patch basically deletes some ad-hoc handling of Cabal Flags and replaces it with a correct query of the LocalBuildInfo. The flags in the local build info can be modified by users by passing hadrian options For example (!4331) ``` *.genapply.cabal.configure.opts += --flags=unregisterised ``` And all the flags specified by the `Cabal Flags` builder were already passed to configure properly using `--flags`. - - - - - a9f3a5c6 by Ben Gamari at 2022-03-28T01:16:38-04:00 Disable text's dependency on simdutf by default Unfortunately we are simply not currently in a good position to robustly ship binary distributions which link against C++ code like simdutf. Fixes #20724. - - - - - eff86e8a by Richard Eisenberg at 2022-03-28T01:17:14-04:00 Add Red Herring to Note [What might equal later?] Close #21208. - - - - - 12653be9 by jberryman at 2022-03-28T01:17:55-04:00 Document typed splices inhibiting unused bind detection (#16524) - - - - - 4aeade15 by Adam Sandberg Ericsson at 2022-03-28T01:18:31-04:00 users-guide: group ticky-ticky profiling under one heading - - - - - cc59648a by Sylvain Henry at 2022-03-28T01:19:12-04:00 Hadrian: allow testsuite to run with cross-compilers (#21292) - - - - - 89cb1315 by Matthew Pickering at 2022-03-28T01:19:48-04:00 hadrian: Add show target to bindist makefile Some build systems use "make show" to query facts about the bindist, for example: ``` make show VALUE=ProjectVersion > version ``` to determine the ProjectVersion - - - - - 8229885c by Alan Zimmerman at 2022-03-28T19:23:28-04:00 EPA: let stmt with semicolon has wrong anchor The code let ;x =1 Captures the semicolon annotation, but did not widen the anchor in the ValBinds. Fix that. Closes #20247 - - - - - 2c12627c by Ryan Scott at 2022-03-28T19:24:04-04:00 Consistently attach SrcSpans to sub-expressions in TH splices Before, `GHC.ThToHs` was very inconsistent about where various sub-expressions would get the same `SrcSpan` from the original TH splice location or just a generic `noLoc` `SrcSpan`. I have ripped out all uses of `noLoc` in favor of the former instead, and I have added a `Note [Source locations within TH splices]` to officially enshrine this design choice. Fixes #21299. - - - - - 789add55 by Zubin Duggal at 2022-03-29T13:07:22-04:00 Fix all invalid haddock comments in the compiler Fixes #20935 and #20924 - - - - - 967dad03 by Zubin Duggal at 2022-03-29T13:07:22-04:00 hadrian: Build lib:GHC with -haddock and -Winvalid-haddock (#21273) - - - - - ad09a5f7 by sheaf at 2022-03-29T13:08:05-04:00 Hadrian: make DDEBUG separate from debugged RTS This patchs separates whether -DDEBUG is enabled (i.e. whether debug assertions are enabled) from whether we are using the debugged RTS (i.e. GhcDebugged = YES). This means that we properly skip tests which have been marked with `when(compiler_debugged(), skip)`. Fixes #21113, #21153 and #21234 - - - - - 840a6811 by Matthew Pickering at 2022-03-29T13:08:42-04:00 RTS: Zero gc_cpu_start and gc_cpu_end after accounting When passed a combination of `-N` and `-qn` options the cpu time for garbage collection was being vastly overcounted because the counters were not being zeroed appropiately. When -qn1 is passed, only 1 of the N avaiable GC threads is chosen to perform work, the rest are idle. At the end of the GC period, stat_endGC traverses all the GC threads and adds up the elapsed time from each of them. For threads which didn't participate in this GC, the value of the cpu time should be zero, but before this patch, the counters were not zeroed and hence we would count the same elapsed time on many subsequent iterations (until the thread participated in a GC again). The most direct way to zero these fields is to do so immediately after the value is added into the global counter, after which point they are never used again. We also tried another approach where we would zero the counter in yieldCapability but there are some (undiagnosed) siations where a capbility would not pass through yieldCapability before the GC ended and the same double counting problem would occur. Fixes #21082 - - - - - dda46e2d by Matthew Pickering at 2022-03-29T13:09:18-04:00 Add test for T21306 Fixes #21306 - - - - - f07c7766 by Jakob Brünker at 2022-03-30T03:10:33-04:00 Give parsing plugins access to errors Previously, when the parser produced non-fatal errors (i.e. it produced errors but the 'PState' is 'POk'), compilation would be aborted before the 'parsedResultAction' of any plugin was invoked. This commit changes that, so that such that 'parsedResultAction' gets collections of warnings and errors as argument, and must return them after potentially modifying them. Closes #20803 - - - - - e5dfde75 by Ben Gamari at 2022-03-30T03:11:10-04:00 Fix reference to Note [FunBind vs PatBind] This Note was renamed in 2535a6716202253df74d8190b028f85cc6d21b72 yet this occurrence was not updated. - - - - - 21894a63 by Krzysztof Gogolewski at 2022-03-30T03:11:45-04:00 Refactor: make primtypes independent of PrimReps Previously, 'pcPrimTyCon', the function used to define a primitive type, was taking a PrimRep, only to convert it to a RuntimeRep. Now it takes a RuntimeRep directly. Moved primRepToRuntimeRep to GHC.Types.RepType. It is now located next to its inverse function runtimeRepPrimRep. Now GHC.Builtin.Types.Prim no longer mentions PrimRep, and GHC.Types.RepType no longer imports GHC.Builtin.Types.Prim. Removed unused functions `primRepsToRuntimeRep` and `mkTupleRep`. Removed Note [PrimRep and kindPrimRep] - it was never referenced, didn't belong to Types.Prim, and Note [Getting from RuntimeRep to PrimRep] is more comprehensive. - - - - - 43da2963 by Matthew Pickering at 2022-03-30T09:55:49+01:00 Fix mention of non-existent "rehydrateIface" function [skip ci] Fixes #21303 - - - - - 6793a20f by gershomb at 2022-04-01T10:33:46+01:00 Remove wrong claim about naturality law. This docs change removes a longstanding confusion in the Traversable docs. The docs say "(The naturality law is implied by parametricity and thus so is the purity law [1, p15].)". However if one reads the reference a different "natural" law is implied by parametricity. The naturality law given as a law here is imposed. Further, the reference gives examples which violate both laws -- so they cannot be implied by parametricity. This PR just removes the wrong claim. - - - - - 5beeff46 by Ben Gamari at 2022-04-01T10:34:39+01:00 Refactor handling of global initializers GHC uses global initializers for a number of things including cost-center registration, info-table provenance registration, and setup of foreign exports. Previously, the global initializer arrays which referenced these initializers would live in the object file of the C stub, which would then be merged into the main object file of the module. Unfortunately, this approach is no longer tenable with the move to Clang/LLVM on Windows (see #21019). Specifically, lld's PE backend does not support object merging (that is, the -r flag). Instead we are now rather packaging a module's object files into a static library. However, this is problematic in the case of initializers as there are no references to the C stub object in the archive, meaning that the linker may drop the object from the final link. This patch refactors our handling of global initializers to instead place initializer arrays within the object file of the module to which they belong. We do this by introducing a Cmm data declaration containing the initializer array in the module's Cmm stream. While the initializer functions themselves remain in separate C stub objects, the reference from the module's object ensures that they are not dropped from the final link. In service of #21068. - - - - - 3e6fe71b by Matthew Pickering at 2022-04-01T10:35:41+01:00 Fix remaining issues in eventlog types (gen_event_types.py) * The size of End concurrent mark phase looks wrong and, it used to be 4 and now it's 0. * The size of Task create is wrong, used to be 18 and now 14. * The event ticky-ticky entry counter begin sample has the wrong name * The event ticky-ticky entry counter being sample has the wrong size, was 0 now 32. Closes #21070 - - - - - 7847f47a by Ben Gamari at 2022-04-01T10:35:41+01:00 users-guide: Fix a few small issues in eventlog format descriptions The CONC_MARK_END event description didn't mention its payload. Clarify the meaning of the CREATE_TASK's payload. - - - - - acfd5a4c by Matthew Pickering at 2022-04-01T10:35:53+01:00 ci: Regenerate jobs.yaml It seems I forgot to update this to reflect the current state of gen_ci.hs - - - - - a952dd80 by Matthew Pickering at 2022-04-01T10:35:59+01:00 ci: Attempt to fix windows cache issues It appears that running the script directly does nothing (no info is printed about saving the cache). - - - - - fb65e6e3 by Adrian Ratiu at 2022-04-01T10:49:52+01:00 fp_prog_ar.m4: take AR var into consideration In ChromeOS and Gentoo we want the ability to use LLVM ar instead of GNU ar even though both are installed, thus we pass (for eg) AR=llvm-ar to configure. Unfortunately GNU ar always gets picked regardless of the AR setting because the check does not consider the AR var when setting fp_prog_ar, hence this fix. - - - - - 1daaefdf by Greg Steuck at 2022-04-01T10:50:16+01:00 T13366 requires c++ & c++abi libraries on OpenBSD Fixes this failure: =====> 1 of 1 [0, 0, 0] T13366(normal) 1 of 1 [0, 0, 0] Compile failed (exit code 1) errors were: <no location info>: error: user specified .o/.so/.DLL could not be loaded (File not found) Whilst trying to load: (dynamic) stdc++ Additional directories searched: (none) *** unexpected failure for T13366(normal) - - - - - 18e6c85b by Jakob Bruenker at 2022-04-01T10:54:28+01:00 new datatypes for parsedResultAction Previously, the warnings and errors were given and returned as a tuple (Messages PsWarnings, Messages PsErrors). Now, it's just PsMessages. This, together with the HsParsedModule the parser plugin gets and returns, has been wrapped up as ParsedResult. - - - - - 9727e592 by Morrow at 2022-04-01T10:55:12+01:00 Clarify that runghc interprets the input program - - - - - f589dea3 by sheaf at 2022-04-01T10:59:58+01:00 Unify RuntimeRep arguments in ty_co_match The `ty_co_match` function ignored the implicit RuntimeRep coercions that occur in a `FunCo`. Even though a comment explained that this should be fine, #21205 showed that it could result in discarding a RuntimeRep coercion, and thus discarding an important cast entirely. With this patch, we first match the kinds in `ty_co_match`. Fixes #21205 ------------------------- Metric Increase: T12227 T18223 ------------------------- - - - - - 6f4dc372 by Andreas Klebinger at 2022-04-01T11:01:35+01:00 Export MutableByteArray from Data.Array.Byte This implements CLC proposal #49 - - - - - 5df9f5e7 by ARATA Mizuki at 2022-04-01T11:02:35+01:00 Add test cases for #20640 Closes #20640 - - - - - 8334ff9e by Krzysztof Gogolewski at 2022-04-01T11:03:16+01:00 Minor cleanup - Remove unused functions exprToCoercion_maybe, applyTypeToArg, typeMonoPrimRep_maybe, runtimeRepMonoPrimRep_maybe. - Replace orValid with a simpler check - Use splitAtList in applyTysX - Remove calls to extra_clean in the testsuite; it does not do anything. Metric Decrease: T18223 - - - - - b2785cfc by Eric Lindblad at 2022-04-01T11:04:07+01:00 hadrian typos - - - - - 418e6fab by Eric Lindblad at 2022-04-01T11:04:12+01:00 two typos - - - - - dd7c7c99 by Phil de Joux at 2022-04-01T11:04:56+01:00 Add tests and docs on plugin args and order. - - - - - 3e209a62 by MaxHearnden at 2022-04-01T11:05:19+01:00 Change may not to might not - - - - - b84380d3 by Matthew Pickering at 2022-04-01T11:07:27+01:00 hadrian: Remove linters-common from bindist Zubin observed that the bindists contains the utility library linters-common. There are two options: 1. Make sure only the right files are added into the bindist.. a bit tricky due to the non-trivial structure of the lib directory. 2. Remove the bad files once they get copied in.. a bit easier So I went for option 2 but we perhaps should go for option 1 in the future. Fixes #21203 - - - - - ba9904c1 by Zubin Duggal at 2022-04-01T11:07:31+01:00 hadrian: allow testing linters with out of tree compilers - - - - - 26547759 by Matthew Pickering at 2022-04-01T11:07:35+01:00 hadrian: Introduce CheckProgram datatype to replace a 7-tuple - - - - - df65d732 by Jakob Bruenker at 2022-04-01T11:08:28+01:00 Fix panic when pretty printing HsCmdLam When pretty printing a HsCmdLam with more than one argument, GHC panicked because of a missing case. This fixes that. Closes #21300 - - - - - ad6cd165 by John Ericson at 2022-04-01T11:10:06+01:00 hadrian: Remove vestigial -this-unit-id support check This has been dead code since 400ead81e80f66ad7b1260b11b2a92f25ccc3e5a. - - - - - 8ca7ab81 by Matthew Pickering at 2022-04-01T11:10:23+01:00 hadrian: Fix race involving empty package databases There was a small chance of a race occuring between the small window of 1. The first package (.conf) file get written into the database 2. hadrian calling "ghc-pkg recache" to refresh the package.conf file In this window the package database would contain rts.conf but not a package.cache file, and therefore if ghc was invoked it would error because it was missing. To solve this we call "ghc-pkg recache" at when the database is created by shake by writing the stamp file into the database folder. This also creates the package.cache file and so avoids the possibility of this race. - - - - - cc4ec64b by Matthew Pickering at 2022-04-01T11:11:05+01:00 hadrian: Add assertion that in/out tree args are the same There have been a few instances where this calculation was incorrect, so we add a non-terminal assertion when now checks they the two computations indeed compute the same thing. Fixes #21285 - - - - - 691508d8 by Matthew Pickering at 2022-04-01T11:13:10+01:00 hlint: Ignore suggestions in generated HaddockLex file With the make build system this file ends up in the compiler/ subdirectory so is linted. With hadrian, the file ends up in _build so it's not linted. Fixes #21313 - - - - - f8f152e7 by Krzysztof Gogolewski at 2022-04-01T11:14:08+01:00 Change GHC.Prim to GHC.Exts in docs and tests Users are supposed to import GHC.Exts rather than GHC.Prim. Part of #18749. - - - - - f8fc6d2e by Matthew Pickering at 2022-04-01T11:15:24+01:00 driver: Improve -Wunused-packages error message (and simplify implementation) In the past I improved the part of -Wunused-packages which found which packages were used. Now I improve the part which detects which ones were specified. The key innovation is to use the explicitUnits field from UnitState which has the result of resolving the package flags, so we don't need to mess about with the flag arguments from DynFlags anymore. The output now always includes the package name and version (and the flag which exposed it). ``` The following packages were specified via -package or -package-id flags, but were not needed for compilation: - bytestring-0.11.2.0 (exposed by flag -package bytestring) - ghc-9.3 (exposed by flag -package ghc) - process-1.6.13.2 (exposed by flag -package process) ``` Fixes #21307 - - - - - 5e5a12d9 by Matthew Pickering at 2022-04-01T11:15:32+01:00 driver: In oneshot mode, look for interface files in hidir How things should work: * -i is the search path for source files * -hidir explicitly sets the search path for interface files and the output location for interface files. * -odir sets the search path and output location for object files. Before in one shot mode we would look for the interface file in the search locations given by `-i`, but then set the path to be in the `hidir`, so in unusual situations the finder could find an interface file in the `-i` dir but later fail because it tried to read the interface file from the `-hidir`. A bug identified by #20569 - - - - - 950f58e7 by Matthew Pickering at 2022-04-01T11:15:36+01:00 docs: Update documentation interaction of search path, -hidir and -c mode. As noted in #20569 the documentation for search path was wrong because it seemed to indicate that `-i` dirs were important when looking for interface files in `-c` mode, but they are not important if `-hidir` is set. Fixes #20569 - - - - - d85c7dcb by sheaf at 2022-04-01T11:17:56+01:00 Keep track of promotion ticks in HsOpTy This patch adds a PromotionFlag field to HsOpTy, which is used in pretty-printing and when determining whether to emit warnings with -fwarn-unticked-promoted-constructors. This allows us to correctly report tick-related warnings for things like: type A = Int : '[] type B = [Int, Bool] Updates haddock submodule Fixes #19984 - - - - - 32070e6c by Jakob Bruenker at 2022-04-01T20:31:08+02:00 Implement \cases (Proposal 302) This commit implements proposal 302: \cases - Multi-way lambda expressions. This adds a new expression heralded by \cases, which works exactly like \case, but can match multiple apats instead of a single pat. Updates submodule haddock to support the ITlcases token. Closes #20768 - - - - - c6f77f39 by sheaf at 2022-04-01T20:33:05+02:00 Add a regression test for #21323 This bug was fixed at some point between GHC 9.0 and GHC 9.2; this patch simply adds a regression test. - - - - - 3596684e by Jakob Bruenker at 2022-04-01T20:33:05+02:00 Fix error when using empty case in arrow notation It was previously not possible to use -XEmptyCase in Arrow notation, since GHC would print "Exception: foldb of empty list". This is now fixed. Closes #21301 - - - - - 9a325b59 by Ben Gamari at 2022-04-01T20:33:05+02:00 users-guide: Fix various markup issues - - - - - aefb1e6d by sheaf at 2022-04-01T20:36:01+02:00 Ensure implicit parameters are lifted `tcExpr` typechecked implicit parameters by introducing a metavariable of kind `TYPE kappa`, without enforcing that `kappa ~ LiftedRep`. This patch instead creates a metavariable of kind `Type`. Fixes #21327 - - - - - ed62dc66 by Ben Gamari at 2022-04-05T11:44:51-04:00 gitlab-ci: Disable cabal-install store caching on Windows For reasons that remain a mystery, cabal-install seems to consistently corrupt its cache on Windows. Disable caching for now. Works around #21347. - - - - - 5ece5c5a by Ryan Scott at 2022-04-06T13:00:51-04:00 Add /linters/*/dist-install/ to .gitignore Fixes #21335. [ci skip] - - - - - 410c76ee by Ben Gamari at 2022-04-06T13:01:28-04:00 Use static archives as an alternative to object merging Unfortunately, `lld`'s COFF backend does not currently support object merging. With ld.bfd having broken support for high image-load base addresses, it's necessary to find an alternative. Here I introduce support in the driver for generating static archives, which we use on Windows instead of object merging. Closes #21068. - - - - - 400666c8 by Ben Gamari at 2022-04-06T13:01:28-04:00 rts/linker: Catch archives masquerading as object files Check the file's header to catch static archive bearing the `.o` extension, as may happen on Windows after the Clang refactoring. See #21068 - - - - - 694d39f0 by Ben Gamari at 2022-04-06T13:01:28-04:00 driver: Make object merging optional On Windows we don't have a linker which supports object joining (i.e. the `-r` flag). Consequently, `-pgmlm` is now a `Maybe`. See #21068. - - - - - 41fcb5cd by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Refactor handling of ar flags Previously the setup was quite fragile as it had to assume which arguments were file arguments and which were flags. - - - - - 3ac80a86 by Ben Gamari at 2022-04-06T13:01:28-04:00 hadrian: Produce ar archives with L modifier on Windows Since object files may in fact be archive files, we must ensure that their contents are merged rather than constructing an archive-of-an-archive. See #21068. - - - - - 295c35c5 by Ben Gamari at 2022-04-06T13:01:28-04:00 Add a Note describing lack of object merging on Windows See #21068. - - - - - d2ae0a3a by Ben Gamari at 2022-04-06T13:01:28-04:00 Build ar archives with -L when "joining" objects Since there may be .o files which are in fact archives. - - - - - babb47d2 by Zubin Duggal at 2022-04-06T13:02:04-04:00 Add warnings for file header pragmas that appear in the body of a module (#20385) Once we are done parsing the header of a module to obtain the options, we look through the rest of the tokens in order to determine if they contain any misplaced file header pragmas that would usually be ignored, potentially resulting in bad error messages. The warnings are reported immediately so that later errors don't shadow over potentially helpful warnings. Metric Increase: T13719 - - - - - 3f31825b by Ben Gamari at 2022-04-06T13:02:40-04:00 rts/AdjustorPool: Generalize to allow arbitrary contexts Unfortunately the i386 adjustor logic needs this. - - - - - 9b645ee1 by Ben Gamari at 2022-04-06T13:02:40-04:00 adjustors/i386: Use AdjustorPool In !7511 (closed) I introduced a new allocator for adjustors, AdjustorPool, which eliminates the address space fragmentation issues which adjustors can introduce. In that work I focused on amd64 since that was the platform where I observed issues. However, in #21132 we noted that the size of adjustors is also a cause of CI fragility on i386. In this MR I port i386 to use AdjustorPool. Sadly the complexity of the i386 adjustor code does cause require a bit of generalization which makes the code a bit more opaque but such is the world. Closes #21132. - - - - - c657a616 by Ben Gamari at 2022-04-06T13:03:16-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 9ce273b9 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Drop dead HACKAGE_INDEX_STATE variable - - - - - 01845375 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab/darwin: Factor out bindists This makes it a bit easier to bump them. - - - - - c41c478e by Ben Gamari at 2022-04-06T13:03:16-04:00 Fix a few new warnings when booting with GHC 9.2.2 -Wuni-incomplete-patterns and apparent improvements in the pattern match checker surfaced these. - - - - - 6563cd24 by Ben Gamari at 2022-04-06T13:03:16-04:00 gitlab-ci: Bump bootstrap compiler to 9.2.2 This is necessary to build recent `text` commits. Bumps Hackage index state for a hashable which builds with GHC 9.2. - - - - - a62e983e by Ben Gamari at 2022-04-06T13:03:16-04:00 Bump text submodule to current `master` Addresses #21295. - - - - - 88d61031 by Vladislav Zavialov at 2022-04-06T13:03:53-04:00 Refactor OutputableBndrFlag instances The matching on GhcPass introduced by 95275a5f25a is not necessary. This patch reverts it to make the code simpler. - - - - - f601f002 by GHC GitLab CI at 2022-04-06T15:18:26-04:00 rts: Eliminate use of nested functions This is a gcc-specific extension. - - - - - d4c5f29c by Ben Gamari at 2022-04-06T15:18:26-04:00 driver: Drop hacks surrounding windres invocation Drop hack for #1828, among others as they appear to be unnecessary when using `llvm-windres`. - - - - - 6be2c5a7 by Ben Gamari at 2022-04-06T15:18:26-04:00 Windows/Clang: Build system adaptation * Bump win32-tarballs to 0.7 * Move Windows toolchain autoconf logic into separate file * Use clang and LLVM utilities as described in #21019 * Disable object merging as lld doesn't support -r * Drop --oformat=pe-bigobj-x86-64 arguments from ld flags as LLD detects that the output is large on its own. * Drop gcc wrapper since Clang finds its root fine on its own. - - - - - c6fb7aff by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Test that we can build bigobj PE objects - - - - - 79851c07 by Ben Gamari at 2022-04-06T15:18:26-04:00 Drop -static-libgcc This flag is not applicable when Clang is used. - - - - - 1f8a8264 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Port T16514 to C Previously this test was C++ which made it a bit of a portability problem. - - - - - d7e650d1 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark Windows as a libc++ platform - - - - - d7886c46 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark T9405 as fixed on Windows I have not seen it fail since moving to clang. Closes #12714. - - - - - 4c3fbb4e by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark FloatFnInverses as fixed The new toolchain has fixed it. Closes #15670. - - - - - 402c36ba by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Rework T13606 to avoid gcc dependence Previously we used libgcc_s's import library in T13606. However, now that we ship with clang we no longer have this library. Instead we now use gdi32. - - - - - 9934ad54 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Clean up tests depending on C++ std lib - - - - - 12fcdef2 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Split T13366 into two tests Split up the C and C++ uses since the latter is significantly more platform-dependent. - - - - - 3c08a198 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Fix mk-big-obj I'm a bit unclear on how this previously worked as it attempted to build an executable without defining `main`. - - - - - 7e97cc23 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Provide module definitions in T10955dyn Otherwise the linker will export all symbols, including those provided by the RTS, from the produced shared object. Consequently, attempting to link against multiple objects simultaneously will cause the linker to complain that RTS symbols are multiply defined. Avoid this by limiting the DLL exports with a module definition file. - - - - - 9a248afa by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite: Mark test-defaulting-plugin as fragile on Windows Currently llvm-ar does not handle long file paths, resulting in occassional failures of these tests and #21293. - - - - - 39371aa4 by Ben Gamari at 2022-04-06T15:18:26-04:00 testsuite/driver: Treat framework failures of fragile tests as non-fatal Previously we would report framework failures of tests marked as fragile as failures. Now we rather treat them as fragile test failures, which are not fatal to the testsuite run. Noticed while investigating #21293. - - - - - a1e6661d by Ben Gamari at 2022-04-06T15:18:32-04:00 Bump Cabal submodule - Disable support for library-for-ghci on Windows as described in #21068. - Teach Cabal to use `ar -L` when available - - - - - f7b0f63c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump process submodule Fixes missing TEST_CC_OPTS in testsuite tests. - - - - - 109cee19 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Disable ghci libraries when object merging is not available - - - - - c22fba5c by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump bytestring submodule - - - - - 6e2744cc by Ben Gamari at 2022-04-06T15:18:37-04:00 Bump text submodule - - - - - 32333747 by Ben Gamari at 2022-04-06T15:18:37-04:00 hadrian: Build wrappers using ghc rather than cc - - - - - 59787ba5 by Ben Gamari at 2022-04-06T15:18:37-04:00 linker/PEi386: More descriptive error message - - - - - 5e3c3c4f by Ben Gamari at 2022-04-06T15:18:37-04:00 testsuite: Mark TH_spliceE5_prof as unbroken on Windows It was previously failing due to #18721 and now passes with the new toolchain. Closes #18721. - - - - - 9eb0a9d9 by GHC GitLab CI at 2022-04-06T15:23:48-04:00 rts/PEi386: Move some debugging output to -DL - - - - - ce874595 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen/x86: Use %rip-relative addressing On Windows with high-entropy ASLR we must use %rip-relative addressing to avoid overflowing the signed 32-bit immediate size of x86-64. Since %rip-relative addressing comes essentially for free and can make linking significantly easier, we use it on all platforms. - - - - - 52deee64 by Ben Gamari at 2022-04-06T15:24:01-04:00 Generate LEA for label expressions - - - - - 105a0056 by Ben Gamari at 2022-04-06T15:24:01-04:00 Refactor is32BitLit to take Platform rather than Bool - - - - - ec4526b5 by Ben Gamari at 2022-04-06T15:24:01-04:00 Don't assume that labels are 32-bit on Windows - - - - - ffdbe457 by Ben Gamari at 2022-04-06T15:24:01-04:00 nativeGen: Note signed-extended nature of MOV - - - - - bfb79697 by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 5ad143fd by Ben Gamari at 2022-04-06T15:30:56-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - a59a66a8 by Ben Gamari at 2022-04-06T15:30:56-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - 42bf7528 by GHC GitLab CI at 2022-04-06T16:25:04-04:00 rts/PEi386: Fix memory leak Previously we would leak the section information of the `.bss` section. - - - - - d286a55c by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Preserve information about symbol types As noted in #20978, the linker would previously handle overflowed relocations by creating a jump island. While this is fine in the case of code symbols, it's very much not okay in the case of data symbols. To fix this we must keep track of whether each symbol is code or data and relocate them appropriately. This patch takes the first step in this direction, adding a symbol type field to the linker's symbol table. It doesn't yet change relocation behavior to take advantage of this knowledge. Fixes #20978. - - - - - e689e9d5 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Fix relocation overflow behavior This fixes handling of overflowed relocations on PEi386 targets: * Refuse to create jump islands for relocations of data symbols * Correctly handle the `__imp___acrt_iob_func` symbol, which is an new type of symbol: `SYM_TYPE_INDIRECT_DATA` - - - - - 655e7d8f by GHC GitLab CI at 2022-04-06T16:25:25-04:00 rts: Mark anything that might have an info table as data Tables-next-to-code mandates that we treat symbols with info tables like data since we cannot relocate them using a jump island. See #20983. - - - - - 7e8cc293 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Rework linker This is a significant rework of the PEi386 linker, making the linker compatible with high image base addresses. Specifically, we now use the m32 allocator instead of `HeapAllocate`. In addition I found a number of latent bugs in our handling of import libraries and relocations. I've added quite a few comments describing what I've learned about Windows import libraries while fixing these. Thanks to Tamar Christina (@Phyx) for providing the address space search logic, countless hours of help while debugging, and his boundless Windows knowledge. Co-Authored-By: Tamar Christina <tamar at zhox.com> - - - - - ff625218 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Move allocateBytes to MMap.c - - - - - f562b5ca by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PEi386: Avoid accidentally-quadratic allocation cost We now preserve the address that we last mapped, allowing us to resume our search and avoiding quadratic allocation costs. This fixes the runtime of T10296a, which allocates many adjustors. - - - - - 3247b7db by Ben Gamari at 2022-04-06T16:25:25-04:00 Move msvcrt dep out of base - - - - - fa404335 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: More descriptive debug output - - - - - 140f338f by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/PathUtils: Define pathprintf in terms of snwprintf on Windows swprintf deviates from usual `snprintf` semantics in that it does not guarantee reasonable behavior when the buffer is NULL (that is, returning the number of bytes that would have been emitted). - - - - - eb60565b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Report archive member index - - - - - 209fd61b by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker: Split up object resolution and initialization Previously the RTS linker would call initializers during the "resolve" phase of linking. However, this is problematic in the case of cyclic dependencies between objects. In particular, consider the case where we have a situation where a static library contains a set of recursive objects: * object A has depends upon symbols in object B * object B has an initializer that depends upon object A * we try to load object A The linker would previously: 1. start resolving object A 2. encounter the reference to object B, loading it resolve object B 3. run object B's initializer 4. the initializer will attempt to call into object A, which hasn't been fully resolved (and therefore protected) Fix this by moving constructor execution to a new linking phase, which follows resolution. Fix #21253. - - - - - 8e8a1021 by Ben Gamari at 2022-04-06T16:25:25-04:00 rts/linker/LoadArchive: Fix leaking file handle Previously `isArchive` could leak a `FILE` handle if the `fread` returned a short read. - - - - - 429ea5d9 by sheaf at 2022-04-07T07:55:52-04:00 Remove Fun pattern from Typeable COMPLETE set GHC merge request !963 improved warnings in the presence of COMPLETE annotations. This allows the removal of the Fun pattern from the complete set. Doing so expectedly causes some redundant pattern match warnings, in particular in GHC.Utils.Binary.Typeable and Data.Binary.Class from the binary library; this commit addresses that. Updates binary submodule Fixes #20230 - - - - - 54b18824 by Alan Zimmerman at 2022-04-07T07:56:28-04:00 EPA: handling of con_bndrs in mkGadtDecl Get rid of unnnecessary case clause that always matched. Closes #20558 - - - - - 9c838429 by Ben Gamari at 2022-04-07T09:38:53-04:00 testsuite: Mark T10420 as broken on Windows Due to #21322. - - - - - 50739d2b by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Refactor and fix printf attributes on clang Clang on Windows does not understand the `gnu_printf` attribute; use `printf` instead. - - - - - 9eeaeca4 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Add missing newline in error message - - - - - fcef9a17 by Ben Gamari at 2022-04-07T09:42:42-04:00 configure: Make environ decl check more robust Some platforms (e.g. Windows/clang64) declare `environ` in `<stdlib.h>`, not `<unistd.h>` - - - - - 8162b4f3 by Ben Gamari at 2022-04-07T09:42:42-04:00 rts: Adjust RTS symbol table on Windows for ucrt - - - - - 633280d7 by Ben Gamari at 2022-04-07T09:43:21-04:00 testsuite: Fix exit code of bounds checking tests on Windows `abort` exits with 255, not 134, on Windows. - - - - - cab4dc01 by Ben Gamari at 2022-04-07T09:43:31-04:00 testsuite: Update expected output from T5435 tests on Windows I'll admit, I don't currently see *why* this output is reordered but it is a fairly benign difference and I'm out of time to investigate. - - - - - edf5134e by Ben Gamari at 2022-04-07T09:43:35-04:00 testsuite: Mark T20918 as broken on Windows Our toolchain on Windows doesn't currently have Windows support. - - - - - d0ddeff3 by Ben Gamari at 2022-04-07T09:43:39-04:00 testsuite: Mark linker unloading tests as broken on Windows Due to #20354. We will need to investigate this prior the release. - - - - - 5a86da2b by Ben Gamari at 2022-04-07T09:43:43-04:00 testsuite: Mark T9405 as broken on Windows Due to #21361. - - - - - 4aa86dcf by Ben Gamari at 2022-04-07T09:44:18-04:00 Merge branches 'wip/windows-high-codegen', 'wip/windows-high-linker', 'wip/windows-clang-2' and 'wip/lint-rts-includes' into wip/windows-clang-join - - - - - 7206f055 by Ben Gamari at 2022-04-07T09:45:07-04:00 rts/CloneStack: Ensure that Rts.h is #included first As is necessary on Windows. - - - - - 9cfcb27b by Ben Gamari at 2022-04-07T09:45:07-04:00 rts: Fallback to ucrtbase not msvcrt Since we have switched to Clang the toolchain now links against ucrt rather than msvcrt. - - - - - d6665d85 by Ben Gamari at 2022-04-07T09:46:25-04:00 Accept spurious perf test shifts on Windows Metric Decrease: T16875 Metric Increase: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 83363c8b by Simon Peyton Jones at 2022-04-07T12:57:21-04:00 Use prepareBinding in tryCastWorkerWrapper As #21144 showed, tryCastWorkerWrapper was calling prepareRhs, and then unconditionally floating the bindings, without the checks of doFloatFromRhs. That led to floating an unlifted binding into a Rec group. This patch refactors prepareBinding to make these checks, and do them uniformly across all calls. A nice improvement. Other changes * Instead of passing around a RecFlag and a TopLevelFlag; and sometimes a (Maybe SimplCont) for join points, define a new Simplifier-specific data type BindContext: data BindContext = BC_Let TopLevelFlag RecFlag | BC_Join SimplCont and use it consistently. * Kill off completeNonRecX by inlining it. It was only called in one place. * Add a wrapper simplImpRules for simplRules. Compile time on T9630 drops by 4.7%; little else changes. Metric Decrease: T9630 - - - - - 02279a9c by Vladislav Zavialov at 2022-04-07T12:57:59-04:00 Rename [] to List (#21294) This patch implements a small part of GHC Proposal #475. The key change is in GHC.Types: - data [] a = [] | a : [a] + data List a = [] | a : List a And the rest of the patch makes sure that List is pretty-printed as [] in various contexts. Updates the haddock submodule. - - - - - 08480d2a by Simon Peyton Jones at 2022-04-07T12:58:36-04:00 Fix the free-var test in validDerivPred The free-var test (now documented as (VD3)) was too narrow, affecting only class predicates. #21302 demonstrated that this wasn't enough! Fixes #21302. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - b3d6d23d by Andreas Klebinger at 2022-04-07T12:59:12-04:00 Properly explain where INLINE pragmas can appear. Fixes #20676 - - - - - 23ef62b3 by Ben Gamari at 2022-04-07T14:28:28-04:00 rts: Fix off-by-one in snwprintf usage - - - - - b2dbcc7d by Simon Jakobi at 2022-04-08T03:00:38-04:00 Improve seq[D]VarSet Previously, the use of size[D]VarSet would involve a traversal of the entire underlying IntMap. Since IntMaps are already spine-strict, this is unnecessary. - - - - - 64ac20a7 by sheaf at 2022-04-08T03:01:16-04:00 Add test for #21338 This no-skolem-info bug was fixed by the no-skolem-info patch that will be part of GHC 9.4. This patch adds a regression test for the issue reported in issue #21338. Fixes #21338. - - - - - c32c4db6 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Move __USE_MINGW_ANSI_STDIO definition to PosixSource.h It's easier to ensure that this is included first than Rts.h - - - - - 56f85d62 by Ben Gamari at 2022-04-08T03:01:53-04:00 rts: Fix various #include issues This fixes various violations of the newly-added RTS includes linter. - - - - - cb1f31f5 by Ben Gamari at 2022-04-08T03:01:53-04:00 testsuite: Lint RTS #includes Verifies two important properties of #includes in the RTS: * That system headers don't appear inside of a `<BeginPrivate.h>` block as this can hide system library symbols, resulting in very hard-to-diagnose linker errors * That no headers precede `Rts.h`, ensuring that __USE_MINGW_ANSI_STDIO is set correctly before system headers are included. - - - - - c44432db by Krzysztof Gogolewski at 2022-04-08T03:02:29-04:00 Fixes to 9.4 release notes - Mention -Wforall-identifier - Improve description of withDict - Fix formatting - - - - - 777365f1 by sheaf at 2022-04-08T09:43:35-04:00 Correctly report SrcLoc of redundant constraints We were accidentally dropping the source location information in certain circumstances when reporting redundant constraints. This patch makes sure that we set the TcLclEnv correctly before reporting the warning. Fixes #21315 - - - - - af300a43 by Vladislav Zavialov at 2022-04-08T09:44:11-04:00 Reject illegal quote mark in data con declarations (#17865) * Non-fatal (i.e. recoverable) parse error * Checking infix constructors * Extended the regression test - - - - - 56254e6b by Ben Gamari at 2022-04-08T09:59:46-04:00 Merge remote-tracking branch 'origin/master' - - - - - 6e2c3b7c by Matthew Pickering at 2022-04-08T13:55:15-04:00 driver: Introduce HomeModInfoCache abstraction The HomeModInfoCache is a mutable cache which is updated incrementally as the driver completes, this makes it robust to exceptions including (SIGINT) The interface for the cache is described by the `HomeMOdInfoCache` data type: ``` data HomeModInfoCache = HomeModInfoCache { hmi_clearCache :: IO [HomeModInfo] , hmi_addToCache :: HomeModInfo -> IO () } ``` The first operation clears the cache and returns its contents. This is designed so it's harder to end up in situations where the cache is retained throughout the execution of upsweep. The second operation allows a module to be added to the cache. The one slightly nasty part is in `interpretBuildPlan` where we have to be careful to ensure that the cache writes happen: 1. In parralel 2. Before the executation continues after upsweep. This requires some simple, localised MVar wrangling. Fixes #20780 - - - - - 85f4a3c9 by Andreas Klebinger at 2022-04-08T13:55:50-04:00 Add flag -fprof-manual which controls if GHC should honour manual cost centres. This allows disabling of manual control centres in code a user doesn't control like libraries. Fixes #18867 - - - - - 3415981c by Vladislav Zavialov at 2022-04-08T13:56:27-04:00 HsUniToken for :: in GADT constructors (#19623) One more step towards the new design of EPA. Updates the haddock submodule. - - - - - 23f95735 by sheaf at 2022-04-08T13:57:07-04:00 Docs: datacon eta-expansion, rep-poly checks The existing notes weren't very clear on how the eta-expansion of data constructors that occurs in tcInferDataCon/dsConLike interacts with the representation polymorphism invariants. So we explain with a few more details how we ensure that the representation-polymorphic lambdas introduced by tcInferDataCon/dsConLike don't end up causing problems, by checking they are properly instantiated and then relying on the simple optimiser to perform beta reduction. A few additional changes: - ConLikeTc just take type variables instead of binders, as we never actually used the binders. - Removed the FRRApp constructor of FRROrigin; it was no longer used now that we use ExpectedFunTyOrigin. - Adds a bit of documentation to the constructors of ExpectedFunTyOrigin. - - - - - d4480490 by Matthew Pickering at 2022-04-08T13:57:43-04:00 ci: Replace "always" with "on_success" to stop build jobs running before hadrian-ghci has finished See https://docs.gitlab.com/ee/ci/yaml/#when * always means, always run not matter what * on_success means, run if the dependencies have built successfully - - - - - 0736e949 by Vladislav Zavialov at 2022-04-08T13:58:19-04:00 Disallow (->) as a data constructor name (#16999) The code was misusing isLexCon, which was never meant for validation. In fact, its documentation states the following: Use these functions to figure what kind of name a 'FastString' represents; these functions do /not/ check that the identifier is valid. Ha! This sign can't stop me because I can't read. The fix is to use okConOcc instead. The other checks (isTcOcc or isDataOcc) seem superfluous, so I also removed those. - - - - - e58d5eeb by Simon Peyton Jones at 2022-04-08T13:58:55-04:00 Tiny documentation wibble This commit commit 83363c8b04837ee871a304cf85207cf79b299fb0 Author: Simon Peyton Jones <simon.peytonjones at gmail.com> Date: Fri Mar 11 16:55:38 2022 +0000 Use prepareBinding in tryCastWorkerWrapper refactored completeNonRecX away, but left a Note referring to it. This MR fixes that Note. - - - - - 4bb00839 by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Fix nightly head.hackage pipelines This also needs a corresponding commit to head.hackage, I also made the job explicitly depend on the fedora33 job so that it isn't blocked by a failing windows job, which causes docs-tarball to fail. - - - - - 3c48e12a by Matthew Pickering at 2022-04-09T07:40:28-04:00 ci: Remove doc-tarball dependency from perf and perf-nofib jobs These don't depend on the contents of the tarball so we can run them straight after the fedora33 job finishes. - - - - - 27362265 by Matthew Pickering at 2022-04-09T07:41:04-04:00 Bump deepseq to 1.4.7.0 Updates deepseq submodule Fixes #20653 - - - - - dcf30da8 by Joachim Breitner at 2022-04-09T13:02:19-04:00 Drop the app invariant previously, GHC had the "let/app-invariant" which said that the RHS of a let or the argument of an application must be of lifted type or ok for speculation. We want this on let to freely float them around, and we wanted that on app to freely convert between the two (e.g. in beta-reduction or inlining). However, the app invariant meant that simple code didn't stay simple and this got in the way of rules matching. By removing the app invariant, this thus fixes #20554. The new invariant is now called "let-can-float invariant", which is hopefully easier to guess its meaning correctly. Dropping the app invariant means that everywhere where we effectively do beta-reduction (in the two simplifiers, but also in `exprIsConApp_maybe` and other innocent looking places) we now have to check if the argument must be evaluated (unlifted and side-effecting), and analyses have to be adjusted to the new semantics of `App`. Also, `LetFloats` in the simplifier can now also carry such non-floating bindings. The fix for DmdAnal, refine by Sebastian, makes functions with unlifted arguments strict in these arguments, which changes some signatures. This causes some extra calls to `exprType` and `exprOkForSpeculation`, so some perf benchmarks regress a bit (while others improve). Metric Decrease: T9020 Metric Increase: LargeRecord T12545 T15164 T16577 T18223 T5642 T9961 Co-authored-by: Sebastian Graf <sebastian.graf at kit.edu> - - - - - 6c6c5379 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add functions traceWith, traceShowWith, traceEventWith. As discussed at https://github.com/haskell/core-libraries-committee/issues/36 - - - - - 8fafacf7 by Philip Hazelden at 2022-04-09T13:02:59-04:00 Add tests for several trace functions. - - - - - 20bbf3ac by Philip Hazelden at 2022-04-09T13:02:59-04:00 Update changelog. - - - - - 47d18b0b by Andreas Klebinger at 2022-04-09T13:03:35-04:00 Add regression test for #19569 - - - - - 5f8d6e65 by sheaf at 2022-04-09T13:04:14-04:00 Fix missing SymCo in pushCoercionIntoLambda There was a missing SymCo in pushCoercionIntoLambda. Currently this codepath is only used with rewrite rules, so this bug managed to slip by, but trying to use pushCoercionIntoLambda in other contexts revealed the bug. - - - - - 20eca489 by Vladislav Zavialov at 2022-04-09T13:04:50-04:00 Refactor: simplify lexing of the dot Before this patch, the lexer did a truly roundabout thing with the dot: 1. look up the varsym in reservedSymsFM and turn it into ITdot 2. under OverloadedRecordDot, turn it into ITvarsym 3. in varsym_(prefix|suffix|...) turn it into ITvarsym, ITdot, or ITproj, depending on extensions and whitespace Turns out, the last step is sufficient to handle the dot correctly. This patch removes the first two steps. - - - - - 5440f63e by Hécate Moonlight at 2022-04-12T11:11:06-04:00 Document that DuplicateRecordFields doesn't tolerates ambiguous fields Fix #19891 - - - - - 0090ad7b by Sebastian Graf at 2022-04-12T11:11:42-04:00 Eta reduction based on evaluation context (#21261) I completely rewrote our Notes surrounding eta-reduction. The new entry point is `Note [Eta reduction makes sense]`. Then I went on to extend the Simplifier to maintain an evaluation context in the form of a `SubDemand` inside a `SimplCont`. That `SubDemand` is useful for doing eta reduction according to `Note [Eta reduction based on evaluation context]`, which describes how Demand analysis, Simplifier and `tryEtaReduce` interact to facilitate eta reduction in more scenarios. Thus we fix #21261. ghc/alloc perf marginally improves (-0.0%). A medium-sized win is when compiling T3064 (-3%). It seems that haddock improves by 0.6% to 1.0%, too. Metric Decrease: T3064 - - - - - 4d2ee313 by Sebastian Graf at 2022-04-12T17:54:57+02:00 Specialising through specialised method calls (#19644) In #19644, we discovered that the ClassOp/DFun rules from Note [ClassOp/DFun selection] inhibit transitive specialisation in a scenario like ``` class C a where m :: Show b => a -> b -> ...; n :: ... instance C Int where m = ... -- $cm :: Show b => Int -> b -> ... f :: forall a b. (C a, Show b) => ... f $dC $dShow = ... m @a $dC @b $dShow ... main = ... f @Int @Bool ... ``` After we specialise `f` for `Int`, we'll see `m @a $dC @b $dShow` in the body of `$sf`. But before this patch, Specialise doesn't apply the ClassOp/DFun rule to rewrite to a call of the instance method for `C Int`, e.g., `$cm @Bool $dShow`. As a result, Specialise couldn't further specialise `$cm` for `Bool`. There's a better example in `Note [Specialisation modulo dictionary selectors]`. This patch enables proper Specialisation, as follows: 1. In the App case of `specExpr`, try to apply the CalssOp/DictSel rule on the head of the application 2. Attach an unfolding to freshly-bound dictionary ids such as `$dC` and `$dShow` in `bindAuxiliaryDict` NB: Without (2), (1) would be pointless, because `lookupRule` wouldn't be able to look into the RHS of `$dC` to see the DFun. (2) triggered #21332, because the Specialiser floats around dictionaries without accounting for them in the `SpecEnv`'s `InScopeSet`, triggering a panic when rewriting dictionary unfoldings. Fixes #19644 and #21332. - - - - - b06f4f47 by Sebastian Graf at 2022-04-12T17:54:58+02:00 Specialise: Check `typeDeterminesValue` before specialising on an interesting dictionary I extracted the checks from `Note [Type determines value]` into its own function, so that we share the logic properly. Then I made sure that we actually call `typeDeterminesValue` everywhere we check for `interestingDict`. - - - - - a42dbc55 by Matthew Pickering at 2022-04-13T06:24:52-04:00 Refine warning about defining rules in SAFE modules This change makes it clear that it's the definition rather than any usage which is a problem, and that rules defined in other modules will still be used to do rewrites. Fixes #20923 - - - - - df893f66 by Andreas Klebinger at 2022-04-14T08:18:37-04:00 StgLint: Lint constructor applications and strict workers for arity. This will mean T9208 when run with lint will return a lint error instead of resulting in a panic. Fixes #21117 - - - - - 426ec446 by sheaf at 2022-04-14T08:19:16-04:00 Hadrian: use a set to keep track of ways The order in which ways are provided doesn't matter, so we use a data structure with the appropriate semantics to represent ways. Fixes #21378 - - - - - 7c639b9a by Dylan Yudaken at 2022-04-15T13:55:59-04:00 Only enable PROF_SPIN in DEBUG - - - - - 96b9e5ea by Ben Gamari at 2022-04-15T13:56:34-04:00 testsuite: Add test for #21390 - - - - - d8392f6a by Ben Gamari at 2022-04-15T13:56:34-04:00 rts: Ensure that the interpreter doesn't disregard tags Previously the interpreter's handling of `RET_BCO` stack frames would throw away the tag of the returned closure. This resulted in #21390. - - - - - 83c67f76 by Alan Zimmerman at 2022-04-20T11:49:28-04:00 Add -dkeep-comments flag to keep comments in the parser This provides a way to set the Opt_KeepRawTokenStream from the command line, allowing exact print annotation users to see exactly what is produced for a given parsed file, when used in conjunction with -ddump-parsed-ast Discussed in #19706, but this commit does not close the issue. - - - - - a5ea65c9 by Krzysztof Gogolewski at 2022-04-20T11:50:04-04:00 Remove LevityInfo Every Id was storing a boolean whether it could be levity-polymorphic. This information is no longer needed since representation-checking has been moved to the typechecker. - - - - - 49bd7584 by Andreas Klebinger at 2022-04-20T11:50:39-04:00 Fix a shadowing issue in StgUnarise. For I assume performance reasons we don't record no-op replacements during unarise. This lead to problems with code like this: f = \(Eta_B0 :: VoidType) x1 x2 -> ... let foo = \(Eta_B0 :: LiftedType) -> g x y Eta_B0 in ... Here we would record the outer Eta_B0 as void rep, but would not shadow Eta_B0 inside `foo` because this arg is single-rep and so doesn't need to replaced. But this means when looking at occurence sites we would check the env and assume it's void rep based on the entry we made for the (no longer in scope) outer `Eta_B0`. Fixes #21396 and the ticket has a few more details. - - - - - 0c02c919 by Simon Peyton Jones at 2022-04-20T11:51:15-04:00 Fix substitution in bindAuxiliaryDict In GHC.Core.Opt.Specialise.bindAuxiliaryDict we were unnecessarily calling `extendInScope` to bring into scope variables that were /already/ in scope. Worse, GHC.Core.Subst.extendInScope strangely deleted the newly-in-scope variables from the substitution -- and that was fatal in #21391. I removed the redundant calls to extendInScope. More ambitiously, I changed GHC.Core.Subst.extendInScope (and cousins) to stop deleting variables from the substitution. I even changed the names of the function to extendSubstInScope (and cousins) and audited all the calls to check that deleting from the substitution was wrong. In fact there are very few such calls, and they are all about introducing a fresh non-in-scope variable. These are "OutIds"; it is utterly wrong to mess with the "InId" substitution. I have not added a Note, because I'm deleting wrong code, and it'd be distracting to document a bug. - - - - - 0481a6af by Cheng Shao at 2022-04-21T11:06:06+00:00 [ci skip] Drop outdated TODO in RtsAPI.c - - - - - 1e062a8a by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Introduce ip_STACK_FRAME While debugging it is very useful to be able to determine whether a given info table is a stack frame or not. We have spare bits in the closure flags array anyways, use one for this information. - - - - - 08a6a2ee by Ben Gamari at 2022-04-22T02:12:59-04:00 rts: Mark closureFlags array as const - - - - - 8f9b8282 by Krzysztof Gogolewski at 2022-04-22T02:13:35-04:00 Check for zero-bit types in sizeExpr Fixes #20940 Metric Decrease: T18698a - - - - - fcf22883 by Andreas Klebinger at 2022-04-22T02:14:10-04:00 Include the way string in the file name for dump files. This can be disabled by `-fno-dump-with-ways` if not desired. Finally we will be able to look at both profiled and non-profiled dumps when compiling with dump flags and we compile in both ways. - - - - - 252394ce by Bodigrim at 2022-04-22T02:14:48-04:00 Improve error messages from GHC.IO.Encoding.Failure - - - - - 250f57c1 by Bodigrim at 2022-04-22T02:14:48-04:00 Update test baselines to match new error messages from GHC.IO.Encoding.Failure - - - - - 5ac9b321 by Ben Gamari at 2022-04-22T02:15:25-04:00 get-win32-tarballs: Drop i686 architecture As of #18487 we no longer support 32-bit Windows. Fixes #21372. - - - - - dd5fecb0 by Ben Gamari at 2022-04-22T02:16:00-04:00 hadrian: Don't rely on xxx not being present in installation path Previously Hadrian's installation makefile would assume that the string `xxx` did not appear in the installation path. This would of course break for some users. Fixes #21402. - - - - - 09e98859 by Ben Gamari at 2022-04-22T02:16:35-04:00 testsuite: Ensure that GHC doesn't pick up environment files Here we set GHC_ENVIRONMENT="-" to ensure that GHC invocations of tests don't pick up a user's local package environment. Fixes #21365. Metric Decrease: T10421 T12234 T12425 T13035 T16875 T9198 - - - - - 76bb8cb3 by Ben Gamari at 2022-04-22T02:17:11-04:00 hadrian: Enable -dlint in devel2 flavour Previously only -dcore-lint was enabled. - - - - - f435d55f by Krzysztof Gogolewski at 2022-04-22T08:00:18-04:00 Fixes to rubbish literals * In CoreToStg, the application 'RUBBISH[rep] x' was simplified to 'RUBBISH[rep]'. But it is possible that the result of the function is represented differently than the function. * In Unarise, 'LitRubbish (primRepToType prep)' is incorrect: LitRubbish takes a RuntimeRep such as IntRep, while primRepToType returns a type such as Any @(TYPE IntRep). Use primRepToRuntimeRep instead. This code is never run in the testsuite. * In StgToByteCode, all rubbish literals were assumed to be boxed. This code predates representation-polymorphic RubbishLit and I think it was not updated. I don't have a testcase for any of those issues, but the code looks wrong. - - - - - 93c16b94 by sheaf at 2022-04-22T08:00:57-04:00 Relax "suppressing errors" assert in reportWanteds The assertion in reportWanteds that we aren't suppressing all the Wanted constraints was too strong: it might be the case that we are inside an implication, and have already reported an unsolved Wanted from outside the implication. It is possible that all Wanteds inside the implication have been rewritten by the outer Wanted, so we shouldn't throw an assertion failure in that case. Fixes #21405 - - - - - 78ec692d by Andreas Klebinger at 2022-04-22T08:01:33-04:00 Mention new MutableByteArray# wrapper in base changelog. - - - - - 56d7cb53 by Eric Lindblad at 2022-04-22T14:13:32-04:00 unlist announce - - - - - 1e4dcf23 by sheaf at 2022-04-22T14:14:12-04:00 decideMonoTyVars: account for CoVars in candidates The "candidates" passed to decideMonoTyVars can contain coercion holes. This is because we might well decide to quantify over some unsolved equality constraints, as long as they are not definitely insoluble. In that situation, decideMonoTyVars was passing a set of type variables that was not closed over kinds to closeWrtFunDeps, which was tripping up an assertion failure. Fixes #21404 - - - - - 2c541f99 by Simon Peyton Jones at 2022-04-22T14:14:47-04:00 Improve floated dicts in Specialise Second fix to #21391. It turned out that we missed calling bringFloatedDictsIntoScope when specialising imports, which led to the same bug as before. I refactored to move that call to a single place, in specCalls, so we can't forget it. This meant making `FloatedDictBinds` into its own type, pairing the dictionary bindings themselves with the set of their binders. Nicer this way. - - - - - 0950e2c4 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Ensure that --extra-lib-dirs are used Previously we only took `extraLibDirs` and friends from the package description, ignoring any contribution from the `LocalBuildInfo`. Fix this. Fixes #20566. - - - - - 53cc93ae by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Drop redundant include directories The package-specific include directories in Settings.Builders.Common.cIncludeDirs are now redundant since they now come from Cabal. Closes #20566. - - - - - b2721819 by Ben Gamari at 2022-04-25T10:18:17-04:00 hadrian: Clean up handling of libffi dependencies - - - - - 18e5103f by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: More robust library way detection Previously `test.mk` would try to determine whether the dynamic, profiling, and vanilla library ways are available by searching for `PrimOpWrappers.{,dyn_,p_}hi` in directory reported by `ghc-pkg field ghc-prim library-dirs`. However, this is extremely fragile as there is no guarantee that there is only one library directory. To handle the case of multiple `library-dirs` correct we would have to carry out the delicate task of tokenising the directory list (in shell, no less). Since this isn't a task that I am eager to solve, I have rather moved the detection logic into the testsuite driver and instead perform a test compilation in each of the ways. This should be more robust than the previous approach. I stumbled upon this while fixing #20579. - - - - - 6c7a4913 by Ben Gamari at 2022-04-25T10:18:17-04:00 testsuite: Cabalify ghc-config To ensure that the build benefits from Hadrian's usual logic for building packages, avoiding #21409. Closes #21409. - - - - - 9af091f7 by Ben Gamari at 2022-04-25T10:18:53-04:00 rts: Factor out built-in GC roots - - - - - e7c4719d by Ben Gamari at 2022-04-25T10:18:54-04:00 Ensure that wired-in exception closures aren't GC'd As described in Note [Wired-in exceptions are not CAFfy], a small set of built-in exception closures get special treatment in the code generator, being declared as non-CAFfy despite potentially containing CAF references. The original intent of this treatment for the RTS to then add StablePtrs for each of the closures, ensuring that they are not GC'd. However, this logic was not applied consistently and eventually removed entirely in 951c1fb0. This lead to #21141. Here we fix this bug by reintroducing the StablePtrs and document the status quo. Closes #21141. - - - - - 9587726f by Ben Gamari at 2022-04-25T10:18:54-04:00 testsuite: Add testcase for #21141 - - - - - cb71226f by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop dead code in GHC.Linker.Static.linkBinary' Previously we supported building statically-linked executables using libtool. However, this was dropped in 91262e75dd1d80f8f28a3922934ec7e59290e28c in favor of using ar/ranlib directly. Consequently we can drop this logic. Fixes #18826. - - - - - 9420d26b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop libtool path from settings file GHC no longers uses libtool for linking and therefore this is no longer necessary. - - - - - 41cf758b by Ben Gamari at 2022-04-25T10:19:29-04:00 Drop remaining vestiges of libtool Drop libtool logic from gen-dll, allowing us to drop the remaining logic from the `configure` script. Strangely, this appears to reliably reduce compiler allocations of T16875 on Windows. Closes #18826. Metric Decrease: T16875 - - - - - e09afbf2 by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - e76705cf by Ben Gamari at 2022-04-25T10:20:05-04:00 rts: Improve documentation of closure types Also drops the unused TREC_COMMITTED transaction state. - - - - - f2c08124 by Bodigrim at 2022-04-25T10:20:44-04:00 Document behaviour of RULES with KnownNat - - - - - 360dc2bc by Li-yao Xia at 2022-04-25T19:13:06+00:00 Fix rendering of liftA haddock - - - - - 16df6058 by Ben Gamari at 2022-04-27T10:02:25-04:00 testsuite: Report minimum and maximum stat changes As suggested in #20733. - - - - - e39cab62 by Fabian Thorand at 2022-04-27T10:03:03-04:00 Defer freeing of mega block groups Solves the quadratic worst case performance of freeing megablocks that was described in issue #19897. During GC runs, we now keep a secondary free list for megablocks that is neither sorted, nor coalesced. That way, free becomes an O(1) operation at the expense of not being able to reuse memory for larger allocations. At the end of a GC run, the secondary free list is sorted and then merged into the actual free list in a single pass. That way, our worst case performance is O(n log(n)) rather than O(n^2). We postulate that temporarily losing coalescense during a single GC run won't have any adverse effects in practice because: - We would need to release enough memory during the GC, and then after that (but within the same GC run) allocate a megablock group of more than one megablock. This seems unlikely, as large objects are not copied during GC, and so we shouldn't need such large allocations during a GC run. - Allocations of megablock groups of more than one megablock are rare. They only happen when a single heap object is large enough to require that amount of space. Any allocation areas that are supposed to hold more than one heap object cannot use megablock groups, because only the first megablock of a megablock group has valid `bdescr`s. Thus, heap object can only start in the first megablock of a group, not in later ones. - - - - - 5de6be0c by Fabian Thorand at 2022-04-27T10:03:03-04:00 Add note about inefficiency in returnMemoryToOS - - - - - 8bef471a by sheaf at 2022-04-27T10:03:43-04:00 Ensure that Any is Boxed in FFI imports/exports We should only accept the type `Any` in foreign import/export declarations when it has type `Type` or `UnliftedType`. This patch adds a kind check, and a special error message triggered by occurrences of `Any` in foreign import/export declarations at other kinds. Fixes #21305 - - - - - ba3d4e1c by Ben Gamari at 2022-04-27T10:04:19-04:00 Basic response file support Here we introduce support into our command-line parsing infrastructure and driver for handling gnu-style response file arguments, typically used to work around platform command-line length limitations. Fixes #16476. - - - - - 3b6061be by Ben Gamari at 2022-04-27T10:04:19-04:00 testsuite: Add test for #16476 - - - - - 75bf1337 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix cabal-reinstall job It's quite nice we can do this by mostly deleting code Fixes #21373 - - - - - 2c00d904 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add test to check that release jobs have profiled libs - - - - - 50d78d3b by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Explicitly handle failures in test_hadrian We also disable the stage1 testing which is broken. Related to #21072 - - - - - 2dcdf091 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Fix shell command - - - - - 55c84123 by Matthew Pickering at 2022-04-27T10:04:55-04:00 bootstrap: Add bootstrapping files for ghc-9_2_2 Fixes #21373 - - - - - c7ee0be6 by Matthew Pickering at 2022-04-27T10:04:55-04:00 ci: Add linting job which checks authors are not GHC CI - - - - - 23aad124 by Adam Sandberg Ericsson at 2022-04-27T10:05:31-04:00 rts: state explicitly what evacuate and scavange mean in the copying gc - - - - - 318e0005 by Ben Gamari at 2022-04-27T10:06:07-04:00 rts/eventlog: Don't attempt to flush if there is no writer If the user has not configured a writer then there is nothing to flush. - - - - - ee11d043 by Ben Gamari at 2022-04-27T10:06:07-04:00 Enable eventlog support in all ways by default Here we deprecate the eventlogging RTS ways and instead enable eventlog support in the remaining ways. This simplifies packaging and reduces GHC compilation times (as we can eliminate two whole compilations of the RTS) while simplifying the end-user story. The trade-off is a small increase in binary sizes in the case that the user does not want eventlogging support, but we think that this is a fine trade-off. This also revealed a latent RTS bug: some files which included `Cmm.h` also assumed that it defined various macros which were in fact defined by `Config.h`, which `Cmm.h` did not include. Fixing this in turn revealed that `StgMiscClosures.cmm` failed to import various spinlock statistics counters, as evidenced by the failed unregisterised build. Closes #18948. - - - - - a2e5ab70 by Andreas Klebinger at 2022-04-27T10:06:43-04:00 Change `-dsuppress-ticks` to only suppress non-code ticks. This means cost centres and coverage ticks will still be present in output. Makes using -dsuppress-all more convenient when looking at profiled builds. - - - - - ec9d7e04 by Ben Gamari at 2022-04-27T10:07:21-04:00 Bump text submodule. This should fix #21352 - - - - - c3105be4 by Bodigrim at 2022-04-27T10:08:01-04:00 Documentation for setLocaleEncoding - - - - - 7f618fd3 by sheaf at 2022-04-27T10:08:40-04:00 Update docs for change to type-checking plugins There was no mention of the changes to type-checking plugins in the 9.4.1 notes, and the extending_ghc documentation contained a reference to an outdated type. - - - - - 4419dd3a by Adam Sandberg Ericsson at 2022-04-27T10:09:18-04:00 rts: add some more documentation to StgWeak closure type - - - - - 5a7f0dee by Matthew Pickering at 2022-04-27T10:09:54-04:00 Give Cmm files fake ModuleNames which include full filepath This fixes the initialisation functions when using -prof or -finfo-table-map. Fixes #21370 - - - - - 81cf52bb by sheaf at 2022-04-27T10:10:33-04:00 Mark GHC.Prim.PtrEq as Unsafe This module exports unsafe pointer equality operations, so we accordingly mark it as Unsafe. Fixes #21433 - - - - - f6a8185d by Ben Gamari at 2022-04-28T09:10:31+00:00 testsuite: Add performance test for #14766 This distills the essence of the Sigs.hs program found in the ticket. - - - - - c7a3dc29 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Add Monoid instance to Way - - - - - 654bafea by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Enrich flavours to build profiled/debugged/threaded ghcs per stage - - - - - 4ad559c8 by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: add debug_ghc and debug_stage1_ghc flavour transformers - - - - - f9728fdb by Douglas Wilson at 2022-04-28T18:54:44-04:00 hadrian: Don't pass -rtsopts when building libraries - - - - - 769279e6 by Matthew Pickering at 2022-04-28T18:54:44-04:00 testsuite: Fix calculation about whether to pass -dynamic to compiler - - - - - da8ae7f2 by Ben Gamari at 2022-04-28T18:55:20-04:00 hadrian: Clean up flavour transformer definitions Previously the `ipe` and `omit_pragmas` transformers were hackily defined using the textual key-value syntax. Fix this. - - - - - 61305184 by Ben Gamari at 2022-04-28T18:55:56-04:00 Bump process submodule - - - - - a8c99391 by sheaf at 2022-04-28T18:56:37-04:00 Fix unification of ConcreteTvs, removing IsRefl# This patch fixes the unification of concrete type variables. The subtlety was that unifying concrete metavariables is more subtle than other metavariables, as decomposition is possible. See the Note [Unifying concrete metavariables], which explains how we unify a concrete type variable with a type 'ty' by concretising 'ty', using the function 'GHC.Tc.Utils.Concrete.concretise'. This can be used to perform an eager syntactic check for concreteness, allowing us to remove the IsRefl# special predicate. Instead of emitting two constraints `rr ~# concrete_tv` and `IsRefl# rr concrete_tv`, we instead concretise 'rr'. If this succeeds we can fill 'concrete_tv', and otherwise we directly emit an error message to the typechecker environment instead of deferring. We still need the error message to be passed on (instead of directly thrown), as we might benefit from further unification in which case we will need to zonk the stored types. To achieve this, we change the 'wc_holes' field of 'WantedConstraints' to 'wc_errors', which stores general delayed errors. For the moement, a delayed error is either a hole, or a syntactic equality error. hasFixedRuntimeRep_MustBeRefl is now hasFixedRuntimeRep_syntactic, and hasFixedRuntimeRep has been refactored to directly return the most useful coercion for PHASE 2 of FixedRuntimeRep. This patch also adds a field ir_frr to the InferResult datatype, holding a value of type Maybe FRROrigin. When this value is not Nothing, this means that we must fill the ir_ref field with a type which has a fixed RuntimeRep. When it comes time to fill such an ExpType, we ensure that the type has a fixed RuntimeRep by performing a representation-polymorphism check with the given FRROrigin This is similar to what we already do to ensure we fill an Infer ExpType with a type of the correct TcLevel. This allows us to properly perform representation-polymorphism checks on 'Infer' 'ExpTypes'. The fillInferResult function had to be moved to GHC.Tc.Utils.Unify to avoid a cyclic import now that it calls hasFixedRuntimeRep. This patch also changes the code in matchExpectedFunTys to make use of the coercions, which is now possible thanks to the previous change. This implements PHASE 2 of FixedRuntimeRep in some situations. For example, the test cases T13105 and T17536b are now both accepted. Fixes #21239 and #21325 ------------------------- Metric Decrease: T18223 T5631 ------------------------- - - - - - 43bd897d by Simon Peyton Jones at 2022-04-28T18:57:13-04:00 Add INLINE pragmas for Enum helper methods As #21343 showed, we need to be super-certain that the "helper methods" for Enum instances are actually inlined or specialised. I also tripped over this when I discovered that numericEnumFromTo and friends had no pragmas at all, so their performance was very fragile. If they weren't inlined, all bets were off. So I've added INLINE pragmas for them too. See new Note [Inline Enum method helpers] in GHC.Enum. I also expanded Note [Checking for INLINE loop breakers] in GHC.Core.Lint to explain why an INLINE function might temporarily be a loop breaker -- this was the initial bug report in #21343. Strangely we get a 16% runtime allocation decrease in perf/should_run/T15185, but only on i386. Since it moves in the right direction I'm disinclined to investigate, so I'll accept it. Metric Decrease: T15185 - - - - - ca1434e3 by Ben Gamari at 2022-04-28T18:57:49-04:00 configure: Bump GHC version to 9.5 Bumps haddock submodule. - - - - - 292e3971 by Teo Camarasu at 2022-04-28T18:58:28-04:00 add since annotation for GHC.Stack.CCS.whereFrom - - - - - 905206d6 by Tamar Christina at 2022-04-28T22:19:34-04:00 winio: add support to iserv. - - - - - d182897e by Tamar Christina at 2022-04-28T22:19:34-04:00 Remove unused line - - - - - 22cf4698 by Matthew Pickering at 2022-04-28T22:20:10-04:00 Revert "rts: Refactor handling of dead threads' stacks" This reverts commit e09afbf2a998beea7783e3de5dce5dd3c6ff23db. - - - - - 8ed57135 by Matthew Pickering at 2022-04-29T04:11:29-04:00 Provide efficient unionMG function for combining two module graphs. This function is used by API clients (hls). This supercedes !6922 - - - - - 0235ff02 by Ben Gamari at 2022-04-29T04:12:05-04:00 Bump bytestring submodule Update to current `master`. - - - - - 01988418 by Matthew Pickering at 2022-04-29T04:12:05-04:00 testsuite: Normalise package versions in UnusedPackages test - - - - - 724d0dc0 by Matthew Pickering at 2022-04-29T08:59:42+00:00 testsuite: Deduplicate ways correctly This was leading to a bug where we would run a profasm test twice which led to invalid junit.xml which meant the test results database was not being populated for the fedora33-perf job. - - - - - 5630dde6 by Ben Gamari at 2022-04-29T13:06:20-04:00 rts: Refactor handling of dead threads' stacks This fixes a bug that @JunmingZhao42 and I noticed while working on her MMTK port. Specifically, in stg_stop_thread we used stg_enter_info as a sentinel at the tail of a stack after a thread has completed. However, stg_enter_info expects to have a two-field payload, which we do not push. Consequently, if the GC ends up somehow the stack it will attempt to interpret data past the end of the stack as the frame's fields, resulting in unsound behavior. To fix this I eliminate this hacky use of `stg_stop_thread` and instead introduce a new stack frame type, `stg_dead_thread_info`. Not only does this eliminate the potential for the previously mentioned memory unsoundness but it also more clearly captures the intended structure of the dead threads' stacks. - - - - - 0cdef807 by parsonsmatt at 2022-04-30T16:51:12-04:00 Add a note about instance visibility across component boundaries In principle, the *visible* instances are * all instances defined in a prior top-level declaration group (see docs on `newDeclarationGroup`), or * all instances defined in any module transitively imported by the module being compiled However, actually searching all modules transitively below the one being compiled is unreasonably expensive, so `reifyInstances` will report only the instance for modules that GHC has had some cause to visit during this compilation. This is a shortcoming: `reifyInstances` might fail to report instances for a type that is otherwise unusued, or instances defined in a different component. You can work around this shortcoming by explicitly importing the modules whose instances you want to be visible. GHC issue #20529 has some discussion around this. Fixes #20529 - - - - - e2dd884a by Ryan Scott at 2022-04-30T16:51:47-04:00 Make mkFunCo take AnonArgFlags into account Previously, whenever `mkFunCo` would produce reflexive coercions, it would use `mkVisFunTy` to produce the kind of the coercion. However, `mkFunCo` is also used to produce coercions between types of the form `ty1 => ty2` in certain places. This has the unfortunate side effect of causing the type of the coercion to appear as `ty1 -> ty2` in certain error messages, as spotted in #21328. This patch address this by changing replacing the use of `mkVisFunTy` with `mkFunctionType` in `mkFunCo`. `mkFunctionType` checks the kind of `ty1` and makes the function arrow `=>` instead of `->` if `ty1` has kind `Constraint`, so this should always produce the correct `AnonArgFlag`. As a result, this patch fixes part (2) of #21328. This is not the only possible way to fix #21328, as the discussion on that issue lists some possible alternatives. Ultimately, it was concluded that the alternatives would be difficult to maintain, and since we already use `mkFunctionType` in `coercionLKind` and `coercionRKind`, using `mkFunctionType` in `mkFunCo` is consistent with this choice. Moreover, using `mkFunctionType` does not regress the performance of any test case we have in GHC's test suite. - - - - - 170da54f by Ben Gamari at 2022-04-30T16:52:27-04:00 Convert More Diagnostics (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors. - - - - - 39edc7b4 by Marius Ghita at 2022-04-30T16:53:06-04:00 Update user guide example rewrite rules formatting Change the rewrite rule examples to include a space between the composition of `f` and `g` in the map rewrite rule examples. Without this change, if the user has locally enabled the extension OverloadedRecordDot the copied example will result in a compile time error that `g` is not a field of `f`. ``` • Could not deduce (GHC.Records.HasField "g" (a -> b) (a1 -> b)) arising from selecting the field ‘g’ ``` - - - - - 2e951e48 by Adam Sandberg Ericsson at 2022-04-30T16:53:42-04:00 ghc-boot: export typesynonyms from GHC.Utils.Encoding This makes the Haddocks easier to understand. - - - - - d8cbc77e by Adam Sandberg Ericsson at 2022-04-30T16:54:18-04:00 users guide: add categories to some flags - - - - - d0f14fad by Chris Martin at 2022-04-30T16:54:57-04:00 hacking guide: mention the core libraries committee - - - - - 34b28200 by Matthew Pickering at 2022-04-30T16:55:32-04:00 Revert "Make the specialiser handle polymorphic specialisation" This reverts commit ef0135934fe32da5b5bb730dbce74262e23e72e8. See ticket #21229 ------------------------- Metric Decrease: T15164 Metric Increase: T13056 ------------------------- - - - - - ee891c1e by Matthew Pickering at 2022-04-30T16:55:32-04:00 Add test for T21229 - - - - - ab677cc8 by Matthew Pickering at 2022-04-30T16:56:08-04:00 Hadrian: Update README about the flavour/testsuite contract There have been a number of tickets about non-tested flavours not passing the testsuite.. this is expected and now noted in the documentation. You use other flavours to run the testsuite at your own risk. Fixes #21418 - - - - - b57b5b92 by Ben Gamari at 2022-04-30T16:56:44-04:00 rts/m32: Fix assertion failure This fixes an assertion failure in the m32 allocator due to the imprecisely specified preconditions of `m32_allocator_push_filled_list`. Specifically, the caller must ensure that the page type is set to filled prior to calling `m32_allocator_push_filled_list`. While this issue did result in an assertion failure in the debug RTS, the issue is in fact benign. - - - - - a7053a6c by sheaf at 2022-04-30T16:57:23-04:00 Testsuite driver: don't crash on empty metrics The testsuite driver crashed when trying to display minimum/maximum performance changes when there are no metrics (i.e. there is no baseline available). This patch fixes that. - - - - - 636f7c62 by Andreas Klebinger at 2022-05-01T22:21:17-04:00 StgLint: Check that functions are applied to compatible runtime reps We use compatibleRep to compare reps, and avoid checking functions with levity polymorphic types because of #21399. - - - - - 60071076 by Hécate Moonlight at 2022-05-01T22:21:55-04:00 Add documentation to the ByteArray# primetype. close #21417 - - - - - 2b2e3020 by Andreas Klebinger at 2022-05-01T22:22:31-04:00 exprIsDeadEnd: Use isDeadEndAppSig to check if a function appliction is bottoming. We used to check the divergence and that the number of arguments > arity. But arity zero represents unknown arity so this was subtly broken for a long time! We would check if the saturated function diverges, and if we applied >=arity arguments. But for unknown arity functions any number of arguments is >=idArity. This fixes #21440. - - - - - 4eaf0f33 by Eric Lindblad at 2022-05-01T22:23:11-04:00 typos - - - - - fc58df90 by Niklas Hambüchen at 2022-05-02T08:59:27+00:00 libraries/base: docs: Explain relationshipt between `finalizeForeignPtr` and `*Conc*` creation Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/21420 - - - - - 3e400f20 by Krzysztof Gogolewski at 2022-05-02T18:29:23-04:00 Remove obsolete code in CoreToStg Note [Nullary unboxed tuple] was removed in e9e61f18a548b70693f4. This codepath is tested by T15696_3. - - - - - 4a780928 by Krzysztof Gogolewski at 2022-05-02T18:29:24-04:00 Fix several note references - - - - - 15ffe2b0 by Sebastian Graf at 2022-05-03T20:11:51+02:00 Assume at least one evaluation for nested SubDemands (#21081, #21133) See the new `Note [SubDemand denotes at least one evaluation]`. A demand `n :* sd` on a let binder `x=e` now means > "`x` was evaluated `n` times and in any program trace it is evaluated, `e` is > evaluated deeply in sub-demand `sd`." The "any time it is evaluated" premise is what this patch adds. As a result, we get better nested strictness. For example (T21081) ```hs f :: (Bool, Bool) -> (Bool, Bool) f pr = (case pr of (a,b) -> a /= b, True) -- before: <MP(L,L)> -- after: <MP(SL,SL)> g :: Int -> (Bool, Bool) g x = let y = let z = odd x in (z,z) in f y ``` The change in demand signature "before" to "after" allows us to case-bind `z` here. Similarly good things happen for the `sd` in call sub-demands `Cn(sd)`, which allows for more eta-reduction (which is only sound with `-fno-pedantic-bottoms`, albeit). We also fix #21085, a surprising inconsistency with `Poly` to `Call` sub-demand expansion. In an attempt to fix a regression caused by less inlining due to eta-reduction in T15426, I eta-expanded the definition of `elemIndex` and `elemIndices`, thus fixing #21345 on the go. The main point of this patch is that it fixes #21081 and #21133. Annoyingly, I discovered that more precise demand signatures for join points can transform a program into a lazier program if that join point gets floated to the top-level, see #21392. There is no simple fix at the moment, but !5349 might. Thus, we accept a ~5% regression in `MultiLayerModulesTH_OneShot`, where #21392 bites us in `addListToUniqDSet`. T21392 reliably reproduces the issue. Surprisingly, ghc/alloc perf on Windows improves much more than on other jobs, by 0.4% in the geometric mean and by 2% in T16875. Metric Increase: MultiLayerModulesTH_OneShot Metric Decrease: T16875 - - - - - 948c7e40 by Andreas Klebinger at 2022-05-04T09:57:34-04:00 CoreLint - When checking for levity polymorphism look through more ticks. For expressions like `(scc<cc_name> primOp#) arg1` we should also look at arg1 to determine if we call primOp# at a fixed runtime rep. This is what corePrep already does but CoreLint didn't yet. This patch will bring them in sync in this regard. It also uses tickishFloatable in CorePrep instead of CorePrep having it's own slightly differing definition of when a tick is floatable. - - - - - 85bc73bd by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Support Unicode properly - - - - - 063d485e by Alexis King at 2022-05-04T09:58:14-04:00 genprimopcode: Replace LaTeX documentation syntax with Haddock The LaTeX documentation generator does not seem to have been used for quite some time, so the LaTeX-to-Haddock preprocessing step has become a pointless complication that makes documenting the contents of GHC.Prim needlessly difficult. This commit replaces the LaTeX syntax with the Haddock it would have been converted into, anyway, though with an additional distinction: it uses single quotes in places to instruct Haddock to generate hyperlinks to bindings. This improves the quality of the generated output. - - - - - d61f7428 by Ben Gamari at 2022-05-04T09:58:50-04:00 rts/ghc.mk: Only build StgCRunAsm.S when it is needed Previously the make build system unconditionally included StgCRunAsm.S in the link, meaning that the RTS would require an execstack unnecessarily. Fixes #21478. - - - - - 934a90dd by Simon Peyton Jones at 2022-05-04T16:15:34-04:00 Improve error reporting in generated code Our error reporting in generated code (via desugaring before typechecking) only worked when the generated code was just a simple call. This commit makes it work in nested cases. - - - - - 445d3657 by sheaf at 2022-05-04T16:16:12-04:00 Ensure Any is not levity-polymorphic in FFI The previous patch forgot to account for a type such as Any @(TYPE (BoxedRep l)) for a quantified levity variable l. - - - - - ddd2591c by Ben Gamari at 2022-05-04T16:16:48-04:00 Update supported LLVM versions Pull forward minimum version to match 9.2. (cherry picked from commit c26faa54c5fbe902ccb74e79d87e3fa705e270d1) - - - - - f9698d79 by Ben Gamari at 2022-05-04T16:16:48-04:00 testsuite/T7275: Use sed -r Darwin requires the `-r` flag to be compatible with GNU sed. (cherry picked from commit 512338c8feec96c38ef0cf799f3a01b77c967c56) - - - - - 8635323b by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Use ld.lld on ARMv7/Linux Due to #16177. Also cleanup some code style issues. (cherry picked from commit cc1c3861e2372f464bf9e3c9c4d4bd83f275a1a6) - - - - - 4f6370c7 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Always preserve artifacts, even in failed jobs (cherry picked from commit fd08b0c91ea3cab39184f1b1b1aafcd63ce6973f) - - - - - 6f662754 by Ben Gamari at 2022-05-04T16:16:48-04:00 configure: Make sphinx version check more robust It appears that the version of sphinx shipped on CentOS 7 reports a version string of `Sphinx v1...`. Accept the `v`. (cherry picked from commit a9197a292fd4b13308dc6664c01351c7239357ed) - - - - - 0032dc38 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab-ci: Don't run make job in release pipelines (cherry picked from commit 16d6a8ff011f2194485387dcca1c00f8ddcdbdeb) - - - - - 27f9aab3 by Ben Gamari at 2022-05-04T16:16:48-04:00 gitlab/ci: Fix name of bootstrap compiler directory Windows binary distributions built with Hadrian have a target platform suffix in the name of their root directory. Teach `ci.sh` about this fact. (cherry picked from commit df5752f39671f6d04d8cd743003469ae5eb67235) - - - - - b528f0f6 by Krzysztof Gogolewski at 2022-05-05T09:05:43-04:00 Fix several note references, part 2 - - - - - 691aacf6 by Adam Sandberg Ericsson at 2022-05-05T09:06:19-04:00 adjustors: align comment about number of integer like arguments with implementation for Amd4+MinGW implementation - - - - - f050557e by Simon Jakobi at 2022-05-05T12:47:32-04:00 Remove two uses of IntMap.size IntMap.size is O(n). The new code should be slightly more efficient. The transformation of GHC.CmmToAsm.CFG.calcFreqs.nodeCount can be described formally as the transformation: (\sum_{0}^{n-1} \sum_{0}^{k-1} i_nk) + n ==> (\sum_{0}^{n-1} 1 + \sum_{0}^{k-1} i_nk) - - - - - 7da90ae3 by Tom Ellis at 2022-05-05T12:48:09-04:00 Explain that 'fail s' should run in the monad itself - - - - - 610d0283 by Matthew Craven at 2022-05-05T12:48:47-04:00 Add a test for the bracketing in rules for (^) - - - - - 016f9ca6 by Matthew Craven at 2022-05-05T12:48:47-04:00 Fix broken rules for (^) with known small powers - - - - - 9372aaab by Matthew Craven at 2022-05-05T12:48:47-04:00 Give the two T19569 tests different names - - - - - 61901b32 by Andreas Klebinger at 2022-05-05T12:49:23-04:00 SpecConstr: Properly create rules for call patterns representing partial applications The main fix is that in addVoidWorkerArg we now add the argument to the front. This fixes #21448. ------------------------- Metric Decrease: T16875 ------------------------- - - - - - 71278dc7 by Teo Camarasu at 2022-05-05T12:50:03-04:00 add since annotations for instances of ByteArray - - - - - 962ff90b by sheaf at 2022-05-05T12:50:42-04:00 Start 9.6.1-notes Updates the documentation notes to start tracking changes for the 9.6.1 release (instead of 9.4). - - - - - aacb15a3 by Matthew Pickering at 2022-05-05T20:24:01-04:00 ci: Add job to check that jobs.yaml is up-to-date There have been quite a few situations where jobs.yaml has been out of date. It's better to add a CI job which checks that it's right. We don't want to use a staged pipeline because it obfuscates the structure of the pipeline. - - - - - be7102e5 by Ben Gamari at 2022-05-05T20:24:37-04:00 rts: Ensure that XMM registers are preserved on Win64 Previously we only preserved the bottom 64-bits of the callee-saved 128-bit XMM registers, in violation of the Win64 calling convention. Fix this. Fixes #21465. - - - - - 73b22ff1 by Ben Gamari at 2022-05-05T20:24:37-04:00 testsuite: Add test for #21465 - - - - - e2ae9518 by Ziyang Liu at 2022-05-06T19:22:22-04:00 Allow `let` just before pure/return in ApplicativeDo The following is currently rejected: ```haskell -- F is an Applicative but not a Monad x :: F (Int, Int) x = do a <- pure 0 let b = 1 pure (a, b) ``` This has bitten me multiple times. This MR contains a simple fix: only allow a "let only" segment to be merged with the next (and not the previous) segment. As a result, when the last one or more statements before pure/return are `LetStmt`s, there will be one more segment containing only those `LetStmt`s. Note that if the `let` statement mentions a name bound previously, then the program is still rejected, for example ```haskell x = do a <- pure 0 let b = a + 1 pure (a, b) ``` or the example in #18559. To support this would require a more complex approach, but this is IME much less common than the previous case. - - - - - 0415449a by Matthew Pickering at 2022-05-06T19:22:58-04:00 template-haskell: Fix representation of OPAQUE pragmas There is a mis-match between the TH representation of OPAQUE pragmas and GHC's internal representation due to how OPAQUE pragmas disallow phase annotations. It seemed most in keeping to just fix the wired in name issue by adding a special case to the desugaring of INLINE pragmas rather than making TH/GHC agree with how the representation should look. Fixes #21463 - - - - - 4de887e2 by Simon Peyton Jones at 2022-05-06T19:23:34-04:00 Comments only: Note [AppCtxt] - - - - - 6e69964d by Matthew Pickering at 2022-05-06T19:24:10-04:00 Fix name of windows release bindist in doc-tarball job - - - - - ced4689e by Matthew Pickering at 2022-05-06T19:24:46-04:00 ci: Generate source-tarball in release jobs We need to distribute the source tarball so we should generate it in the CI pipeline. - - - - - 3c91de21 by Rob at 2022-05-08T13:40:53+02:00 Change Specialise to use OrdList. Fixes #21362 Metric Decrease: T16875 - - - - - 67072c31 by Simon Jakobi at 2022-05-08T12:23:43-04:00 Tweak GHC.CmmToAsm.CFG.delEdge mapAdjust is more efficient than mapAlter. - - - - - 374554bb by Teo Camarasu at 2022-05-09T16:24:37-04:00 Respect -po when heap profiling (#21446) - - - - - 1ea414b6 by Teo Camarasu at 2022-05-09T16:24:37-04:00 add test case for #21446 - - - - - c7902078 by Jens Petersen at 2022-05-09T16:25:17-04:00 avoid hadrian/bindist/Makefile install_docs error when --docs=none When docs are disabled the bindist does not have docs/ and hence docs-utils/ is not generated. Here we just test that docs-utils exists before attempting to install prologue.txt and gen_contents_index to avoid the error: /usr/bin/install: cannot stat 'docs-utils/prologue.txt': No such file or directory make: *** [Makefile:195: install_docs] Error 1 - - - - - 158bd659 by Hécate Moonlight at 2022-05-09T16:25:56-04:00 Correct base's changelog for 4.16.1.0 This commit reaffects the new Ix instances of the foreign integral types from base 4.17 to 4.16.1.0 closes #21529 - - - - - a4fbb589 by Sylvain Henry at 2022-05-09T16:26:36-04:00 STG: only print cost-center if asked to - - - - - 50347ded by Gergo ERDI at 2022-05-10T11:43:33+00:00 Improve "Glomming" note Add a paragraph that clarifies that `occurAnalysePgm` finding out-of-order references, and thus needing to glom, is not a cause for concern when its root cause is rewrite rules. - - - - - df2e3373 by Eric Lindblad at 2022-05-10T20:45:41-04:00 update INSTALL - - - - - dcac3833 by Matthew Pickering at 2022-05-10T20:46:16-04:00 driver: Make -no-keep-o-files -no-keep-hi-files work in --make mode It seems like it was just an oversight to use the incorrect DynFlags (global rather than local) when implementing these two options. Using the local flags allows users to request these intermediate files get cleaned up, which works fine in --make mode because 1. Interface files are stored in memory 2. Object files are only cleaned at the end of session (after link) Fixes #21349 - - - - - 35da81f8 by Ben Gamari at 2022-05-10T20:46:52-04:00 configure: Check for ffi.h As noted in #21485, we checked for ffi.h yet then failed to throw an error if it is missing. Fixes #21485. - - - - - bdc99cc2 by Simon Peyton Jones at 2022-05-10T20:47:28-04:00 Check for uninferrable variables in tcInferPatSynDecl This fixes #21479 See Note [Unquantified tyvars in a pattern synonym] While doing this, I found that some error messages pointed at the pattern synonym /name/, rather than the /declaration/ so I widened the SrcSpan to encompass the declaration. - - - - - 142a73d9 by Matthew Pickering at 2022-05-10T20:48:04-04:00 hadrian: Fix split-sections transformer The splitSections transformer has been broken since -dynamic-too support was implemented in hadrian. This is because we actually build the dynamic way when building the dynamic way, so the predicate would always fail. The fix is to just always pass `split-sections` even if it doesn't do anything for a particular way. Fixes #21138 - - - - - 699f5935 by Matthew Pickering at 2022-05-10T20:48:04-04:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. Closes #21135 - - - - - 21feece2 by Simon Peyton Jones at 2022-05-10T20:48:39-04:00 Use the wrapper for an unlifted binding We assumed the wrapper for an unlifted binding is the identity, but as #21516 showed, that is no always true. Solution is simple: use it. - - - - - 68d1ea5f by Matthew Pickering at 2022-05-10T20:49:15-04:00 docs: Fix path to GHC API docs in index.html In the make bindists we generate documentation in docs/ghc-<VER> but the hadrian bindists generate docs/ghc/ so the path to the GHC API docs was wrong in the index.html file. Rather than make the hadrian and make bindists the same it was easier to assume that if you're using the mkDocs script that you're using hadrian bindists. Fixes #21509 - - - - - 9d8f44a9 by Matthew Pickering at 2022-05-10T20:49:51-04:00 hadrian: Don't pass -j to haddock This has high potential for oversubcribing as many haddock jobs can be spawned in parralel which will each request the given number of capabilities. Once -jsem is implemented (#19416, !5176) we can expose that haddock via haddock and use that to pass a semaphore. Ticket #21136 - - - - - fec3e7aa by Matthew Pickering at 2022-05-10T20:50:27-04:00 hadrian: Only copy and install libffi headers when using in-tree libffi When passed `--use-system-libffi` then we shouldn't copy and install the headers from the system package. Instead the headers are expected to be available as a runtime dependency on the users system. Fixes #21485 #21487 - - - - - 5b791ed3 by mikael at 2022-05-11T08:22:13-04:00 FIND_LLVM_PROG: Recognize llvm suffix used by FreeBSD, ie llc10. - - - - - 8500206e by ARATA Mizuki at 2022-05-11T08:22:57-04:00 Make floating-point abs IEEE 754 compliant The old code used by via-C backend didn't handle the sign bit of NaN. See #21043. - - - - - 4a4c77ed by Alan Zimmerman at 2022-05-11T08:23:33-04:00 EPA: do statement with leading semicolon has wrong anchor The code do; a <- doAsync; b Generated an incorrect Anchor for the statement list that starts after the first semicolon. This commit fixes it. Closes #20256 - - - - - e3ca8dac by Simon Peyton Jones at 2022-05-11T08:24:08-04:00 Specialiser: saturate DFuns correctly Ticket #21489 showed that the saturation mechanism for DFuns (see Note Specialising DFuns) should use both UnspecType and UnspecArg. We weren't doing that; but this MR fixes that problem. No test case because it's hard to tickle, but it showed up in Gergo's work with GHC-as-a-library. - - - - - fcc7dc4c by Ben Gamari at 2022-05-11T20:05:41-04:00 gitlab-ci: Check for dynamic msys2 dependencies Both #20878 and #21196 were caused by unwanted dynamic dependencies being introduced by boot libraries. Ensure that we catch this in CI by attempting to run GHC in an environment with a minimal PATH. - - - - - 3c998f0d by Matthew Pickering at 2022-05-11T20:06:16-04:00 Add back Debian9 CI jobs We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19 not being at EOL until April 2023 and they still need tinfo5. Fixes #21469 - - - - - dea9a3d9 by Ben Gamari at 2022-05-11T20:06:51-04:00 rts: Drop setExecutable Since f6e366c058b136f0789a42222b8189510a3693d1 setExecutable has been dead code. Drop it. - - - - - 32cdf62d by Simon Peyton Jones at 2022-05-11T20:07:27-04:00 Add a missing guard in GHC.HsToCore.Utils.is_flat_prod_pat This missing guard gave rise to #21519. - - - - - 2c00a8d0 by Matthew Pickering at 2022-05-11T20:08:02-04:00 Add mention of -hi to RTS --help Fixes #21546 - - - - - a2dcad4e by Andre Marianiello at 2022-05-12T02:15:48+00:00 Decouple dynflags in Cmm parser (related to #17957) - - - - - 3a022baa by Andre Marianiello at 2022-05-12T02:15:48+00:00 Remove Module argument from initCmmParserConfig - - - - - 2fc8d76b by Andre Marianiello at 2022-05-12T02:15:48+00:00 Move CmmParserConfig and PDConfig into GHC.Cmm.Parser.Config - - - - - b8c5ffab by Andre Marianiello at 2022-05-12T18:13:55-04:00 Decouple dynflags in GHC.Core.Opt.Arity (related to #17957) Metric Decrease: T16875 - - - - - 3bf938b6 by sheaf at 2022-05-12T18:14:34-04:00 Update extending_ghc for TcPlugin changes The documentation still mentioned Derived constraints and an outdated datatype TcPluginResult. - - - - - 668a9ef4 by jackohughes at 2022-05-13T12:10:34-04:00 Fix printing of brackets in multiplicities (#20315) Change mulArrow to allow for printing of correct application precedence where necessary and update callers of mulArrow to reflect this. As part of this, move mulArrow from GHC/Utils/Outputtable to GHC/Iface/Type. Fixes #20315 - - - - - 30b8b7f1 by Ben Gamari at 2022-05-13T12:11:09-04:00 rts: Add debug output on ocResolve failure This makes it easier to see how resolution failures nest. - - - - - 53b3fa1c by Ben Gamari at 2022-05-13T12:11:09-04:00 rts/PEi386: Fix handling of weak symbols Previously we would flag the symbol as weak but failed to set its address, which must be computed from an "auxiliary" symbol entry the follows the weak symbol. Fixes #21556. - - - - - 5678f017 by Ben Gamari at 2022-05-13T12:11:09-04:00 testsuite: Add tests for #21556 - - - - - 49af0e52 by Ben Gamari at 2022-05-13T22:23:26-04:00 Re-export augment and build from GHC.List Resolves https://gitlab.haskell.org/ghc/ghc/-/issues/19127 - - - - - aed356e1 by Simon Peyton Jones at 2022-05-13T22:24:02-04:00 Comments only around HsWrapper - - - - - 27b90409 by Ben Gamari at 2022-05-16T08:30:44-04:00 hadrian: Introduce linting flavour transformer (+lint) The linting flavour enables -dlint uniformly across anything build by the stage1 compiler. -dcmm-lint is not currently enabled because it fails on i386 (see #21563) - - - - - 3f316776 by Matthew Pickering at 2022-05-16T08:30:44-04:00 hadrian: Uniformly enable -dlint with enableLinting transformer This fixes some bugs where * -dcore-lint was being passed when building stage1 libraries with the boot compiler * -dcore-lint was not being passed when building executables. Fixes #20135 - - - - - 3d74cfca by Andreas Klebinger at 2022-05-16T08:31:20-04:00 Make closure macros EXTERN_INLINE to make debugging easier Implements #21424. The RTS macros get_itbl and friends are extremely helpful during debugging. However only a select few of those were available in the compiled RTS as actual symbols as the rest were INLINE macros. This commit marks all of them as EXTERN_INLINE. This will still inline them at use sites but allow us to use their compiled counterparts during debugging. This allows us to use things like `p get_fun_itbl(ptr)` in the gdb shell since `get_fun_itbl` will now be available as symbol! - - - - - 93153aab by Matthew Pickering at 2022-05-16T08:31:55-04:00 packaging: Introduce CI job for generating hackage documentation This adds a CI job (hackage-doc-tarball) which generates the necessary tarballs for uploading libraries and documentation to hackage. The release script knows to download this folder and the upload script will also upload the release to hackage as part of the release. The `ghc_upload_libs` script is moved from ghc-utils into .gitlab/ghc_upload_libs There are two modes, preparation and upload. * The `prepare` mode takes a link to a bindist and creates a folder containing the source and doc tarballs ready to upload to hackage. * The `upload` mode takes the folder created by prepare and performs the upload to hackage. Fixes #21493 Related to #21512 - - - - - 65d31d05 by Simon Peyton Jones at 2022-05-16T15:32:50-04:00 Add arity to the INLINE pragmas for pattern synonyms The lack of INLNE arity was exposed by #21531. The fix is simple enough, if a bit clumsy. - - - - - 43c018aa by Krzysztof Gogolewski at 2022-05-16T15:33:25-04:00 Misc cleanup - Remove groupWithName (unused) - Use the RuntimeRepType synonym where possible - Replace getUniqueM + mkSysLocalOrCoVar with mkSysLocalOrCoVarM No functional changes. - - - - - 8dfea078 by Pavol Vargovcik at 2022-05-16T15:34:04-04:00 TcPlugin: access to irreducible givens + fix passed ev_binds_var - - - - - fb579e15 by Ben Gamari at 2022-05-17T00:25:02-04:00 driver: Introduce pgmcxx Here we introduce proper support for compilation of C++ objects. This includes: * logic in `configure` to detect the C++ toolchain and propagating this information into the `settings` file * logic in the driver to use the C++ toolchain when compiling C++ sources - - - - - 43628ed4 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Build T20918 with HC, not CXX - - - - - 0ef249aa by Ben Gamari at 2022-05-17T00:25:02-04:00 Introduce package to capture dependency on C++ stdlib Here we introduce a new "virtual" package into the initial package database, `system-cxx-std-lib`. This gives users a convenient, platform agnostic way to link against C++ libraries, addressing #20010. Fixes #20010. - - - - - 03efe283 by Ben Gamari at 2022-05-17T00:25:02-04:00 testsuite: Add tests for system-cxx-std-lib package Test that we can successfully link against C++ code both in GHCi and batch compilation. See #20010 - - - - - 5f6527e0 by nineonine at 2022-05-17T00:25:38-04:00 OverloadedRecordFields: mention parent name in 'ambiguous occurrence' error for better disambiguation (#17420) - - - - - eccdb208 by Simon Peyton Jones at 2022-05-17T07:16:39-04:00 Adjust flags for pprTrace We were using defaultSDocContext for pprTrace, which suppresses lots of useful infomation. This small MR adds GHC.Utils.Outputable.traceSDocContext and uses it for pprTrace and pprTraceUserWarning. traceSDocContext is a global, and hence not influenced by flags, but that seems unavoidable. But I made the sdocPprDebug bit controlled by unsafeHasPprDebug, since we have the latter for exactly this purpose. Fixes #21569 - - - - - d2284c4c by Simon Peyton Jones at 2022-05-17T07:17:15-04:00 Fix bad interaction between withDict and the Specialiser This MR fixes a bad bug, where the withDict was inlined too vigorously, which in turn made the type-class Specialiser generate a bogus specialisation, because it saw the same overloaded function applied to two /different/ dictionaries. Solution: inline `withDict` later. See (WD8) of Note [withDict] in GHC.HsToCore.Expr See #21575, which is fixed by this change. - - - - - 70f52443 by Matthew Pickering at 2022-05-17T07:17:50-04:00 Bump time submodule to 1.12.2 This bumps the time submodule to the 1.12.2 release. Fixes #21571 - - - - - 2343457d by Vladislav Zavialov at 2022-05-17T07:18:26-04:00 Remove unused test files (#21582) Those files were moved to the perf/ subtree in 11c9a469, and then accidentally reintroduced in 680ef2c8. - - - - - cb52b4ae by Ben Gamari at 2022-05-17T16:00:14-04:00 CafAnal: Improve code clarity Here we implement a few measures to improve the clarity of the CAF analysis implementation. Specifically: * Use CafInfo instead of Bool since the former is more descriptive * Rename CAFLabel to CAFfyLabel, since not all CAFfyLabels are in fact CAFs * Add numerous comments - - - - - b048a9f4 by Ben Gamari at 2022-05-17T16:00:14-04:00 codeGen: Ensure that static datacon apps are included in SRTs When generating an SRT for a recursive group, GHC.Cmm.Info.Build.oneSRT filters out recursive references, as described in Note [recursive SRTs]. However, doing so for static functions would be unsound, for the reason described in Note [Invalid optimisation: shortcutting]. However, the same argument applies to static data constructor applications, as we discovered in #20959. Fix this by ensuring that static data constructor applications are included in recursive SRTs. The approach here is not entirely satisfactory, but it is a starting point. Fixes #20959. - - - - - 0e2d16eb by Matthew Pickering at 2022-05-17T16:00:50-04:00 Add test for #21558 This is now fixed on master and 9.2 branch. Closes #21558 - - - - - ef3c8d9e by Sylvain Henry at 2022-05-17T20:22:02-04:00 Don't store LlvmConfig into DynFlags LlvmConfig contains information read from llvm-passes and llvm-targets files in GHC's top directory. Reading these files is done only when needed (i.e. when the LLVM backend is used) and cached for the whole compiler session. This patch changes the way this is done: - Split LlvmConfig into LlvmConfig and LlvmConfigCache - Store LlvmConfigCache in HscEnv instead of DynFlags: there is no good reason to store it in DynFlags. As it is fixed per session, we store it in the session state instead (HscEnv). - Initializing LlvmConfigCache required some changes to driver functions such as newHscEnv. I've used the opportunity to untangle initHscEnv from initGhcMonad (in top-level GHC module) and to move it to GHC.Driver.Main, close to newHscEnv. - I've also made `cmmPipeline` independent of HscEnv in order to remove the call to newHscEnv in regalloc_unit_tests. - - - - - 828fbd8a by Andreas Klebinger at 2022-05-17T20:22:38-04:00 Give all EXTERN_INLINE closure macros prototypes - - - - - cfc8e2e2 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Introduce [sg]etFinalizerExceptionHandler This introduces a global hook which is called when an exception is thrown during finalization. - - - - - 372cf730 by Ben Gamari at 2022-05-19T04:57:51-04:00 base: Throw exceptions raised while closing finalized Handles Fixes #21336. - - - - - 3dd2f944 by Ben Gamari at 2022-05-19T04:57:51-04:00 testsuite: Add tests for #21336 - - - - - 297156e0 by Matthew Pickering at 2022-05-19T04:58:27-04:00 Add release flavour and use it for the release jobs The release flavour is essentially the same as the perf flavour currently but also enables `-haddock`. I have hopefully updated all the relevant places where the `-perf` flavour was hardcoded. Fixes #21486 - - - - - a05b6293 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Don't build sphinx documentation on centos The centos docker image lacks the sphinx builder so we disable building sphinx docs for these jobs. Fixes #21580 - - - - - 209d7c69 by Matthew Pickering at 2022-05-19T04:58:27-04:00 ci: Use correct syntax when args list is empty This seems to fail on the ancient version of bash present on CentOS - - - - - 02d16334 by Matthew Pickering at 2022-05-19T04:59:03-04:00 hadrian: Don't attempt to build dynamic profiling libraries We only support building static profiling libraries, the transformer was requesting things like a dynamic, threaded, debug, profiling RTS, which we have never produced nor distributed. Fixes #21567 - - - - - 35bdab1c by Ben Gamari at 2022-05-19T04:59:39-04:00 configure: Check CC_STAGE0 for --target support We previously only checked the stage 1/2 compiler for --target support. We got away with this for quite a while but it eventually caught up with us in #21579, where `bytestring`'s new NEON implementation was unbuildable on Darwin due to Rosetta's seemingly random logic for determining which executable image to execute. This lead to a confusing failure to build `bytestring`'s cbits, when `clang` tried to compile NEON builtins while targetting x86-64. Fix this by checking CC_STAGE0 for --target support. Fixes #21579. - - - - - 0ccca94b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator analysis of `CmmGraph` This commit adds module `GHC.Cmm.Dominators`, which provides a wrapper around two existing algorithms in GHC: the Lengauer-Tarjan dominator analysis from the X86 back end and the reverse postorder ordering from the Cmm Dataflow framework. Issue #20726 proposes that we evaluate some alternatives for dominator analysis, but for the time being, the best path forward is simply to use the existing analysis on `CmmGraph`s. This commit addresses a bullet in #21200. - - - - - 54f0b578 by Norman Ramsey at 2022-05-20T05:32:32-04:00 add dominator-tree function - - - - - 05ed917b by Norman Ramsey at 2022-05-20T05:32:32-04:00 add HasDebugCallStack; remove unneeded extensions - - - - - 0b848136 by Andreas Klebinger at 2022-05-20T05:32:32-04:00 document fields of `DominatorSet` - - - - - 8a26e8d6 by Ben Gamari at 2022-05-20T05:33:08-04:00 nonmoving: Fix documentation of GC statistics fields These were previously incorrect. Fixes #21553. - - - - - c1e24e61 by Matthew Pickering at 2022-05-20T05:33:44-04:00 Remove pprTrace from pushCoercionIntoLambda (#21555) This firstly caused spurious output to be emitted (as evidenced by #21555) but even worse caused a massive coercion to be attempted to be printed (> 200k terms) which would invariably eats up all the memory of your computer. The good news is that removing this trace allows the program to compile to completion, the bad news is that the program exhibits a core lint error (on 9.0.2) but not any other releases it seems. Fixes #21577 and #21555 - - - - - a36d12ee by Zubin Duggal at 2022-05-20T10:44:35-04:00 docs: Fix LlvmVersion in manpage (#21280) - - - - - 36b8a57c by Matthew Pickering at 2022-05-20T10:45:10-04:00 validate: Use $make rather than make In the validate script we are careful to use the $make variable as this stores whether we are using gmake, make, quiet mode etc. There was just this one place where we failed to use it. Fixes #21598 - - - - - 4aa3c5bd by Norman Ramsey at 2022-05-21T03:11:04+00:00 Change `Backend` type and remove direct dependencies With this change, `Backend` becomes an abstract type (there are no more exposed value constructors). Decisions that were formerly made by asking "is the current back end equal to (or different from) this named value constructor?" are now made by interrogating the back end about its properties, which are functions exported by `GHC.Driver.Backend`. There is a description of how to migrate code using `Backend` in the user guide. Clients using the GHC API can find a backdoor to access the Backend datatype in GHC.Driver.Backend.Internal. Bumps haddock submodule. Fixes #20927 - - - - - ecf5f363 by Julian Ospald at 2022-05-21T12:51:16-04:00 Respect DESTDIR in hadrian bindist Makefile, fixes #19646 - - - - - 7edd991e by Julian Ospald at 2022-05-21T12:51:16-04:00 Test DESTDIR in test_hadrian() - - - - - ea895b94 by Matthew Pickering at 2022-05-22T21:57:47-04:00 Consider the stage of typeable evidence when checking stage restriction We were considering all Typeable evidence to be "BuiltinInstance"s which meant the stage restriction was going unchecked. In-fact, typeable has evidence and so we need to apply the stage restriction. This is complicated by the fact we don't generate typeable evidence and the corresponding DFunIds until after typechecking is concluded so we introcue a new `InstanceWhat` constructor, BuiltinTypeableInstance which records whether the evidence is going to be local or not. Fixes #21547 - - - - - ffbe28e5 by Dominik Peteler at 2022-05-22T21:58:23-04:00 Modularize GHC.Core.Opt.LiberateCase Progress towards #17957 - - - - - bc723ac2 by Simon Peyton Jones at 2022-05-23T17:09:34+01:00 Improve FloatOut and SpecConstr This patch addresses a relatively obscure situation that arose when chasing perf regressions in !7847, which itself is fixing It does two things: * SpecConstr can specialise on ($df d1 d2) dictionary arguments * FloatOut no longer checks argument strictness See Note [Specialising on dictionaries] in GHC.Core.Opt.SpecConstr. A test case is difficult to construct, but it makes a big difference in nofib/real/eff/VSM, at least when we have the patch for #21286 installed. (The latter stops worker/wrapper for dictionary arguments). There is a spectacular, but slightly illusory, improvement in runtime perf on T15426. I have documented the specifics in T15426 itself. Metric Decrease: T15426 - - - - - 1a4195b0 by John Ericson at 2022-05-23T17:33:59-04:00 Make debug a `Bool` not an `Int` in `StgToCmmConfig` We don't need any more resolution than this. Rename the field to `stgToCmmEmitDebugInfo` to indicate it is no longer conveying any "level" information. - - - - - e9fff12b by Alan Zimmerman at 2022-05-23T21:04:49-04:00 EPA : Remove duplicate comments in DataFamInstD The code data instance Method PGMigration = MigrationQuery Query -- ^ Run a query against the database | MigrationCode (Connection -> IO (Either String ())) -- ^ Run any arbitrary IO code Resulted in two instances of the "-- ^ Run a query against the database" comment appearing in the Exact Print Annotations when it was parsed. Ensure only one is kept. Closes #20239 - - - - - e2520df3 by Alan Zimmerman at 2022-05-23T21:05:27-04:00 EPA: Comment Order Reversed Make sure comments captured in the exact print annotations are in order of increasing location Closes #20718 - - - - - 4b45fd72 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Add test for T21455 - - - - - e2cd1d43 by Teo Camarasu at 2022-05-24T10:49:13-04:00 Allow passing -po outside profiling way Resolves #21455 - - - - - 3b8c413a by Greg Steuck at 2022-05-24T10:49:52-04:00 Fix haddock_*_perf tests on non-GNU-grep systems Using regexp pattern requires `egrep` and straight up `+`. The haddock_parser_perf and haddock_renamer_perf tests now pass on OpenBSD. They previously incorrectly parsed the files and awk complained about invalid syntax. - - - - - 1db877a3 by Ben Gamari at 2022-05-24T10:50:28-04:00 hadrian/bindist: Drop redundant include of install.mk `install.mk` is already included by `config.mk`. Moreover, `install.mk` depends upon `config.mk` to set `RelocatableBuild`, making this first include incorrect. - - - - - f485d267 by Greg Steuck at 2022-05-24T10:51:08-04:00 Remove -z wxneeded for OpenBSD With all the recent W^X fixes in the loader this workaround is not necessary any longer. I verified that the only tests failing for me on OpenBSD 7.1-current are the same (libc++ related) before and after this commit (with --fast). - - - - - 7c51177d by Andreas Klebinger at 2022-05-24T22:13:19-04:00 Use UnionListsOrd instead of UnionLists in most places. This should get rid of most, if not all "Overlong lists" errors and fix #20016 - - - - - 81b3741f by Andreas Klebinger at 2022-05-24T22:13:55-04:00 Fix #21563 by using Word64 for 64bit shift code. We use the 64bit shifts only on 64bit platforms. But we compile the code always so compiling it on 32bit caused a lint error. So use Word64 instead. - - - - - 2c25fff6 by Zubin Duggal at 2022-05-24T22:14:30-04:00 Fix compilation with -haddock on GHC <= 8.10 -haddock on GHC < 9.0 is quite fragile and can result in obtuse parse errors when it encounters invalid haddock syntax. This has started to affect users since 297156e0b8053a28a860e7a18e1816207a59547b enabled -haddock by default on many flavours. Furthermore, since we don't test bootstrapping with 8.10 on CI, this problem managed to slip throught the cracks. - - - - - cfb9faff by sheaf at 2022-05-24T22:15:12-04:00 Hadrian: don't add "lib" for relocatable builds The conditional in hadrian/bindist/Makefile depended on the target OS, but it makes more sense to use whether we are using a relocatable build. (Currently this only gets set to true on Windows, but this ensures that the logic stays correctly coupled.) - - - - - 9973c016 by Andre Marianiello at 2022-05-25T01:36:09-04:00 Remove HscEnv from GHC.HsToCore.Usage (related to #17957) Metric Decrease: T16875 - - - - - 2ff18e39 by sheaf at 2022-05-25T01:36:48-04:00 SimpleOpt: beta-reduce through casts The simple optimiser would sometimes fail to beta-reduce a lambda when there were casts in between the lambda and its arguments. This can cause problems because we rely on representation-polymorphic lambdas getting beta-reduced away (for example, those that arise from newtype constructors with representation-polymorphic arguments, with UnliftedNewtypes). - - - - - e74fc066 by CarrieMY at 2022-05-25T16:43:03+02:00 Desugar RecordUpd in `tcExpr` This patch typechecks record updates by desugaring them inside the typechecker using the HsExpansion mechanism, and then typechecking this desugared result. Example: data T p q = T1 { x :: Int, y :: Bool, z :: Char } | T2 { v :: Char } | T3 { x :: Int } | T4 { p :: Float, y :: Bool, x :: Int } | T5 The record update `e { x=e1, y=e2 }` desugars as follows e { x=e1, y=e2 } ===> let { x' = e1; y' = e2 } in case e of T1 _ _ z -> T1 x' y' z T4 p _ _ -> T4 p y' x' The desugared expression is put into an HsExpansion, and we typecheck that. The full details are given in Note [Record Updates] in GHC.Tc.Gen.Expr. Fixes #2595 #3632 #10808 #10856 #16501 #18311 #18802 #21158 #21289 Updates haddock submodule - - - - - 2b8bdab8 by Eric Lindblad at 2022-05-26T03:21:58-04:00 update README - - - - - 3d7e7e84 by BinderDavid at 2022-05-26T03:22:38-04:00 Replace dead link in Haddock documentation of Control.Monad.Fail (fixes #21602) - - - - - ee61c7f9 by John Ericson at 2022-05-26T03:23:13-04:00 Add Haddocks for `WwOpts` - - - - - da5ccf0e by Dominik Peteler at 2022-05-26T03:23:13-04:00 Avoid global compiler state for `GHC.Core.Opt.WorkWrap` Progress towards #17957 - - - - - 3bd975b4 by sheaf at 2022-05-26T03:23:52-04:00 Optimiser: avoid introducing bad rep-poly The functions `pushCoValArg` and `pushCoercionIntoLambda` could introduce bad representation-polymorphism. Example: type RR :: RuntimeRep type family RR where { RR = IntRep } type F :: TYPE RR type family F where { F = Int# } co = GRefl F (TYPE RR[0]) :: (F :: TYPE RR) ~# (F |> TYPE RR[0] :: TYPE IntRep) f :: F -> () `pushCoValArg` would transform the unproblematic application (f |> (co -> <()>)) (arg :: F |> TYPE RR[0]) into an application in which the argument does not have a fixed `RuntimeRep`: f ((arg |> sym co) :: (F :: TYPE RR)) - - - - - b22979fb by Fraser Tweedale at 2022-05-26T06:14:51-04:00 executablePath test: fix file extension treatment The executablePath test strips the file extension (if any) when comparing the query result with the expected value. This is to handle platforms where GHC adds a file extension to the output program file (e.g. .exe on Windows). After the initial check, the file gets deleted (if supported). However, it tries to delete the *stripped* filename, which is incorrect. The test currently passes only because Windows does not allow deleting the program while any process created from it is alive. Make the test program correct in general by deleting the *non-stripped* executable filename. - - - - - afde4276 by Fraser Tweedale at 2022-05-26T06:14:51-04:00 fix executablePath test for NetBSD executablePath support for NetBSD was added in a172be07e3dce758a2325104a3a37fc8b1d20c9c, but the test was not updated. Update the test so that it works for NetBSD. This requires handling some quirks: - The result of getExecutablePath could include "./" segments. Therefore use System.FilePath.equalFilePath to compare paths. - The sysctl(2) call returns the original executable name even after it was deleted. Add `canQueryAfterDelete :: [FilePath]` and adjust expectations for the post-delete query accordingly. Also add a note to the `executablePath` haddock to advise that NetBSD behaves differently from other OSes when the file has been deleted. Also accept a decrease in memory usage for T16875. On Windows, the metric is -2.2% of baseline, just outside the allowed ±2%. I don't see how this commit could have influenced this metric, so I suppose it's something in the CI environment. Metric Decrease: T16875 - - - - - d0e4355a by John Ericson at 2022-05-26T06:15:30-04:00 Factor out `initArityOps` to `GHC.Driver.Config.*` module We want `DynFlags` only mentioned in `GHC.Driver`. - - - - - 44bb7111 by romes at 2022-05-26T16:27:57+00:00 TTG: Move MatchGroup Origin field and MatchGroupTc to GHC.Hs - - - - - 88e58600 by sheaf at 2022-05-26T17:38:43-04:00 Add tests for eta-expansion of data constructors This patch adds several tests relating to the eta-expansion of data constructors, including UnliftedNewtypes and DataTypeContexts. - - - - - d87530bb by Richard Eisenberg at 2022-05-26T23:20:14-04:00 Generalize breakTyVarCycle to work with TyFamLHS The function breakTyVarCycle_maybe has been installed in a dark corner of GHC to catch some gremlins (a.k.a. occurs-check failures) who lurk there. But it previously only caught gremlins of the form (a ~ ... F a ...), where some of our intrepid users have spawned gremlins of the form (G a ~ ... F (G a) ...). This commit improves breakTyVarCycle_maybe (and renames it to breakTyEqCycle_maybe) to catch the new gremlins. Happily, the change is remarkably small. The gory details are in Note [Type equality cycles]. Test cases: typecheck/should_compile/{T21515,T21473}. - - - - - ed37027f by Hécate Moonlight at 2022-05-26T23:20:52-04:00 [base] Fix the links in the Data.Data module fix #21658 fix #21657 fix #21657 - - - - - 3bd7d5d6 by Krzysztof Gogolewski at 2022-05-27T16:44:48+02:00 Use a class to check validity of withDict This moves handling of the magic 'withDict' function from the desugarer to the typechecker. Details in Note [withDict]. I've extracted a part of T16646Fail to a separate file T16646Fail2, because the new error in 'reify' hides the errors from 'f' and 'g'. WithDict now works with casts, this fixes #21328. Part of #19915 - - - - - b54f6c4f by sheaf at 2022-05-28T21:00:09-04:00 Fix FreeVars computation for mdo Commit acb188e0 introduced a regression in the computation of free variables in mdo statements, as the logic in GHC.Rename.Expr.segmentRecStmts was slightly different depending on whether the recursive do block corresponded to an mdo statement or a rec statment. This patch restores the previous computation for mdo blocks. Fixes #21654 - - - - - 0704295c by Matthew Pickering at 2022-05-28T21:00:45-04:00 T16875: Stabilise (temporarily) by increasing acceptance threshold The theory is that on windows there is some difference in the environment between pipelines on master and merge requests which affects all tests equally but because T16875 barely allocates anything it is the test which is affected the most. See #21557 - - - - - 6341c8ed by Matthew Pickering at 2022-05-28T21:01:20-04:00 make: Fix make maintainer-clean deleting a file tracked by source control Fixes #21659 - - - - - fbf2f254 by Bodigrim at 2022-05-28T21:01:58-04:00 Expand documentation of hIsTerminalDevice - - - - - 0092c67c by Teo Camarasu at 2022-05-29T12:25:39+00:00 export IsList from GHC.IsList it is still re-exported from GHC.Exts - - - - - 91396327 by Sylvain Henry at 2022-05-30T09:40:55-04:00 MachO linker: fix handling of ARM64_RELOC_SUBTRACTOR ARM64_RELOC_SUBTRACTOR relocations are paired with an AMR64_RELOC_UNSIGNED relocation to implement: addend + sym1 - sym2 The linker was doing it in two steps, basically: *addend <- *addend - sym2 *addend <- *addend + sym1 The first operation was likely to overflow. For example when the relocation target was 32-bit and both sym1/sym2 were 64-bit addresses. With the small memory model, (sym1-sym2) would fit in 32 bits but (*addend-sym2) may not. Now the linker does it in one step: *addend <- *addend + sym1 - sym2 - - - - - acc26806 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Some fixes to SRT documentation - reordered the 3 SRT implementation cases from the most general to the most specific one: USE_SRT_POINTER -> USE_SRT_OFFSET -> USE_INLINE_SRT_FIELD - added requirements for each - found and documented a confusion about "SRT inlining" not supported with MachO. (It is fixed in the following commit) - - - - - 5878f439 by Sylvain Henry at 2022-05-30T09:40:55-04:00 Enable USE_INLINE_SRT_FIELD on ARM64 It was previously disabled because of: - a confusion about "SRT inlining" (see removed comment in this commit) - a linker bug (overflow) in the handling of ARM64_RELOC_SUBTRACTOR relocation: fixed by a previous commit. - - - - - 59bd6159 by Matthew Pickering at 2022-05-30T09:41:39-04:00 ci: Make sure to exit promptly if `make install` fails. Due to the vageries of bash, you have to explicitly handle the failure and exit when in a function. This failed to exit promptly when !8247 was failing. See #21358 for the general issue - - - - - 5a5a28da by Sylvain Henry at 2022-05-30T09:42:23-04:00 Split GHC.HsToCore.Foreign.Decl This is preliminary work for JavaScript support. It's better to put the code handling the desugaring of Prim, C and JavaScript declarations into separate modules. - - - - - 6f5ff4fa by Sylvain Henry at 2022-05-30T09:43:05-04:00 Bump hadrian to LTS-19.8 (GHC 9.0.2) - - - - - f2e70707 by Sylvain Henry at 2022-05-30T09:43:05-04:00 Hadrian: remove unused code - - - - - 2f215b9f by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Eta reduction with casted function We want to be able to eta-reduce \x y. ((f x) |> co) y by pushing 'co' inwards. A very small change accommodates this See Note [Eta reduction with casted function] - - - - - f4f6a87a by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Do arity trimming at bindings, rather than in exprArity Sometimes there are very large casts, and coercionRKind can be slow. - - - - - 610a2b83 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make findRhsArity take RecFlag This avoids a fixpoint iteration for the common case of non-recursive bindings. - - - - - 80ba50c7 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Comments and white space - - - - - 0079171b by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 Make PrimOpId record levity This patch concerns #20155, part (1) The general idea is that since primops have curried bindings (currently in PrimOpWrappers.hs) we don't need to eta-expand them. But we /do/ need to eta-expand the levity-polymorphic ones, because they /don't/ have bindings. This patch makes a start in that direction, by identifying the levity-polymophic primops in the PrimOpId IdDetails constructor. For the moment, I'm still eta-expanding all primops (by saying that hasNoBinding returns True for all primops), because of the bug reported in #20155. But I hope that before long we can tidy that up too, and remove the TEMPORARILY stuff in hasNoBinding. - - - - - 6656f016 by Simon Peyton Jones at 2022-05-30T13:44:14-04:00 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: * Move state-hack stuff from GHC.Types.Id (where it never belonged) to GHC.Core.Opt.Arity (which seems much more appropriate). * Add a crucial mkCast in the Cast case of GHC.Core.Opt.Arity.eta_expand; helps with T18223 * Add clarifying notes about eta-reducing to PAPs. See Note [Do not eta reduce PAPs] * I moved tryEtaReduce from GHC.Core.Utils to GHC.Core.Opt.Arity, where it properly belongs. See Note [Eta reduce PAPs] * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, pull out the code for when eta-expansion is wanted, to make wantEtaExpansion, and all that same function in GHC.Core.Opt.Simplify.simplStableUnfolding. It was previously inconsistent, but it's doing the same thing. * I did a substantial refactor of ArityType; see Note [ArityType]. This allowed me to do away with the somewhat mysterious takeOneShots; more generally it allows arityType to describe the function, leaving its clients to decide how to use that information. I made ArityType abstract, so that clients have to use functions to access it. * Make GHC.Core.Opt.Simplify.Utils.rebuildLam (was stupidly called mkLam before) aware of the floats that the simplifier builds up, so that it can still do eta-reduction even if there are some floats. (Previously that would not happen.) That means passing the floats to rebuildLam, and an extra check when eta-reducting (etaFloatOk). * In GHC.Core.Opt.Simplify.Utils.tryEtaExpandRhs, make use of call-info in the idDemandInfo of the binder, as well as the CallArity info. The occurrence analyser did this but we were failing to take advantage here. In the end I moved the heavy lifting to GHC.Core.Opt.Arity.findRhsArity; see Note [Combining arityType with demand info], and functions idDemandOneShots and combineWithDemandOneShots. (These changes partly drove my refactoring of ArityType.) * In GHC.Core.Opt.Arity.findRhsArity * I'm now taking account of the demand on the binder to give extra one-shot info. E.g. if the fn is always called with two args, we can give better one-shot info on the binders than if we just look at the RHS. * Don't do any fixpointing in the non-recursive case -- simple short cut. * Trim arity inside the loop. See Note [Trim arity inside the loop] * Make SimpleOpt respect the eta-reduction flag (Some associated refactoring here.) * I made the CallCtxt which the Simplifier uses distinguish between recursive and non-recursive right-hand sides. data CallCtxt = ... | RhsCtxt RecFlag | ... It affects only one thing: - We call an RHS context interesting only if it is non-recursive see Note [RHS of lets] in GHC.Core.Unfold * Remove eta-reduction in GHC.CoreToStg.Prep, a welcome simplification. See Note [No eta reduction needed in rhsToBody] in GHC.CoreToStg.Prep. Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. * Delete dead function GHC.Core.Opt.Simplify.Utils.contIsRhsOrArg Metrics: compile_time/bytes allocated Test Metric Baseline New value Change --------------------------------------------------------------------------------------- MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,743,297,692 2,619,762,992 -4.5% GOOD T18223(normal) ghc/alloc 1,103,161,360 972,415,992 -11.9% GOOD T3064(normal) ghc/alloc 201,222,500 184,085,360 -8.5% GOOD T8095(normal) ghc/alloc 3,216,292,528 3,254,416,960 +1.2% T9630(normal) ghc/alloc 1,514,131,032 1,557,719,312 +2.9% BAD parsing001(normal) ghc/alloc 530,409,812 525,077,696 -1.0% geo. mean -0.1% Nofib: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- banner +0.0% +0.4% -8.9% -8.7% 0.0% exact-reals +0.0% -7.4% -36.3% -37.4% 0.0% fannkuch-redux +0.0% -0.1% -1.0% -1.0% 0.0% fft2 -0.1% -0.2% -17.8% -19.2% 0.0% fluid +0.0% -1.3% -2.1% -2.1% 0.0% gg -0.0% +2.2% -0.2% -0.1% 0.0% spectral-norm +0.1% -0.2% 0.0% 0.0% 0.0% tak +0.0% -0.3% -9.8% -9.8% 0.0% x2n1 +0.0% -0.2% -3.2% -3.2% 0.0% -------------------------------------------------------------------------------- Min -3.5% -7.4% -58.7% -59.9% 0.0% Max +0.1% +2.2% +32.9% +32.9% 0.0% Geometric Mean -0.0% -0.1% -14.2% -14.8% -0.0% Metric Decrease: MultiLayerModulesTH_OneShot T18223 T3064 T15185 T14766 Metric Increase: T9630 - - - - - cac8c7bb by Matthew Pickering at 2022-05-30T13:44:50-04:00 hadrian: Fix building from source-dist without alex/happy This fixes two bugs which were adding dependencies on alex/happy when building from a source dist. * When we try to pass `--with-alex` and `--with-happy` to cabal when configuring but the builders are not set. This is fixed by making them optional. * When we configure, cabal requires alex/happy because of the build-tool-depends fields. These are now made optional with a cabal flag (build-tool-depends) for compiler/hpc-bin/genprimopcode. Fixes #21627 - - - - - a96dccfe by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test the bootstrap without ALEX/HAPPY on path - - - - - 0e5bb3a8 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Test bootstrapping in release jobs - - - - - d8901469 by Matthew Pickering at 2022-05-30T13:44:50-04:00 ci: Allow testing bootstrapping on MRs using the "test-bootstrap" label - - - - - 18326ad2 by Matthew Pickering at 2022-05-30T13:45:25-04:00 rts: Remove explicit timescale for deprecating -h flag We originally planned to remove the flag in 9.4 but there's actually no great rush to do so and it's probably less confusing (forever) to keep the message around suggesting an explicit profiling option. Fixes #21545 - - - - - eaaa1389 by Matthew Pickering at 2022-05-30T13:46:01-04:00 Enable -dlint in hadrian lint transformer Now #21563 is fixed we can properly enable `-dlint` in CI rather than a subset of the flags. - - - - - 0544f114 by Ben Gamari at 2022-05-30T19:16:55-04:00 upload-ghc-libs: Allow candidate-only upload - - - - - 83467435 by Sylvain Henry at 2022-05-30T19:17:35-04:00 Avoid using DynFlags in GHC.Linker.Unit (#17957) - - - - - 5c4421b1 by Matthew Pickering at 2022-05-31T08:35:17-04:00 hadrian: Introduce new package database for executables needed to build stage0 These executables (such as hsc2hs) are built using the boot compiler and crucially, most libraries from the global package database. We also move other build-time executables to be built in this stage such as linters which also cleans up which libraries end up in the global package database. This allows us to remove hacks where linters-common is removed from the package database when a bindist is created. This fixes issues caused by infinite recursion due to bytestring adding a dependency on template-haskell. Fixes #21634 - - - - - 0dafd3e7 by Matthew Pickering at 2022-05-31T08:35:17-04:00 Build stage1 with -V as well This helps tracing errors which happen when building stage1 - - - - - 15d42a7a by Matthew Pickering at 2022-05-31T08:35:52-04:00 Revert "packaging: Build perf builds with -split-sections" This reverts commit 699f593532a3cd5ca1c2fab6e6e4ce9d53be2c1f. Split sections causes segfaults in profiling way with old toolchains (deb9) and on windows (#21670) Fixes #21670 - - - - - d4c71f09 by John Ericson at 2022-05-31T16:26:28+00:00 Purge `DynFlags` and `HscEnv` from some `GHC.Core` modules where it's not too hard Progress towards #17957 Because of `CoreM`, I did not move the `DynFlags` and `HscEnv` to other modules as thoroughly as I usually do. This does mean that risk of `DynFlags` "creeping back in" is higher than it usually is. After we do the same process to the other Core passes, and then figure out what we want to do about `CoreM`, we can finish the job started here. That is a good deal more work, however, so it certainly makes sense to land this now. - - - - - a720322f by romes at 2022-06-01T07:44:44-04:00 Restore Note [Quasi-quote overview] - - - - - 392ce3fc by romes at 2022-06-01T07:44:44-04:00 Move UntypedSpliceFlavour from L.H.S to GHC.Hs UntypedSpliceFlavour was only used in the client-specific `GHC.Hs.Expr` but was defined in the client-independent L.H.S.Expr. - - - - - 7975202b by romes at 2022-06-01T07:44:44-04:00 TTG: Rework and improve splices This commit redefines the structure of Splices in the AST. We get rid of `HsSplice` which used to represent typed and untyped splices, quasi quotes, and the result of splicing either an expression, a type or a pattern. Instead we have `HsUntypedSplice` which models an untyped splice or a quasi quoter, which works in practice just like untyped splices. The `HsExpr` constructor `HsSpliceE` which used to be constructed with an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The former is directly constructed with an `HsExpr` and the latter now takes an `HsUntypedSplice`. Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now take an `HsUntypedSplice` instead of a `HsSplice` (remember only /untyped splices/ can be spliced as types or patterns). The result of splicing an expression, type, or pattern is now comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`, `XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult (HsExpr GhcRn)` Overall the TTG extension points are now better used to make invalid states unrepresentable and model the progression between stages better. See Note [Lifecycle of an untyped splice, and PendingRnSplice] and Note [Lifecycle of an typed splice, and PendingTcSplice] for more details. Updates haddock submodule Fixes #21263 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - 320270c2 by Matthew Pickering at 2022-06-01T07:44:44-04:00 Add test for #21619 Fixes #21619 - - - - - ef7ddd73 by Pierre Le Marre at 2022-06-01T07:44:47-04:00 Pure Haskell implementation of GHC.Unicode Switch to a pure Haskell implementation of base:GHC.Unicode, based on the implementation of the package unicode-data (https://github.com/composewell/unicode-data/). Approved by CLC as per https://github.com/haskell/core-libraries-committee/issues/59#issuecomment-1132106691. - Remove current Unicode cbits. - Add generator for Unicode property files from Unicode Character Database. - Generate internal modules. - Update GHC.Unicode. - Add unicode003 test for general categories and case mappings. - Add Python scripts to check 'base' Unicode tests outputs and characters properties. Fixes #21375 ------------------------- Metric Decrease: T16875 Metric Increase: T4029 T18304 haddock.base ------------------------- - - - - - 514a6a28 by Eric Lindblad at 2022-06-01T07:44:51-04:00 typos - - - - - 9004be3c by Matthew Pickering at 2022-06-01T07:44:52-04:00 source-dist: Copy in files created by ./boot Since we started producing source dists with hadrian we stopped copying in the files created by ./boot which adds a dependency on python3 and autoreconf. This adds back in the files which were created by running configure. Fixes #21673 #21672 and #21626 - - - - - a12a3cab by Matthew Pickering at 2022-06-01T07:44:52-04:00 ci: Don't try to run ./boot when testing bootstrap of source dist - - - - - e07f9059 by Shlomo Shuck at 2022-06-01T07:44:55-04:00 Language.Haskell.Syntax: Fix docs for PromotedConsT etc. Fixes ghc/ghc#21675. - - - - - 87295e6d by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump bytestring, process, and text submodules Metric Decrease: T5631 Metric Increase: T18223 (cherry picked from commit 55fcee30cb3281a66f792e8673967d64619643af) - - - - - 24b5bb61 by Ben Gamari at 2022-06-01T07:44:56-04:00 Bump Cabal submodule To current `master`. (cherry picked from commit fbb59c212415188486aafd970eafef170516356a) - - - - - 5433a35e by Matthew Pickering at 2022-06-01T22:26:30-04:00 hadrian/tool-args: Write output to intermediate file rather than via stdout This allows us to see the output of hadrian while it is doing the setup. - - - - - 468f919b by Matthew Pickering at 2022-06-01T22:27:10-04:00 Make -fcompact-unwind the default This is a follow-up to !7247 (closed) making the inclusion of compact unwinding sections the default. Also a slight refactoring/simplification of the flag handling to add -fno-compact-unwind. - - - - - 819fdc61 by Zubin Duggal at 2022-06-01T22:27:47-04:00 hadrian bootstrap: add plans for 9.0.2 and 9.2.3 - - - - - 9fa790b4 by Zubin Duggal at 2022-06-01T22:27:47-04:00 ci: Add matrix for bootstrap sources - - - - - ce9f986b by John Ericson at 2022-06-02T15:42:59+00:00 HsToCore.Coverage: Improve haddocks - - - - - f065804e by John Ericson at 2022-06-02T15:42:59+00:00 Hoist auto `mkModBreaks` and `writeMixEntries` conditions to caller No need to inline traversing a maybe for `mkModBreaks`. And better to make each function do one thing and let the caller deside when than scatter the decision making and make the caller seem more imperative. - - - - - d550d907 by John Ericson at 2022-06-02T15:42:59+00:00 Rename `HsToCore.{Coverage -> Ticks}` The old name made it confusing why disabling HPC didn't disable the entire pass. The name makes it clear --- there are other reasons to add ticks in addition. - - - - - 6520da95 by John Ericson at 2022-06-02T15:42:59+00:00 Split out `GHC.HsToCore.{Breakpoints,Coverage}` and use `SizedSeq` As proposed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_432877 and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7508#note_434676, `GHC.HsToCore.Ticks` is about ticks, breakpoints are separate and backend-specific (only for the bytecode interpreter), and mix entry writing is just for HPC. With this split we separate out those interpreter- and HPC-specific its, and keep the main `GHC.HsToCore.Ticks` agnostic. Also, instead of passing the reversed list and count around, we use `SizedSeq` which abstracts over the algorithm. This is much nicer to avoid noise and prevents bugs. (The bugs are not just hypothetical! I missed up the reverses on an earlier draft of this commit.) - - - - - 1838c3d8 by Sylvain Henry at 2022-06-02T15:43:14+00:00 GHC.HsToCore.Breakpoints: Slightly improve perf We have the length already, so we might as well use that rather than O(n) recomputing it. - - - - - 5a3fdcfd by John Ericson at 2022-06-02T15:43:59+00:00 HsToCore.Coverage: Purge DynFlags Finishes what !7467 (closed) started. Progress towards #17957 - - - - - 9ce9ea50 by HaskellMouse at 2022-06-06T09:50:00-04:00 Deprecate TypeInType extension This commit fixes #20312 It deprecates "TypeInType" extension according to the following proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0083-no-type-in-type.rst It has been already implemented. The migration strategy: 1. Disable TypeInType 2. Enable both DataKinds and PolyKinds extensions Metric Decrease: T16875 - - - - - f2e037fd by Aaron Allen at 2022-06-06T09:50:39-04:00 Diagnostics conversions, part 6 (#20116) Replaces uses of `TcRnUnknownMessage` with proper diagnostics constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and `GHC.Tc.Gen.Sig`. - - - - - 04209f2a by Simon Peyton Jones at 2022-06-06T09:51:15-04:00 Ensure floated dictionaries are in scope (again) In the Specialiser, we missed one more call to bringFloatedDictsIntoScope (see #21391). This omission led to #21689. The problem is that the call to `rewriteClassOps` needs to have in scope any dictionaries floated out of the arguments we have just specialised. Easy fix. - - - - - a7fece19 by John Ericson at 2022-06-07T05:04:22+00:00 Don't print the number of deps in count-deps tests It is redundant information and a source of needless version control conflicts when multiple MRs are changing the deps list. Just printing the list and not also its length is fine. - - - - - a1651a3a by John Ericson at 2022-06-07T05:06:38+00:00 Core.Lint: Reduce `DynFlags` and `HscEnv` Co-Authored-By: Andre Marianiello <andremarianiello at users.noreply.github.com> - - - - - 56ebf9a5 by Andreas Klebinger at 2022-06-09T09:11:43-04:00 Fix a CSE shadowing bug. We used to process the rhs of non-recursive bindings and their body using the same env. If we had something like let x = ... x ... this caused trouble because the two xs refer to different binders but we would substitute both for a new binder x2 causing out of scope errors. We now simply use two different envs for the rhs and body in cse_bind. It's all explained in the Note [Separate envs for let rhs and body] Fixes #21685 - - - - - 28880828 by sheaf at 2022-06-09T09:12:19-04:00 Typecheck remaining ValArgs in rebuildHsApps This patch refactors hasFixedRuntimeRep_remainingValArgs, renaming it to tcRemainingValArgs. The logic is moved to rebuildHsApps, which ensures consistent behaviour across tcApp and quickLookArg1/tcEValArg. This patch also refactors the treatment of stupid theta for data constructors, changing the place we drop stupid theta arguments from dsConLike to mkDataConRep (now the datacon wrapper drops these arguments). We decided not to implement PHASE 2 of the FixedRuntimeRep plan for these remaining ValArgs. Future directions are outlined on the wiki: https://gitlab.haskell.org/ghc/ghc/-/wikis/Remaining-ValArgs Fixes #21544 and #21650 - - - - - 1fbba97b by Matthew Pickering at 2022-06-09T09:12:54-04:00 Add test for T21682 Fixes #21682 - - - - - 8727be73 by Andreas Klebinger at 2022-06-09T09:13:29-04:00 Document dataToTag# primop - - - - - 7eab75bb by uhbif19 at 2022-06-09T20:22:47+03:00 Remove TcRnUnknownMessage usage from GHC.Rename.Env #20115 - - - - - 46d2fc65 by uhbif19 at 2022-06-09T20:24:40+03:00 Fix TcRnPragmaWarning meaning - - - - - 69e72ecd by Matthew Pickering at 2022-06-09T19:07:01-04:00 getProcessCPUTime: Fix the getrusage fallback to account for system CPU time clock_gettime reports the combined total or user AND system time so in order to replicate it with getrusage we need to add both system and user time together. See https://stackoverflow.com/questions/7622371/getrusage-vs-clock-gettime Some sample measurements when building Cabal with this patch t1: rusage t2: clock_gettime t1: 62347518000; t2: 62347520873 t1: 62395687000; t2: 62395690171 t1: 62432435000; t2: 62432437313 t1: 62478489000; t2: 62478492465 t1: 62514990000; t2: 62514992534 t1: 62515479000; t2: 62515480327 t1: 62515485000; t2: 62515486344 Fixes #21656 - - - - - 722814ba by Yiyun Liu at 2022-06-10T21:23:03-04:00 Use <br> instead of newline character - - - - - dc202080 by Matthew Craven at 2022-06-13T14:07:12-04:00 Use (fixed_lev = True) in mkDataTyConRhs - - - - - ad70c621 by Matthew Pickering at 2022-06-14T08:40:53-04:00 hadrian: Fix testing stage1 compiler There were various issues with testing the stage1 compiler.. 1. The wrapper was not being built 2. The wrapper was picking up the stage0 package database and trying to load prelude from that. 3. The wrappers never worked on windows so just don't support that for now. Fixes #21072 - - - - - ac83899d by Ben Gamari at 2022-06-14T08:41:30-04:00 validate: Ensure that $make variable is set Currently the `$make` variable is used without being set in `validate`'s Hadrian path, which uses make to install the binary distribution. Fix this. Fixes #21687. - - - - - 59bc6008 by John Ericson at 2022-06-15T18:05:35+00:00 CoreToStg.Prep: Get rid of `DynFlags` and `HscEnv` The call sites in `Driver.Main` are duplicative, but this is good, because the next step is to remove `InteractiveContext` from `Core.Lint` into `Core.Lint.Interactive`. Also further clean up `Core.Lint` to use a better configuration record than the one we initially added. - - - - - aa9d9381 by Ben Gamari at 2022-06-15T20:33:04-04:00 hadrian: Run xattr -rc . on bindist tarball Fixes #21506. - - - - - cdc75a1f by Ben Gamari at 2022-06-15T20:33:04-04:00 configure: Hide spurious warning from ld Previously the check_for_gold_t22266 configure check could result in spurious warnings coming from the linker being blurted to stderr. Suppress these by piping stderr to /dev/null. - - - - - e128b7b8 by Ben Gamari at 2022-06-15T20:33:40-04:00 cmm: Add surface syntax for MO_MulMayOflo - - - - - bde65ea9 by Ben Gamari at 2022-06-15T20:34:16-04:00 configure: Don't attempt to override linker on Darwin Configure's --enable-ld-override functionality is intended to ensure that we don't rely on ld.bfd, which tends to be slow and buggy, on Linux and Windows. However, on Darwin the lack of sensible package management makes it extremely easy for users to have awkward mixtures of toolchain components from, e.g., XCode, the Apple Command-Line Tools package, and homebrew. This leads to extremely confusing problems like #21712. Here we avoid this by simply giving up on linker selection on Darwin altogether. This isn't so bad since the Apple ld64 linker has decent performance and AFAICT fairly reliable. Closes #21712. - - - - - 25b510c3 by Torsten Schmits at 2022-06-16T12:37:45-04:00 replace quadratic nub to fight byte code gen perf explosion Despite this code having been present in the core-to-bytecode implementation, I have observed it in the wild starting with 9.2, causing enormous slowdown in certain situations. My test case produces the following profiles: Before: ``` total time = 559.77 secs (559766 ticks @ 1000 us, 1 processor) total alloc = 513,985,665,640 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes elem_by Data.OldList libraries/base/Data/OldList.hs:429:1-7 67.6 92.9 378282 477447404296 eqInt GHC.Classes libraries/ghc-prim/GHC/Classes.hs:275:8-14 12.4 0.0 69333 32 $c>>= GHC.Data.IOEnv <no location info> 6.9 0.6 38475 3020371232 ``` After: ``` total time = 89.83 secs (89833 ticks @ 1000 us, 1 processor) total alloc = 39,365,306,360 bytes (excludes profiling overheads) COST CENTRE MODULE SRC %time %alloc ticks bytes $c>>= GHC.Data.IOEnv <no location info> 43.6 7.7 39156 3020403424 doCase GHC.StgToByteCode compiler/GHC/StgToByteCode.hs:(805,1)-(1054,53) 2.5 7.4 2246 2920777088 ``` - - - - - aa7e1f20 by Matthew Pickering at 2022-06-16T12:38:21-04:00 hadrian: Don't install `include/` directory in bindist. The install_includes for the RTS package used to be put in the top-level ./include folder but this would lead to confusing things happening if you installed multiple GHC versions side-by-side. We don't need this folder anymore because install-includes is honoured properly by cabal and the relevant header files already copied in by the cabal installation process. If you want to depend on the header files for the RTS in a Haskell project then you just have to depend on the `rts` package and the correct include directories will be provided for you. If you want to depend on the header files in a standard C project then you should query ghc-pkg to get the right paths. ``` ghc-pkg field rts include-dirs --simple-output ``` Fixes #21609 - - - - - 03172116 by Bryan Richter at 2022-06-16T12:38:57-04:00 Enable eventlogs on nightly perf job - - - - - ecbf8685 by Hécate Moonlight at 2022-06-16T16:30:00-04:00 Repair dead link in TH haddocks Closes #21724 - - - - - 99ff3818 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian: allow configuring Hsc2Hs This patch adds the ability to pass options to Hsc2Hs as Hadrian key/value settings, in the same way as cabal configure options, using the syntax: *.*.hsc2hs.run.opts += ... - - - - - 9c575f24 by sheaf at 2022-06-16T16:30:39-04:00 Hadrian bootstrap: look up hsc2hs Hadrian bootstrapping looks up where to find ghc_pkg, but the same logic was not in place for hsc2hs which meant we could fail to find the appropriate hsc2hs executabe when bootstrapping Hadrian. This patch adds that missing logic. - - - - - 229d741f by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Add (broken) test for #21622 - - - - - cadd7753 by Ben Gamari at 2022-06-18T10:42:54-04:00 ghc-heap: Don't Box NULL pointers Previously we could construct a `Box` of a NULL pointer from the `link` field of `StgWeak`. Now we take care to avoid ever introducing such pointers in `collect_pointers` and ensure that the `link` field is represented as a `Maybe` in the `Closure` type. Fixes #21622 - - - - - 31c214cc by Tamar Christina at 2022-06-18T10:43:34-04:00 winio: Add support to console handles to handleToHANDLE - - - - - 711cb417 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Add SMUL[LH] instructions These will be needed to fix #21624. - - - - - d05d90d2 by Ben Gamari at 2022-06-18T10:44:11-04:00 CmmToAsm/AArch64: Fix syntax of OpRegShift operands Previously this produced invalid assembly containing a redundant comma. - - - - - a1e1d8ee by Ben Gamari at 2022-06-18T10:44:11-04:00 ncg/aarch64: Fix implementation of IntMulMayOflo The code generated for IntMulMayOflo was previously wrong as it depended upon the overflow flag, which the AArch64 MUL instruction does not set. Fix this. Fixes #21624. - - - - - 26745006 by Ben Gamari at 2022-06-18T10:44:11-04:00 testsuite: Add test for #21624 Ensuring that mulIntMayOflo# behaves as expected. - - - - - 94f2e92a by Sebastian Graf at 2022-06-20T09:40:58+02:00 CprAnal: Set signatures of DFuns to top The recursive DFun in the reproducer for #20836 also triggered a bug in CprAnal that is observable in a debug build. The CPR signature of a recursive DFunId was never updated and hence the optimistic arity 0 bottom signature triggered a mismatch with the arity 1 of the binding in WorkWrap. We never miscompiled any code because WW doesn't exploit bottom CPR signatures. - - - - - b570da84 by Sebastian Graf at 2022-06-20T09:43:29+02:00 CorePrep: Don't speculatively evaluate recursive calls (#20836) In #20836 we have optimised a terminating program into an endless loop, because we speculated the self-recursive call of a recursive DFun. Now we track the set of enclosing recursive binders in CorePrep to prevent speculation of such self-recursive calls. See the updates to Note [Speculative evaluation] for details. Fixes #20836. - - - - - 49fb2f9b by Sebastian Graf at 2022-06-20T09:43:32+02:00 Simplify: Take care with eta reduction in recursive RHSs (#21652) Similar to the fix to #20836 in CorePrep, we now track the set of enclosing recursive binders in the SimplEnv and SimpleOptEnv. See Note [Eta reduction in recursive RHSs] for details. I also updated Note [Arity robustness] with the insights Simon and I had in a call discussing the issue. Fixes #21652. Unfortunately, we get a 5% ghc/alloc regression in T16577. That is due to additional eta reduction in GHC.Read.choose1 and the resulting ANF-isation of a large list literal at the top-level that didn't happen before (presumably because it was too interesting to float to the top-level). There's not much we can do about that. Metric Increase: T16577 - - - - - 2563b95c by Sebastian Graf at 2022-06-20T09:45:09+02:00 Ignore .hie-bios - - - - - e4e44d8d by Simon Peyton Jones at 2022-06-20T12:31:45-04:00 Instantiate top level foralls in partial type signatures The main fix for #21667 is the new call to tcInstTypeBnders in tcHsPartialSigType. It was really a simple omission before. I also moved the decision about whether we need to apply the Monomorphism Restriction, from `decideGeneralisationPlan` to `tcPolyInfer`. That removes a flag from the InferGen constructor, which is good. But more importantly, it allows the new function, checkMonomorphismRestriction called from `tcPolyInfer`, to "see" the `Types` involved rather than the `HsTypes`. And that in turn matters because we invoke the MR for partial signatures if none of the partial signatures in the group have any overloading context; and we can't answer that question for HsTypes. See Note [Partial type signatures and the monomorphism restriction] in GHC.Tc.Gen.Bind. This latter is really a pre-existing bug. - - - - - 262a9f93 by Winston Hartnett at 2022-06-20T12:32:23-04:00 Make Outputable instance for InlineSig print the InlineSpec Fix ghc/ghc#21739 Squash fix ghc/ghc#21739 - - - - - b5590fff by Matthew Pickering at 2022-06-20T12:32:59-04:00 Add NO_BOOT to hackage_doc_tarball job We were attempting to boot a src-tarball which doesn't work as ./boot is not included in the source tarball. This slipped through as the job is only run on nightly. - - - - - d24afd9d by Vladislav Zavialov at 2022-06-20T17:34:44-04:00 HsToken for @-patterns and TypeApplications (#19623) One more step towards the new design of EPA. - - - - - 159b7628 by Tamar Christina at 2022-06-20T17:35:23-04:00 linker: only keep rtl exception tables if they have been relocated - - - - - da5ff105 by Andreas Klebinger at 2022-06-21T17:04:12+02:00 Ticky:Make json info a separate field. - - - - - 1a4ce4b2 by Matthew Pickering at 2022-06-22T09:49:22+01:00 Revert "Ticky:Make json info a separate field." This reverts commit da5ff10503e683e2148c62e36f8fe2f819328862. This was pushed directly without review. - - - - - f89bf85f by Vanessa McHale at 2022-06-22T08:21:32-04:00 Flags to disable local let-floating; -flocal-float-out, -flocal-float-out-top-level CLI flags These flags affect the behaviour of local let floating. If `-flocal-float-out` is disabled (the default) then we disable all local floating. ``` …(let x = let y = e in (a,b) in body)... ===> …(let y = e; x = (a,b) in body)... ``` Further to this, top-level local floating can be disabled on it's own by passing -fno-local-float-out-top-level. ``` x = let y = e in (a,b) ===> y = e; x = (a,b) ``` Note that this is only about local floating, ie, floating two adjacent lets past each other and doesn't say anything about the global floating pass which is controlled by `-fno-float`. Fixes #13663 - - - - - 4ccefc6e by Matthew Craven at 2022-06-22T08:22:12-04:00 Check for Int overflows in Data.Array.Byte - - - - - 2004e3c8 by Matthew Craven at 2022-06-22T08:22:12-04:00 Add a basic test for ByteArray's Monoid instance - - - - - fb36770c by Matthew Craven at 2022-06-22T08:22:12-04:00 Rename `copyByteArray` to `unsafeCopyByteArray` - - - - - ecc9aedc by Ben Gamari at 2022-06-22T08:22:48-04:00 testsuite: Add test for #21719 Happily, this has been fixed since 9.2. - - - - - 19606c42 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Use lookupNameCache instead of lookupOrigIO - - - - - 4c9dfd69 by Brandon Chinn at 2022-06-22T08:23:28-04:00 Break out thNameToGhcNameIO (ref. #21730) - - - - - eb4fb849 by Michael Peyton Jones at 2022-06-22T08:24:07-04:00 Add laws for 'toInteger' and 'toRational' CLC discussion here: https://github.com/haskell/core-libraries-committee/issues/58 - - - - - c1a950c1 by Alexander Esgen at 2022-06-22T12:36:13+00:00 Correct documentation of defaults of the `-V` RTS option - - - - - b7b7d90d by Matthew Pickering at 2022-06-22T21:58:12-04:00 Transcribe discussion from #21483 into a Note In #21483 I had a discussion with Simon Marlow about the memory retention behaviour of -Fd. I have just transcribed that conversation here as it elucidates the potentially subtle assumptions which led to the design of the memory retention behaviours of -Fd. Fixes #21483 - - - - - 980d1954 by Ben Gamari at 2022-06-22T21:58:48-04:00 eventlog: Don't leave dangling pointers hanging around Previously we failed to reset pointers to various eventlog buffers to NULL after freeing them. In principle we shouldn't look at them after they are freed but nevertheless it is good practice to set them to a well-defined value. - - - - - 575ec846 by Eric Lindblad at 2022-06-22T21:59:28-04:00 runhaskell - - - - - e6a69337 by Artem Pelenitsyn at 2022-06-22T22:00:07-04:00 re-export GHC.Natural.minusNaturalMaybe from Numeric.Natural CLC proposal: https://github.com/haskell/core-libraries-committee/issues/45 - - - - - 5d45aa97 by Gergo ERDI at 2022-06-22T22:00:46-04:00 When specialising, look through floatable ticks. Fixes #21697. - - - - - 531205ac by Andreas Klebinger at 2022-06-22T22:01:22-04:00 TagCheck.hs: Properly check if arguments are boxed types. For one by mistake I had been checking against the kind of runtime rep instead of the boxity. This uncovered another bug, namely that we tried to generate the checking code before we had associated the function arguments with a register, so this could never have worked to begin with. This fixes #21729 and both of the above issues. - - - - - c7f9f6b5 by Gleb Popov at 2022-06-22T22:02:00-04:00 Use correct arch for the FreeBSD triple in gen-data-layout.sh Downstream bug for reference: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=261798 Relevant upstream issue: #15718 - - - - - 75f0091b by Andreas Klebinger at 2022-06-22T22:02:35-04:00 Bump nofib submodule. Allows the shake runner to build with 9.2.3 among other things. Fixes #21772 - - - - - 0aa0ce69 by Ben Gamari at 2022-06-27T08:01:03-04:00 Bump ghc-prim and base versions To 0.9.0 and 4.17.0 respectively. Bumps array, deepseq, directory, filepath, haskeline, hpc, parsec, stm, terminfo, text, unix, haddock, and hsc2hs submodules. (cherry picked from commit ba47b95122b7b336ce1cc00896a47b584ad24095) - - - - - 4713abc2 by Ben Gamari at 2022-06-27T08:01:03-04:00 testsuite: Use normalise_version more consistently Previously several tests' output were unnecessarily dependent on version numbers, particularly of `base`. Fix this. - - - - - d7b0642b by Matthew Pickering at 2022-06-27T08:01:03-04:00 linters: Fix lint-submodule-refs when crashing trying to find plausible branches - - - - - 38378be3 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 hadrian: Improve haddocks for ghcDebugAssertions - - - - - ac7a7fc8 by Andreas Klebinger at 2022-06-27T08:01:39-04:00 Don't mark lambda binders as OtherCon We used to put OtherCon unfoldings on lambda binders of workers and sometimes also join points/specializations with with the assumption that since the wrapper would force these arguments once we execute the RHS they would indeed be in WHNF. This was wrong for reasons detailed in #21472. So now we purge evaluated unfoldings from *all* lambda binders. This fixes #21472, but at the cost of sometimes not using as efficient a calling convention. It can also change inlining behaviour as some occurances will no longer look like value arguments when they did before. As consequence we also change how we compute CBV information for arguments slightly. We now *always* determine the CBV convention for arguments during tidy. Earlier in the pipeline we merely mark functions as candidates for having their arguments treated as CBV. As before the process is described in the relevant notes: Note [CBV Function Ids] Note [Attaching CBV Marks to ids] Note [Never put `OtherCon` unfoldigns on lambda binders] ------------------------- Metric Decrease: T12425 T13035 T18223 T18223 T18923 MultiLayerModulesTH_OneShot Metric Increase: WWRec ------------------------- - - - - - 06cf6f4a by Tony Zorman at 2022-06-27T08:02:18-04:00 Add suggestions for unrecognised pragmas (#21589) In case of a misspelled pragma, offer possible corrections as to what the user could have meant. Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/21589 - - - - - 3fbab757 by Greg Steuck at 2022-06-27T08:02:56-04:00 Remove the traces of i386-*-openbsd, long live amd64 OpenBSD will not ship any ghc packages on i386 starting with 7.2 release. This means there will not be a bootstrap compiler easily available. The last available binaries are ghc-8.10.6 which is already not supported as bootstrap for HEAD. See here for more information: https://marc.info/?l=openbsd-ports&m=165060700222580&w=2 - - - - - 58530271 by Bodigrim at 2022-06-27T08:03:34-04:00 Add Foldable1 and Bifoldable1 type classes Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/9 Instances roughly follow https://hackage.haskell.org/package/semigroupoids-5.3.7/docs/Data-Semigroup-Foldable-Class.html#t:Foldable1 but the API of `Foldable1` was expanded in comparison to `semigroupoids`. Compatibility shim is available from https://github.com/phadej/foldable1 (to be released). Closes #13573. - - - - - a51f4ecc by Naomi Liu at 2022-06-27T08:04:13-04:00 add levity polymorphism to addrToAny# - - - - - f4edcdc4 by Naomi Liu at 2022-06-27T08:04:13-04:00 add tests for addrToAny# levity - - - - - 07016fc9 by Matthew Pickering at 2022-06-27T08:04:49-04:00 hadrian: Update main README page This README had some quite out-of-date content about the build system so I did a complete pass deleting old material. I also made the section about flavours more prominent and mentioned flavour transformers. - - - - - 79ae2d89 by Ben Gamari at 2022-06-27T08:05:24-04:00 testsuite: Hide output from test compilations with verbosity==2 Previously the output from test compilations used to determine whether, e.g., profiling libraries are available was shown with verbosity levels >= 2. However, the default level is 2, meaning that most users were often spammed with confusing errors. Fix this by bumping the verbosity threshold for this output to >=3. Fixes #21760. - - - - - 995ea44d by Ben Gamari at 2022-06-27T08:06:00-04:00 configure: Only probe for LD in FIND_LD Since 6be2c5a7e9187fc14d51e1ec32ca235143bb0d8b we would probe for LD rather early in `configure`. However, it turns out that this breaks `configure`'s `ld`-override logic, which assumes that `LD` was set by the user and aborts. Fixes #21778. - - - - - b43d140b by Sergei Trofimovich at 2022-06-27T08:06:39-04:00 `.hs-boot` make rules: add missing order-only dependency on target directory Noticed missing target directory dependency as a build failure in `make --shuffle` mode (added in https://savannah.gnu.org/bugs/index.php?62100): "cp" libraries/base/./GHC/Stack/CCS.hs-boot libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot cp: cannot create regular file 'libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot': No such file or directory libraries/haskeline/ghc.mk:4: libraries/haskeline/dist-install/build/.depend-v-p-dyn.haskell: No such file or directory make[1]: *** [libraries/base/ghc.mk:4: libraries/base/dist-install/build/GHC/Stack/CCS.hs-boot] Error 1 shuffle=1656129254 make: *** [Makefile:128: all] Error 2 shuffle=1656129254 Note that `cp` complains about inability to create target file. The change adds order-only dependency on a target directory (similar to the rest of rules in that file). The bug is lurking there since 2009 commit 34cc75e1a (`GHC new build system megapatch`.) where upfront directory creation was never added to `.hs-boot` files. - - - - - 57a5f88c by Ben Gamari at 2022-06-28T03:24:24-04:00 Mark AArch64/Darwin as requiring sign-extension Apple's AArch64 ABI requires that the caller sign-extend small integer arguments. Set platformCConvNeedsExtension to reflect this fact. Fixes #21773. - - - - - df762ae9 by Ben Gamari at 2022-06-28T03:24:24-04:00 -ddump-llvm shouldn't imply -fllvm Previously -ddump-llvm would change the backend used, which contrasts with all other dump flags. This is quite surprising and cost me quite a bit of time. Dump flags should not change compiler behavior. Fixes #21776. - - - - - 70f0c1f8 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Re-format argument handling logic Previously there were very long, hard to parse lines. Fix this. - - - - - 696d64c3 by Ben Gamari at 2022-06-28T03:24:24-04:00 CmmToAsm/AArch64: Sign-extend narrow C arguments The AArch64/Darwin ABI requires that function arguments narrower than 32-bits must be sign-extended by the caller. We neglected to do this, resulting in #20735. Fixes #20735. - - - - - c006ac0d by Ben Gamari at 2022-06-28T03:24:24-04:00 testsuite: Add test for #20735 - - - - - 16b9100c by Ben Gamari at 2022-06-28T03:24:59-04:00 integer-gmp: Fix cabal file Evidently fields may not come after sections in a cabal file. - - - - - 03cc5d02 by Sergei Trofimovich at 2022-06-28T15:20:45-04:00 ghc.mk: fix 'make install' (`mk/system-cxx-std-lib-1.0.conf.install` does not exist) before the change `make install` was failing as: ``` "mv" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc-stage2" "/<<NIX>>/ghc-9.3.20220406/lib/ghc-9.5.20220625/bin/ghc" make[1]: *** No rule to make target 'mk/system-cxx-std-lib-1.0.conf.install', needed by 'install_packages'. Stop. ``` I think it's a recent regression caused by 0ef249aa where `system-cxx-std-lib-1.0.conf` is created (somewhat manually), but not the .install varianlt of it. The fix is to consistently use `mk/system-cxx-std-lib-1.0.conf` everywhere. Closes: https://gitlab.haskell.org/ghc/ghc/-/issues/21784 - - - - - eecab8f9 by Simon Peyton Jones at 2022-06-28T15:21:21-04:00 Comments only, about join points This MR just adds some documentation about why casts destroy join points, following #21716. - - - - - 251471e7 by Matthew Pickering at 2022-06-28T19:02:41-04:00 Cleanup BuiltInSyntax vs UserSyntax There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302 - - - - - 0e22f16c by Ben Gamari at 2022-06-28T19:03:16-04:00 template-haskell: Bump version to 2.19.0.0 Bumps text and exceptions submodules due to bounds. - - - - - bbe6f10e by Emily Bourke at 2022-06-29T08:23:13+00:00 Tiny tweak to `IOPort#` documentation The exclamation mark and bracket don’t seem to make sense here. I’ve looked through the history, and I don’t think they’re deliberate – possibly a copy-and-paste error. - - - - - 70e47489 by Dominik Peteler at 2022-06-29T19:26:31-04:00 Remove `CoreOccurAnal` constructor of the `CoreToDo` type It was dead code since the last occurence in an expression context got removed in 71916e1c018dded2e68d6769a2dbb8777da12664. - - - - - d0722170 by nineonine at 2022-07-01T08:15:56-04:00 Fix panic with UnliftedFFITypes+CApiFFI (#14624) When declaring foreign import using CAPI calling convention, using unlifted unboxed types would result in compiler panic. There was an attempt to fix the situation in #9274, however it only addressed some of the ByteArray cases. This patch fixes other missed cases for all prims that may be used as basic foreign types. - - - - - eb043148 by Douglas Wilson at 2022-07-01T08:16:32-04:00 rts: gc stats: account properly for copied bytes in sequential collections We were not updating the [copied,any_work,scav_find_work, max_n_todo_overflow] counters during sequential collections. As well, we were double counting for parallel collections. To fix this we add an `else` clause to the `if (is_par_gc())`. The par_* counters do not need to be updated in the sequential case because they must be 0. - - - - - f95edea9 by Matthew Pickering at 2022-07-01T19:21:55-04:00 desugar: Look through ticks when warning about possible literal overflow Enabling `-fhpc` or `-finfo-table-map` would case a tick to end up between the appliation of `neg` to its argument. This defeated the special logic which looks for `NegApp ... (HsOverLit` to warn about possible overflow if a user writes a negative literal (without out NegativeLiterals) in their code. Fixes #21701 - - - - - f25c8d03 by Matthew Pickering at 2022-07-01T19:22:31-04:00 ci: Fix definition of slow-validate flavour (so that -dlint) is passed In this embarassing sequence of events we were running slow-validate without -dlint. - - - - - bf7991b0 by Mike Pilgrem at 2022-07-02T10:12:04-04:00 Identify the extistence of the `runhaskell` command and that it is equivalent to the `runghc` command. Add an entry to the index for `runhaskell`. See https://gitlab.haskell.org/ghc/ghc/-/issues/21411 - - - - - 9e79f6d0 by Simon Jakobi at 2022-07-02T10:12:39-04:00 Data.Foldable1: Remove references to Foldable-specific note ...as discussed in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8495#note_439455. - - - - - 3a8970ac by romes at 2022-07-03T14:11:31-04:00 TTG: Move HsModule to L.H.S Move the definition of HsModule defined in GHC.Hs to Language.Haskell.Syntax with an added TTG parameter and corresponding extension fields. This is progress towards having the haskell-syntax package, as described in #21592 - - - - - f9f80995 by romes at 2022-07-03T14:11:31-04:00 TTG: Move ImpExp client-independent bits to L.H.S.ImpExp Move the GHC-independent definitions from GHC.Hs.ImpExp to Language.Haskell.Syntax.ImpExp with the required TTG extension fields such as to keep the AST independent from GHC. This is progress towards having the haskell-syntax package, as described in #21592 Bumps haddock submodule - - - - - c43dbac0 by romes at 2022-07-03T14:11:31-04:00 Refactor ModuleName to L.H.S.Module.Name ModuleName used to live in GHC.Unit.Module.Name. In this commit, the definition of ModuleName and its associated functions are moved to Language.Haskell.Syntax.Module.Name according to the current plan towards making the AST GHC-independent. The instances for ModuleName for Outputable, Uniquable and Binary were moved to the module in which the class is defined because these instances depend on GHC. The instance of Eq for ModuleName is slightly changed to no longer depend on unique explicitly and instead uses FastString's instance of Eq. - - - - - 2635c6f2 by konsumlamm at 2022-07-03T14:12:11-04:00 Expand `Ord` instance for `Down` Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/23#issuecomment-1172932610 - - - - - 36fba0df by Anselm Schüler at 2022-07-04T05:06:42+00:00 Add applyWhen to Data.Function per CLC prop Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/71#issuecomment-1165830233 - - - - - 3b13aab1 by Matthew Pickering at 2022-07-04T15:15:00-04:00 hadrian: Don't read package environments in ghc-stage1 wrapper The stage1 compiler may be on the brink of existence and not have even a working base library. You may have installed packages globally with a similar stage2 compiler which will then lead to arguments such as --show-iface not even working because you are passing too many package flags. The solution is simple, don't read these implicit files. Fixes #21803 - - - - - aba482ea by Andreas Klebinger at 2022-07-04T17:55:55-04:00 Ticky:Make json info a separate field. Fixes #21233 - - - - - 74f3867d by Matthew Pickering at 2022-07-04T17:56:30-04:00 Add docs:<pkg> command to hadrian to build docs for just one package - - - - - 418afaf1 by Matthew Pickering at 2022-07-04T17:56:30-04:00 upload-docs: propagate publish correctly in upload_sdist - - - - - ed793d7a by Matthew Pickering at 2022-07-04T17:56:30-04:00 docs-upload: Fix upload script when no packages are listed - - - - - d002c6e0 by Matthew Pickering at 2022-07-04T17:56:30-04:00 hadrian: Add --haddock-base-url option for specifying base-url when generating docs The motiviation for this flag is to be able to produce documentation which is suitable for uploading for hackage, ie, the cross-package links work correctly. There are basically three values you want to set this to: * off - default, base_url = ../%pkg% which works for local browsing * on - no argument , base_url = https:://hackage.haskell.org/package/%pkg%/docs - for hackage docs upload * on - argument, for example, base_url = http://localhost:8080/package/%pkg%/docs for testing the documentation. The `%pkg%` string is a template variable which is replaced with the package identifier for the relevant package. This is one step towards fixing #21749 - - - - - 41eb749a by Matthew Pickering at 2022-07-04T17:56:31-04:00 Add nightly job for generating docs suitable for hackage upload - - - - - 620ee7ed by Matthew Pickering at 2022-07-04T17:57:05-04:00 ghci: Support :set prompt in multi repl This adds supports for various :set commands apart from `:set <FLAG>` in multi repl, this includes `:set prompt` and so-on. Fixes #21796 - - - - - b151b65e by Matthew Pickering at 2022-07-05T16:32:31-04:00 Vendor filepath inside template-haskell Adding filepath as a dependency of template-haskell means that it can't be reinstalled if any build-plan depends on template-haskell. This is a temporary solution for the 9.4 release. A longer term solution is to split-up the template-haskell package into the wired-in part and a non-wired-in part which can be reinstalled. This was deemed quite risky on the 9.4 release timescale. Fixes #21738 - - - - - c9347ecf by John Ericson at 2022-07-05T16:33:07-04:00 Factor fields of `CoreDoSimplify` into separate data type This avoids some partiality. The work @mmhat is doing cleaning up and modularizing `Core.Opt` will build on this nicely. - - - - - d0e74992 by Eric Lindblad at 2022-07-06T01:35:48-04:00 https urls - - - - - 803e965c by Eric Lindblad at 2022-07-06T01:35:48-04:00 options and typos - - - - - 5519baa5 by Eric Lindblad at 2022-07-06T01:35:48-04:00 grammar - - - - - 4ddc1d3e by Eric Lindblad at 2022-07-06T01:35:48-04:00 sources - - - - - c95c2026 by Matthew Pickering at 2022-07-06T01:35:48-04:00 Fix lint warnings in bootstrap.py - - - - - 86ced2ad by romes at 2022-07-06T01:36:23-04:00 Restore Eq instance of ImportDeclQualifiedStyle Fixes #21819 - - - - - 3547e264 by romes at 2022-07-06T13:50:27-04:00 Prune L.H.S modules of GHC dependencies Move around datatypes, functions and instances that are GHC-specific out of the `Language.Haskell.Syntax.*` modules to reduce the GHC dependencies in them -- progressing towards #21592 Creates a module `Language.Haskell.Syntax.Basic` to hold basic definitions required by the other L.H.S modules (and don't belong in any of them) - - - - - e4eea07b by romes at 2022-07-06T13:50:27-04:00 TTG: Move CoreTickish out of LHS.Binds Remove the `[CoreTickish]` fields from datatype `HsBindLR idL idR` and move them to the extension point instance, according to the plan outlined in #21592 to separate the base AST from the GHC specific bits. - - - - - acc1816b by romes at 2022-07-06T13:50:27-04:00 TTG for ForeignImport/Export Add a TTG parameter to both `ForeignImport` and `ForeignExport` and, according to #21592, move the GHC-specific bits in them and in the other AST data types related to foreign imports and exports to the TTG extension point. - - - - - 371c5ecf by romes at 2022-07-06T13:50:27-04:00 TTG for HsTyLit Add TTG parameter to `HsTyLit` to move the GHC-specific `SourceText` fields to the extension point and out of the base AST. Progress towards #21592 - - - - - fd379d1b by romes at 2022-07-06T13:50:27-04:00 Remove many GHC dependencies from L.H.S Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC imports according to the plan in the linked issue. Moves more GHC-specific declarations to `GHC.*` and brings more required GHC-independent declarations to `Language.Haskell.Syntax.*` (extending e.g. `Language.Haskell.Syntax.Basic`). Progress towards #21592 Bump haddock submodule for !8308 ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - c5415bc5 by Alan Zimmerman at 2022-07-06T13:50:27-04:00 Fix exact printing of the HsRule name Prior to this branch, the HsRule name was XRec pass (SourceText,RuleName) and there is an ExactPrint instance for (SourceText, RuleName). The SourceText has moved to a different location, so synthesise the original to trigger the correct instance when printing. We need both the SourceText and RuleName when exact printing, as it is possible to have a NoSourceText variant, in which case we fall back to the FastString. - - - - - 665fa5a7 by Matthew Pickering at 2022-07-06T13:51:03-04:00 driver: Fix issue with module loops and multiple home units We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 - - - - - bbcaba6a by Andreas Klebinger at 2022-07-06T13:51:39-04:00 Remove a bogus #define from ClosureMacros.h - - - - - fa59223b by Tamar Christina at 2022-07-07T23:23:57-04:00 winio: make consoleReadNonBlocking not wait for any events at all. - - - - - 42c917df by Adam Sandberg Ericsson at 2022-07-07T23:24:34-04:00 rts: allow NULL to be used as an invalid StgStablePtr - - - - - 3739e565 by Andreas Schwab at 2022-07-07T23:25:10-04:00 RTS: Add stack marker to StgCRunAsm.S Every object file must be properly marked for non-executable stack, even if it contains no code. - - - - - a889bc05 by Ben Gamari at 2022-07-07T23:25:45-04:00 Bump unix submodule Adds `config.sub` to unix's `.gitignore`, fixing #19574. - - - - - 3609a478 by Matthew Pickering at 2022-07-09T11:11:58-04:00 ghci: Fix most calls to isLoaded to work in multi-mode The most egrarious thing this fixes is the report about the total number of loaded modules after starting a session. Ticket #20889 - - - - - fc183c90 by Matthew Pickering at 2022-07-09T11:11:58-04:00 Enable :edit command in ghci multi-mode. This works after the last change to isLoaded. Ticket #20888 - - - - - 46050534 by Simon Peyton Jones at 2022-07-09T11:12:34-04:00 Fix a scoping bug in the Specialiser In the call to `specLookupRule` in `already_covered`, in `specCalls`, we need an in-scope set that includes the free vars of the arguments. But we simply were not guaranteeing that: did not include the `rule_bndrs`. Easily fixed. I'm not sure how how this bug has lain for quite so long without biting us. Fixes #21828. - - - - - 6e8d9056 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Edit Note [idArity varies independently of dmdTypeDepth] ...and refer to it in GHC.Core.Lint.lintLetBind. Fixes #21452 - - - - - 89ba4655 by Simon Peyton Jones at 2022-07-12T13:26:52+00:00 Tiny documentation wibbles (comments only) - - - - - 61a46c6d by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix readme - - - - - 61babb5e by Eric Lindblad at 2022-07-13T08:28:29-04:00 fix bootstrap - - - - - 8b417ad5 by Eric Lindblad at 2022-07-13T08:28:29-04:00 tarball - - - - - e9d9f078 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Fix scopes for deriving clauses and instance signatures (#18425) - - - - - c4989131 by Zubin Duggal at 2022-07-13T14:00:18-04:00 hie-files: Record location of filled in default method bindings This is useful for hie files to reconstruct the evidence that default methods depend on. - - - - - 9c52e7fc by Zubin Duggal at 2022-07-13T14:00:18-04:00 testsuite: Factor out common parts from hiefile tests - - - - - 6a9e4493 by sheaf at 2022-07-13T14:00:56-04:00 Hadrian: update documentation of settings The documentation for key-value settings was a bit out of date. This patch updates it to account for `cabal.configure.opts` and `hsc2hs.run.opts`. The user-settings document was also re-arranged, to make the key-value settings more prominent (as it doesn't involve changing the Hadrian source code, and thus doesn't require any recompilation of Hadrian). - - - - - a2f142f8 by Zubin Duggal at 2022-07-13T20:43:32-04:00 Fix potential space leak that arise from ModuleGraphs retaining references to previous ModuleGraphs, in particular the lazy `mg_non_boot` field. This manifests in `extendMG`. Solution: Delete `mg_non_boot` as it is only used for `mgLookupModule`, which is only called in two places in the compiler, and should only be called at most once for every home unit: GHC.Driver.Make: mainModuleSrcPath :: Maybe String mainModuleSrcPath = do ms <- mgLookupModule mod_graph (mainModIs hue) ml_hs_file (ms_location ms) GHCI.UI: listModuleLine modl line = do graph <- GHC.getModuleGraph let this = GHC.mgLookupModule graph modl Instead `mgLookupModule` can be a linear function that looks through the entire list of `ModuleGraphNodes` Fixes #21816 - - - - - dcf8b30a by Ben Gamari at 2022-07-13T20:44:08-04:00 rts: Fix AdjustorPool bitmap manipulation Previously the implementation of bitmap_first_unset assumed that `__builtin_clz` would accept `uint8_t` however it apparently rather extends its argument to `unsigned int`. To fix this we simply revert to a naive implementation since handling the various corner cases with `clz` is quite tricky. This should be fine given that AdjustorPool isn't particularly hot. Ideally we would have a single, optimised bitmap implementation in the RTS but I'll leave this for future work. Fixes #21838. - - - - - ad8f3e15 by Luite Stegeman at 2022-07-16T07:20:36-04:00 Change GHCi bytecode return convention for unlifted datatypes. This changes the bytecode return convention for unlifted algebraic datatypes to be the same as for lifted types, i.e. ENTER/PUSH_ALTS instead of RETURN_UNLIFTED/PUSH_ALTS_UNLIFTED Fixes #20849 - - - - - 5434d1a3 by Colten Webb at 2022-07-16T07:21:15-04:00 Compute record-dot-syntax types Ensures type information for record-dot-syntax is included in HieASTs. See #21797 - - - - - 89d169ec by Colten Webb at 2022-07-16T07:21:15-04:00 Add record-dot-syntax test - - - - - 4beb9f3c by Ben Gamari at 2022-07-16T07:21:51-04:00 Document RuntimeRep polymorphism limitations of catch#, et al As noted in #21868, several primops accepting continuations producing RuntimeRep-polymorphic results aren't nearly as polymorphic as their types suggest. Document this limitation and adapt the `UnliftedWeakPtr` test to avoid breaking this limitation in `keepAlive#`. - - - - - 4ef1c65d by Ben Gamari at 2022-07-16T07:21:51-04:00 Make keepAlive# out-of-line This is a naive approach to fixing the unsoundness noticed in #21708. Specifically, we remove the lowering of `keepAlive#` via CorePrep and instead turn it into an out-of-line primop. This is simple, inefficient (since the continuation must now be heap allocated), but good enough for 9.4.1. We will revisit this (particiularly via #16098) in a future release. Metric Increase: T4978 T7257 T9203 - - - - - 1bbff35d by Greg Steuck at 2022-07-16T07:22:29-04:00 Suppress extra output from configure check for c++ libraries - - - - - 3acbd7ad by Ben Gamari at 2022-07-16T07:23:04-04:00 rel-notes: Drop mention of #21745 fix Since we have backported the fix to 9.4.1. - - - - - b27c2774 by Dominik Peteler at 2022-07-16T07:23:43-04:00 Align the behaviour of `dopt` and `log_dopt` Before the behaviour of `dopt` and `logHasDumpFlag` (and the underlying function `log_dopt`) were different as the latter did not take the verbosity level into account. This led to problems during the refactoring as we cannot simply replace calls to `dopt` with calls to `logHasDumpFlag`. In addition to that a subtle bug in the GHC module was fixed: `setSessionDynFlags` did not update the logger and as a consequence the verbosity value of the logger was not set appropriately. Fixes #21861 - - - - - 28347d71 by Douglas Wilson at 2022-07-16T13:25:06-04:00 rts: forkOn context switches the target capability Fixes #21824 - - - - - f1c44991 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Eliminate orphan Outputable instances Here we reorganize `GHC.Cmm` to eliminate the orphan `Outputable` and `OutputableP` instances for the Cmm AST. This makes it significantly easier to use the Cmm pretty-printers in tracing output without incurring module import cycles. - - - - - f2e5e763 by Ben Gamari at 2022-07-16T13:25:41-04:00 cmm: Move toBlockList to GHC.Cmm - - - - - fa092745 by Ben Gamari at 2022-07-16T13:25:41-04:00 compiler: Add haddock sections to GHC.Utils.Panic - - - - - 097759f9 by Ben Gamari at 2022-07-16T13:26:17-04:00 configure: Don't override Windows CXXFLAGS At some point we used the clang distribution from msys2's `MINGW64` environment for our Windows toolchain. This defaulted to using libgcc and libstdc++ for its runtime library. However, we found for a variety of reasons that compiler-rt, libunwind, and libc++ were more reliable, consequently we explicitly overrode the CXXFLAGS to use these. However, since then we have switched to use the `CLANG64` packaging, which default to these already. Consequently we can drop these arguments, silencing some redundant argument warnings from clang. Fixes #21669. - - - - - e38a2684 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Check that there are no NULL ctors - - - - - 616365b0 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/Elf: Introduce support for invoking finalizers on unload Addresses #20494. - - - - - cdd3be20 by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add T20494 - - - - - 03c69d8d by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Rename finit field to fini fini is short for "finalizer", which does not contain a "t". - - - - - 033580bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Refactor handling of oc->info Previously we would free oc->info after running initializers. However, we can't do this is we want to also run finalizers. Moreover, freeing oc->info so early was wrong for another reason: we will need it in order to unregister the exception tables (see the call to `RtlDeleteFunctionTable`). In service of #20494. - - - - - f17912e4 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Add finalization support This implements #20494 for the PEi386 linker. Happily, this also appears to fix `T9405`, resolving #21361. - - - - - 2cd75550 by Ben Gamari at 2022-07-16T23:50:36-04:00 Loader: Implement gnu-style -l:$path syntax Gnu ld allows `-l` to be passed an absolute file path, signalled by a `:` prefix. Implement this in the GHC's loader search logic. - - - - - 5781a360 by Ben Gamari at 2022-07-16T23:50:36-04:00 Statically-link against libc++ on Windows Unfortunately on Windows we have no RPATH-like facility, making dynamic linking extremely fragile. Since we cannot assume that the user will add their GHC installation to `$PATH` (and therefore their DLL search path) we cannot assume that the loader will be able to locate our `libc++.dll`. To avoid this, we instead statically link against `libc++.a` on Windows. Fixes #21435. - - - - - 8e2e883b by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Ensure that all .ctors/.dtors sections are run It turns out that PE objects may have multiple `.ctors`/`.dtors` sections but the RTS linker had assumed that there was only one. Fix this. Fixes #21618. - - - - - fba04387 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Respect dtor/ctor priority Previously we would run constructors and destructors in arbitrary order despite explicit priorities. Fixes #21847. - - - - - 1001952f by Ben Gamari at 2022-07-16T23:50:36-04:00 testsuite: Add test for #21618 and #21847 - - - - - 6f3816af by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/PEi386: Fix exception unwind unregistration RtlDeleteFunctionTable expects a pointer to the .pdata section yet we passed it the .xdata section. Happily, this fixes #21354. - - - - - d9bff44c by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Drop dead code - - - - - d161e6bc by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Use section flags to identify initializers - - - - - fbb17110 by Ben Gamari at 2022-07-16T23:50:36-04:00 rts/linker/MachO: Introduce finalizer support - - - - - 5b0ed8a8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Use system-cxx-std-lib instead of config.stdcxx_impl - - - - - 6c476e1a by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker/Elf: Work around GCC 6 init/fini behavior It appears that GCC 6t (at least on i386) fails to give init_array/fini_array sections the correct SHT_INIT_ARRAY/SHT_FINI_ARRAY section types, instead marking them as SHT_PROGBITS. This caused T20494 to fail on Debian. - - - - - 5f8203b8 by Ben Gamari at 2022-07-16T23:50:37-04:00 testsuite: Mark T13366Cxx as unbroken on Darwin - - - - - 1fd2f851 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Fix resolution of __dso_handle on Darwin Darwin expects a leading underscore. - - - - - a2dc00f3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Clean up section kinds - - - - - aeb1a7c3 by Ben Gamari at 2022-07-16T23:50:37-04:00 rts/linker: Ensure that __cxa_finalize is called on code unload - - - - - 028f081e by Ben Gamari at 2022-07-16T23:51:12-04:00 testsuite: Fix T11829 on Centos 7 It appears that Centos 7 has a more strict C++ compiler than most distributions since std::runtime_error is defined in <stdexcept> rather than <exception>. In T11829 we mistakenly imported the latter. - - - - - a10584e8 by Ben Gamari at 2022-07-17T22:30:32-04:00 hadrian: Rename documentation directories for consistency with make * Rename `docs` to `doc` * Place pdf documentation in `doc/` instead of `doc/pdfs/` Fixes #21164. - - - - - b27c5947 by Anselm Schüler at 2022-07-17T22:31:11-04:00 Fix incorrect proof of applyWhen’s properties - - - - - eb031a5b by Matthew Pickering at 2022-07-18T08:04:47-04:00 hadrian: Add multi:<pkg> and multi targets for starting a multi-repl This patch adds support to hadrian for starting a multi-repl containing all the packages which stage0 can build. In particular, there is the new user-facing command: ``` ./hadrian/ghci-multi ``` which when executed will start a multi-repl containing the `ghc` package and all it's dependencies. This is implemented by two new hadrian targets: ``` ./hadrian/build multi:<pkg> ``` Construct the arguments for a multi-repl session where the top-level package is <pkg>. For example, `./hadrian/ghci-multi` is implemented using `multi:ghc` target. There is also the `multi` command which constructs a repl for everything in stage0 which we can build. - - - - - 19e7cac9 by Eric Lindblad at 2022-07-18T08:05:27-04:00 changelog typo - - - - - af6731a4 by Eric Lindblad at 2022-07-18T08:05:27-04:00 typos - - - - - 415468fe by Simon Peyton Jones at 2022-07-18T16:36:54-04:00 Refactor SpecConstr to use treat bindings uniformly This patch, provoked by #21457, simplifies SpecConstr by treating top-level and nested bindings uniformly (see the new scBind). * Eliminates the mysterious scTopBindEnv * Refactors scBind to handle top-level and nested definitions uniformly. * But, for now at least, continues the status quo of not doing SpecConstr for top-level non-recursive bindings. (In contrast we do specialise nested non-recursive bindings, although the original paper did not; see Note [Local let bindings].) I tried the effect of specialising top-level non-recursive bindings (which is now dead easy to switch on, unlike before) but found some regressions, so I backed off. See !8135. It's a pure refactoring. I think it'll do a better job in a few cases, but there is no regression test. - - - - - d4d3fe6e by Andreas Klebinger at 2022-07-18T16:37:29-04:00 Rule matching: Don't compute the FVs if we don't look at them. - - - - - 5f907371 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 White space only in FamInstEnv - - - - - ae3b3b62 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make transferPolyIdInfo work for CPR I don't know why this hasn't bitten us before, but it was plain wrong. - - - - - 9bdfdd98 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Inline mapAccumLM This function is called in inner loops in the compiler, and it's overloaded and higher order. Best just to inline it. This popped up when I was looking at something else. I think perhaps GHC is delicately balanced on the cusp of inlining this automatically. - - - - - d0b806ff by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Make SetLevels honour floatConsts This fix, in the definition of profitableFloat, is just for consistency. `floatConsts` should do what it says! I don't think it'll affect anything much, though. - - - - - d1c25a48 by Simon Peyton Jones at 2022-07-18T16:38:04-04:00 Refactor wantToUnboxArg a bit * Rename GHC.Core.Opt.WorkWrap.Utils.wantToUnboxArg to canUnboxArg and similarly wantToUnboxResult to canUnboxResult. * Add GHC.Core.Opt.DmdAnal.wantToUnboxArg as a wrapper for the (new) GHC.Core.Opt.WorkWrap.Utils.canUnboxArg, avoiding some yukky duplication. I decided it was clearer to give it a new data type for its return type, because I nedeed the FD_RecBox case which was not otherwise readiliy expressible. * Add dcpc_args to WorkWrap.Utils.DataConPatContext for the payload * Get rid of the Unlift constructor of UnboxingDecision, eliminate two panics, and two arguments to canUnboxArg (new name). Much nicer now. - - - - - 6d8a715e by Teo Camarasu at 2022-07-18T16:38:44-04:00 Allow running memInventory when the concurrent nonmoving gc is enabled If the nonmoving gc is enabled and we are using a threaded RTS, we now try to grab the collector mutex to avoid memInventory and the collection racing. Before memInventory was disabled. - - - - - aa75bbde by Ben Gamari at 2022-07-18T16:39:20-04:00 gitignore: don't ignore all aclocal.m4 files While GHC's own aclocal.m4 is generated by the aclocal tool, other packages' aclocal.m4 are committed in the repository. Previously `.gitignore` included an entry which covered *any* file named `aclocal.m4`, which lead to quite some confusion (e.g. see #21740). Fix this by modifying GHC's `.gitignore` to only cover GHC's own `aclocal.m4`. - - - - - 4b98c5ce by Boris Lykah at 2022-07-19T02:34:12-04:00 Add mapAccumM, forAccumM to Data.Traversable Approved by Core Libraries Committee in https://github.com/haskell/core-libraries-committee/issues/65#issuecomment-1186275433 - - - - - bd92182c by Ben Gamari at 2022-07-19T02:34:47-04:00 configure: Use AC_PATH_TOOL to detect tools Previously we used AC_PATH_PROG which, as noted by #21601, does not look for tools with a target prefix, breaking cross-compilation. Fixes #21601. - - - - - e8c07aa9 by Matthew Pickering at 2022-07-19T10:07:53-04:00 driver: Fix implementation of -S We were failing to stop before running the assembler so the object file was also created. Fixes #21869 - - - - - e2f0094c by Ben Gamari at 2022-07-19T10:08:28-04:00 rts/ProfHeap: Ensure new Censuses are zeroed When growing the Census array ProfHeap previously neglected to zero the new part of the array. Consequently `freeEra` would attempt to free random words that often looked suspiciously like pointers. Fixes #21880. - - - - - 81d65f7f by sheaf at 2022-07-21T15:37:22+02:00 Make withDict opaque to the specialiser As pointed out in #21575, it is not sufficient to set withDict to inline after the typeclass specialiser, because we might inline withDict in one module and then import it in another, and we run into the same problem. This means we could still end up with incorrect runtime results because the typeclass specialiser would assume that distinct typeclass evidence terms at the same type are equal, when this is not necessarily the case when using withDict. Instead, this patch introduces a new magicId, 'nospec', which is only inlined in CorePrep. We make use of it in the definition of withDict to ensure that the typeclass specialiser does not common up distinct typeclass evidence terms. Fixes #21575 - - - - - 9a3e1f31 by Dominik Peteler at 2022-07-22T08:18:40-04:00 Refactored Simplify pass * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify namespace and GHC.Core.Opt.Stats. Also removed services from configuration records. * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration. * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm` and moved the Simplify driver to GHC.Core.Opt.Simplify. * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env. * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment in GHC.Core.Opt.Simplify.Monad. * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions for those in a new module GHC.Driver.Config.Core.Opt.Simplify. Also added initialization functions for `SimplMode` to that module. * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types and the counting types and functions (`SimplCount` and `Tick`) to new module GHC.Core.Opt.Stats. * Added getter functions for the fields of `SimplMode`. The pedantic bottoms option and the platform are retrieved from the ArityOpts and RuleOpts and the getter functions allow us to retrieve values from `SpecEnv` without the knowledge where the data is stored exactly. * Moved the coercion optimization options from the top environment to `SimplMode`. This way the values left in the top environment are those dealing with monadic functionality, namely logging, IO related stuff and counting. Added a note "The environments of the Simplify pass". * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead. * Prep work before removing `InteractiveContext` from `HscEnv`. - - - - - 2c5991cc by Simon Peyton Jones at 2022-07-22T08:18:41-04:00 Make the specialiser deal better with specialised methods This patch fixes #21848, by being more careful to update unfoldings in the type-class specialiser. See the new Note [Update unfolding after specialisation] Now that we are being so much more careful about unfoldings, it turned out that I could dispense with se_interesting, and all its tricky corners. Hooray. This fixes #21368. - - - - - ae166635 by Ben Gamari at 2022-07-22T08:18:41-04:00 ghc-boot: Clean up UTF-8 codecs In preparation for moving the UTF-8 codecs into `base`: * Move them to GHC.Utils.Encoding.UTF8 * Make names more consistent * Add some Haddocks - - - - - e8ac91db by Ben Gamari at 2022-07-22T08:18:41-04:00 base: Introduce GHC.Encoding.UTF8 Here we copy a subset of the UTF-8 implementation living in `ghc-boot` into `base`, with the intent of dropping the former in the future. For this reason, the `ghc-boot` copy is now CPP-guarded on `MIN_VERSION_base(4,18,0)`. Naturally, we can't copy *all* of the functions defined by `ghc-boot` as some depend upon `bytestring`; we rather just copy those which only depend upon `base` and `ghc-prim`. Further consolidation? ---------------------- Currently GHC ships with at least five UTF-8 implementations: * the implementation used by GHC in `ghc-boot:GHC.Utils.Encoding`; this can be used at a number of types including `Addr#`, `ByteArray#`, `ForeignPtr`, `Ptr`, `ShortByteString`, and `ByteString`. Most of this can be removed in GHC 9.6+2, when the copies in `base` will become available to `ghc-boot`. * the copy of the `ghc-boot` definition now exported by `base:GHC.Encoding.UTF8`. This can be used at `Addr#`, `Ptr`, `ByteArray#`, and `ForeignPtr` * the decoder used by `unpackCStringUtf8#` in `ghc-prim:GHC.CString`; this is specialised at `Addr#`. * the codec used by the IO subsystem in `base:GHC.IO.Encoding.UTF8`; this is specialised at `Addr#` but, unlike the above, supports recovery in the presence of partial codepoints (since in IO contexts codepoints may be broken across buffers) * the implementation provided by the `text` library This does seem a tad silly. On the other hand, these implementations *do* materially differ from one another (e.g. in the types they support, the detail in errors they can report, and the ability to recover from partial codepoints). Consequently, it's quite unclear that further consolidate would be worthwhile. - - - - - f9ad8025 by Ben Gamari at 2022-07-22T08:18:41-04:00 Add a Note summarising GHC's UTF-8 implementations GHC has a somewhat dizzying array of UTF-8 implementations. This note describes why this is the case. - - - - - 72dfad3d by Ben Gamari at 2022-07-22T08:18:42-04:00 upload_ghc_libs: Fix path to documentation The documentation was moved in a10584e8df9b346cecf700b23187044742ce0b35 but this one occurrence was note updated. Finally closes #21164. - - - - - a8b150e7 by sheaf at 2022-07-22T08:18:44-04:00 Add test for #21871 This adds a test for #21871, which was fixed by the No Skolem Info rework (MR !7105). Fixes #21871 - - - - - 6379f942 by sheaf at 2022-07-22T08:18:46-04:00 Add test for #21360 The way record updates are typechecked/desugared changed in MR !7981. Because we desugar in the typechecker to a simple case expression, the pattern match checker becomes able to spot the long-distance information and avoid emitting an incorrect pattern match warning. Fixes #21360 - - - - - ce0cd12c by sheaf at 2022-07-22T08:18:47-04:00 Hadrian: don't try to build "unix" on Windows - - - - - dc27e15a by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Implement DeepSubsumption This MR adds the language extension -XDeepSubsumption, implementing GHC proposal #511. This change mitigates the impact of GHC proposal The changes are highly localised, by design. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. The main changes are: * Add -XDeepSubsumption, which is on by default in Haskell98 and Haskell2010, but off in Haskell2021. -XDeepSubsumption largely restores the behaviour before the "simple subsumption" change. -XDeepSubsumpition has a similar flavour as -XNoMonoLocalBinds: it makes type inference more complicated and less predictable, but it may be convenient in practice. * The main changes are in: * GHC.Tc.Utils.Unify.tcSubType, which does deep susumption and eta-expanansion * GHC.Tc.Utils.Unify.tcSkolemiseET, which does deep skolemisation * In GHC.Tc.Gen.App.tcApp we call tcSubTypeNC to match the result type. Without deep subsumption, unifyExpectedType would be sufficent. See Note [Deep subsumption] in GHC.Tc.Utils.Unify. * There are no changes to Quick Look at all. * The type of `withDict` becomes ambiguous; so add -XAllowAmbiguousTypes to GHC.Magic.Dict * I fixed a small but egregious bug in GHC.Core.FVs.varTypeTyCoFVs, where we'd forgotten to take the free vars of the multiplicity of an Id. * I also had to fix tcSplitNestedSigmaTys When I did the shallow-subsumption patch commit 2b792facab46f7cdd09d12e79499f4e0dcd4293f Date: Sun Feb 2 18:23:11 2020 +0000 Simple subsumption I changed tcSplitNestedSigmaTys to not look through function arrows any more. But that was actually an un-forced change. This function is used only in * Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt * Validity checking for default methods: GHC.Tc.TyCl.checkValidClass * A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect All to do with validity checking and error messages. Acutally its fine to look under function arrows here, and quite useful a test DeepSubsumption05 (a test motivated by a build failure in the `lens` package) shows. The fix is easy. I added Note [tcSplitNestedSigmaTys]. - - - - - e31ead39 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add tests that -XHaskell98 and -XHaskell2010 enable DeepSubsumption - - - - - 67189985 by Matthew Pickering at 2022-07-25T09:42:01-04:00 Add DeepSubsumption08 - - - - - 5e93a952 by Simon Peyton Jones at 2022-07-25T09:42:01-04:00 Fix the interaction of operator sections and deep subsumption Fixes DeepSubsumption08 - - - - - 918620d9 by Zubin Duggal at 2022-07-25T09:42:01-04:00 Add DeepSubsumption09 - - - - - 2a773259 by Gabriella Gonzalez at 2022-07-25T09:42:40-04:00 Default implementation for mempty/(<>) Approved by: https://github.com/haskell/core-libraries-committee/issues/61 This adds a default implementation for `mempty` and `(<>)` along with a matching `MINIMAL` pragma so that `Semigroup` and `Monoid` instances can be defined in terms of `sconcat` / `mconcat`. The description for each class has also been updated to include the equivalent set of laws for the `sconcat`-only / `mconcat`-only instances. - - - - - 73836fc8 by Bryan Richter at 2022-07-25T09:43:16-04:00 ci: Disable (broken) perf-nofib See #21859 - - - - - c24ca5c3 by sheaf at 2022-07-25T09:43:58-04:00 Docs: clarify ConstraintKinds infelicity GHC doesn't consistently require the ConstraintKinds extension to be enabled, as it allows programs such as type families returning a constraint without this extension. MR !7784 fixes this infelicity, but breaking user programs was deemed to not be worth it, so we document it instead. Fixes #21061. - - - - - 5f2fbd5e by Simon Peyton Jones at 2022-07-25T09:44:34-04:00 More improvements to worker/wrapper This patch fixes #21888, and simplifies finaliseArgBoxities by eliminating the (recently introduced) data type FinalDecision. A delicate interaction meant that this patch commit d1c25a48154236861a413e058ea38d1b8320273f Date: Tue Jul 12 16:33:46 2022 +0100 Refactor wantToUnboxArg a bit make worker/wrapper go into an infinite loop. This patch fixes it by narrowing the handling of case (B) of Note [Boxity for bottoming functions], to deal only the arguemnts that are type variables. Only then do we drop the trimBoxity call, which is what caused the bug. I also * Added documentation of case (B), which was previously completely un-mentioned. And a regression test, T21888a, to test it. * Made unboxDeeplyDmd stop at lazy demands. It's rare anyway for a bottoming function to have a lazy argument (mainly when the data type is recursive and then we don't want to unbox deeply). Plus there is Note [No lazy, Unboxed demands in demand signature] * Refactored the Case equation for dmdAnal a bit, to do less redundant pattern matching. - - - - - b77d95f8 by Simon Peyton Jones at 2022-07-25T09:45:09-04:00 Fix a small buglet in tryEtaReduce Gergo points out (#21801) that GHC.Core.Opt.Arity.tryEtaReduce was making an ill-formed cast. It didn't matter, because the subsequent guard discarded it; but still worth fixing. Spurious warnings are distracting. - - - - - 3bbde957 by Zubin Duggal at 2022-07-25T09:45:45-04:00 Fix #21889, GHCi misbehaves with Ctrl-C on Windows On Windows, we create multiple levels of wrappers for GHCi which ultimately execute ghc --interactive. In order to handle console events properly, each of these wrappers must call FreeConsole() in order to hand off event processing to the child process. See #14150. In addition to this, FreeConsole must only be called from interactive processes (#13411). This commit makes two changes to fix this situation: 1. The hadrian wrappers generated using `hadrian/bindist/cwrappers/version-wrapper.c` call `FreeConsole` if the CPP flag INTERACTIVE_PROCESS is set, which is set when we are generating a wrapper for GHCi. 2. The GHCi wrapper in `driver/ghci/` calls the `ghc-$VER.exe` executable which is not wrapped rather than calling `ghc.exe` is is wrapped on windows (and usually non-interactive, so can't call `FreeConsole`: Before: ghci-$VER.exe calls ghci.exe which calls ghc.exe which calls ghc-$VER.exe After: ghci-$VER.exe calls ghci.exe which calls ghc-$VER.exe - - - - - 79f1b021 by Simon Jakobi at 2022-07-25T09:46:21-04:00 docs: Fix documentation of \cases Fixes #21902. - - - - - e4bf9592 by sternenseemann at 2022-07-25T09:47:01-04:00 ghc-cabal: allow Cabal 3.8 to unbreak make build When bootstrapping GHC 9.4.*, the build will fail when configuring ghc-cabal as part of the make based build system due to this upper bound, as Cabal has been updated to a 3.8 release. Reference #21914, see especially https://gitlab.haskell.org/ghc/ghc/-/issues/21914#note_444699 - - - - - 726d938e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Fix isEvaldUnfolding and isValueUnfolding This fixes (1) in #21831. Easy, obviously correct. - - - - - 5d26c321 by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Switch off eta-expansion in rules and unfoldings I think this change will make little difference except to reduce clutter. But that's it -- if it causes problems we can switch it on again. - - - - - d4fe2f4e by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Teach SpecConstr about typeDeterminesValue This patch addresses #21831, point 2. See Note [generaliseDictPats] in SpecConstr I took the opportunity to refactor the construction of specialisation rules a bit, so that the rule name says what type we are specialising at. Surprisingly, there's a 20% decrease in compile time for test perf/compiler/T18223. I took a look at it, and the code size seems the same throughout. I did a quick ticky profile which seemed to show a bit less substitution going on. Hmm. Maybe it's the "don't do eta-expansion in stable unfoldings" patch, which is part of the same MR as this patch. Anyway, since it's a move in the right direction, I didn't think it was worth looking into further. Metric Decrease: T18223 - - - - - 65f7838a by Simon Peyton Jones at 2022-07-25T14:38:14-04:00 Add a 'notes' file in testsuite/tests/perf/compiler This file is just a place to accumlate notes about particular benchmarks, so that I don't keep re-inventing the wheel. - - - - - 61faff40 by Simon Peyton Jones at 2022-07-25T14:38:50-04:00 Get the in-scope set right in FamInstEnv.injectiveBranches There was an assert error, as Gergo pointed out in #21896. I fixed this by adding an InScopeSet argument to tcUnifyTyWithTFs. And also to GHC.Core.Unify.niFixTCvSubst. I also took the opportunity to get a couple more InScopeSets right, and to change some substTyUnchecked into substTy. This MR touches a lot of other files, but only because I also took the opportunity to introduce mkInScopeSetList, and use it. - - - - - 4a7256a7 by Cheng Shao at 2022-07-25T20:41:55+00:00 Add location to cc phase - - - - - 96811ba4 by Cheng Shao at 2022-07-25T20:41:55+00:00 Avoid as pipeline when compiling c - - - - - 2869b66d by Cheng Shao at 2022-07-25T20:42:20+00:00 testsuite: Skip test cases involving -S when testing unregisterised GHC We no longer generate .s files anyway. Metric Decrease: MultiLayerModules T10421 T13035 T13701 T14697 T16875 T18140 T18304 T18923 T9198 - - - - - 82a0991a by Ben Gamari at 2022-07-25T23:32:05-04:00 testsuite: introduce nonmoving_thread_sanity way (cherry picked from commit 19f8fce3659de3d72046bea9c61d1a82904bc4ae) - - - - - 4b087973 by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Track segment state It can often be useful during debugging to be able to determine the state of a nonmoving segment. Introduce some state, enabled by DEBUG, to track this. (cherry picked from commit 40e797ef591ae3122ccc98ab0cc3cfcf9d17bd7f) - - - - - 54a5c32d by Ben Gamari at 2022-07-25T23:32:06-04:00 rts/nonmoving: Don't scavenge objects which weren't evacuated This fixes a rather subtle bug in the logic responsible for scavenging objects evacuated to the non-moving generation. In particular, objects can be allocated into the non-moving generation by two ways: a. evacuation out of from-space by the garbage collector b. direct allocation by the mutator Like all evacuation, objects moved by (a) must be scavenged, since they may contain references to other objects located in from-space. To accomplish this we have the following scheme: * each nonmoving segment's block descriptor has a scan pointer which points to the first object which has yet to be scavenged * the GC tracks a set of "todo" segments which have pending scavenging work * to scavenge a segment, we scavenge each of the unmarked blocks between the scan pointer and segment's `next_free` pointer. We skip marked blocks since we know the allocator wouldn't have allocated into marked blocks (since they contain presumably live data). We can stop at `next_free` since, by definition, the GC could not have evacuated any objects to blocks above `next_free` (otherwise `next_free wouldn't be the first free block). However, this neglected to consider objects allocated by path (b). In short, the problem is that objects directly allocated by the mutator may become unreachable (but not swept, since the containing segment is not yet full), at which point they may contain references to swept objects. Specifically, we observed this in #21885 in the following way: 1. the mutator (specifically in #21885, a `lockCAF`) allocates an object (specifically a blackhole, which here we will call `blkh`; see Note [Static objects under the nonmoving collector] for the reason why) on the non-moving heap. The bitmap of the allocated block remains 0 (since allocation doesn't affect the bitmap) and the containing segment's (which we will call `blkh_seg`) `next_free` is advanced. 2. We enter the blackhole, evaluating the blackhole to produce a result (specificaly a cons cell) in the nursery 3. The blackhole gets updated into an indirection pointing to the cons cell; it is pushed to the generational remembered set 4. we perform a GC, the cons cell is evacuated into the nonmoving heap (into segment `cons_seg`) 5. the cons cell is marked 6. the GC concludes 7. the CAF and blackhole become unreachable 8. `cons_seg` is filled 9. we start another GC; the cons cell is swept 10. we start a new GC 11. something is evacuated into `blkh_seg`, adding it to the "todo" list 12. we attempt to scavenge `blkh_seg` (namely, all unmarked blocks between `scan` and `next_free`, which includes `blkh`). We attempt to evacuate `blkh`'s indirectee, which is the previously-swept cons cell. This is unsafe, since the indirectee is no longer a valid heap object. The problem here was that the scavenging logic *assumed* that (a) was the only source of allocations into the non-moving heap and therefore *all* unmarked blocks between `scan` and `next_free` were evacuated. However, due to (b) this is not true. The solution is to ensure that that the scanned region only encompasses the region of objects allocated during evacuation. We do this by updating `scan` as we push the segment to the todo-segment list to point to the block which was evacuated into. Doing this required changing the nonmoving scavenging implementation's update of the `scan` pointer to bump it *once*, instead of after scavenging each block as was done previously. This is because we may end up evacuating into the segment being scavenged as we scavenge it. This was quite tricky to discover but the result is quite simple, demonstrating yet again that global mutable state should be used exceedingly sparingly. Fixes #21885 (cherry picked from commit 0b27ea23efcb08639309293faf13fdfef03f1060) - - - - - 25c24535 by Ben Gamari at 2022-07-25T23:32:06-04:00 testsuite: Skip a few tests as in the nonmoving collector Residency monitoring under the non-moving collector is quite conservative (e.g. the reported value is larger than reality) since otherwise we would need to block on concurrent collection. Skip a few tests that are sensitive to residency. (cherry picked from commit 6880e4fbf728c04e8ce83e725bfc028fcb18cd70) - - - - - 42147534 by sternenseemann at 2022-07-26T16:26:53-04:00 hadrian: add flag disabling selftest rules which require QuickCheck The hadrian executable depends on QuickCheck for building, meaning this library (and its dependencies) will need to be built for bootstrapping GHC in the future. Building QuickCheck, however, can require TemplateHaskell. When building a statically linking GHC toolchain, TemplateHaskell can be tricky to get to work, and cross-compiling TemplateHaskell doesn't work at all without -fexternal-interpreter, so QuickCheck introduces an element of fragility to GHC's bootstrap. Since the selftest rules are the only part of hadrian that need QuickCheck, we can easily eliminate this bootstrap dependency when required by introducing a `selftest` flag guarding the rules' inclusion. Closes #8699. - - - - - 9ea29d47 by Simon Peyton Jones at 2022-07-26T16:27:28-04:00 Regression test for #21848 - - - - - ef30e215 by Matthew Pickering at 2022-07-28T13:56:59-04:00 driver: Don't create LinkNodes when -no-link is enabled Fixes #21866 - - - - - fc23b5ed by sheaf at 2022-07-28T13:57:38-04:00 Docs: fix mistaken claim about kind signatures This patch fixes #21806 by rectifying an incorrect claim about the usage of kind variables in the header of a data declaration with a standalone kind signature. It also adds some clarifications about the number of parameters expected in GADT declarations and in type family declarations. - - - - - 2df92ee1 by Matthew Pickering at 2022-08-02T05:20:01-04:00 testsuite: Correctly set withNativeCodeGen Fixes #21918 - - - - - f2912143 by Matthew Pickering at 2022-08-02T05:20:45-04:00 Fix since annotations in GHC.Stack.CloneStack Fixes #21894 - - - - - aeb8497d by Andreas Klebinger at 2022-08-02T19:26:51-04:00 Add -dsuppress-coercion-types to make coercions even smaller. Instead of `` `cast` <Co:11> :: (Some -> Really -> Large Type)`` simply print `` `cast` <Co:11> :: ... `` - - - - - 97655ad8 by sheaf at 2022-08-02T19:27:29-04:00 User's guide: fix typo in hasfield.rst Fixes #21950 - - - - - 35aef18d by Yiyun Liu at 2022-08-04T02:55:07-04:00 Remove TCvSubst and use Subst for both term and type-level subst This patch removes the TCvSubst data type and instead uses Subst as the environment for both term and type level substitution. This change is partially motivated by the existential type proposal, which will introduce types that contain expressions and therefore forces us to carry around an "IdSubstEnv" even when substituting for types. It also reduces the amount of code because "Subst" and "TCvSubst" share a lot of common operations. There isn't any noticeable impact on performance (geo. mean for ghc/alloc is around 0.0% but we have -94 loc and one less data type to worry abount). Currently, the "TCvSubst" data type for substitution on types is identical to the "Subst" data type except the former doesn't store "IdSubstEnv". Using "Subst" for type-level substitution means there will be a redundant field stored in the data type. However, in cases where the substitution starts from the expression, using "Subst" for type-level substitution saves us from having to project "Subst" into a "TCvSubst". This probably explains why the allocation is mostly even despite the redundant field. The patch deletes "TCvSubst" and moves "Subst" and its relevant functions from "GHC.Core.Subst" into "GHC.Core.TyCo.Subst". Substitution on expressions is still defined in "GHC.Core.Subst" so we don't have to expose the definition of "Expr" in the hs-boot file that "GHC.Core.TyCo.Subst" must import to refer to "IdSubstEnv" (whose codomain is "CoreExpr"). Most functions named fooTCvSubst are renamed into fooSubst with a few exceptions (e.g. "isEmptyTCvSubst" is a distinct function from "isEmptySubst"; the former ignores the emptiness of "IdSubstEnv"). These exceptions mainly exist for performance reasons and will go away when "Expr" and "Type" are mutually recursively defined (we won't be able to take those shortcuts if we can't make the assumption that expressions don't appear in types). - - - - - b99819bd by Krzysztof Gogolewski at 2022-08-04T02:55:43-04:00 Fix TH + defer-type-errors interaction (#21920) Previously, we had to disable defer-type-errors in splices because of #7276. But this fix is no longer necessary, the test T7276 no longer segfaults and is now correctly deferred. - - - - - fb529cae by Andreas Klebinger at 2022-08-04T13:57:25-04:00 Add a note about about W/W for unlifting strict arguments This fixes #21236. - - - - - fffc75a9 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force safeInferred to avoid retaining extra copy of DynFlags This will only have a (very) modest impact on memory but we don't want to retain old copies of DynFlags hanging around so best to force this value. - - - - - 0f43837f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Force name selectors to ensure no reference to Ids enter the NameCache I observed some unforced thunks in the NameCache which were retaining a whole Id, which ends up retaining a Type.. which ends up retaining old copies of HscEnv containing stale HomeModInfo. - - - - - 0b1f5fd1 by Matthew Pickering at 2022-08-04T13:58:01-04:00 Fix leaks in --make mode when there are module loops This patch fixes quite a tricky leak where we would end up retaining stale ModDetails due to rehydrating modules against non-finalised interfaces. == Loops with multiple boot files It is possible for a module graph to have a loop (SCC, when ignoring boot files) which requires multiple boot files to break. In this case we must perform the necessary hydration steps before and after compiling modules which have boot files which are described above for corectness but also perform an additional hydration step at the end of the SCC to remove space leaks. Consider the following example: ┌───────┐ ┌───────┐ │ │ │ │ │ A │ │ B │ │ │ │ │ └─────┬─┘ └───┬───┘ │ │ ┌────▼─────────▼──┐ │ │ │ C │ └────┬─────────┬──┘ │ │ ┌────▼──┐ ┌───▼───┐ │ │ │ │ │ A-boot│ │ B-boot│ │ │ │ │ └───────┘ └───────┘ A, B and C live together in a SCC. Say we compile the modules in order A-boot, B-boot, C, A, B then when we compile A we will perform the hydration steps (because A has a boot file). Therefore C will be hydrated relative to A, and the ModDetails for A will reference C/A. Then when B is compiled C will be rehydrated again, and so B will reference C/A,B, its interface will be hydrated relative to both A and B. Now there is a space leak because say C is a very big module, there are now two different copies of ModDetails kept alive by modules A and B. The way to avoid this space leak is to rehydrate an entire SCC together at the end of compilation so that all the ModDetails point to interfaces for .hs files. In this example, when we hydrate A, B and C together then both A and B will refer to C/A,B. See #21900 for some more discussion. ------------------------------------------------------- In addition to this simple case, there is also the potential for a leak during parallel upsweep which is also fixed by this patch. Transcibed is Note [ModuleNameSet, efficiency and space leaks] Note [ModuleNameSet, efficiency and space leaks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ During unsweep the results of compiling modules are placed into a MVar, to find the environment the module needs to compile itself in the MVar is consulted and the HomeUnitGraph is set accordingly. The reason we do this is that precisely tracking module dependencies and recreating the HUG from scratch each time is very expensive. In serial mode (-j1), this all works out fine because a module can only be compiled after its dependencies have finished compiling and not interleaved with compiling module loops. Therefore when we create the finalised or no loop interfaces, the HUG only contains finalised interfaces. In parallel mode, we have to be more careful because the HUG variable can contain non-finalised interfaces which have been started by another thread. In order to avoid a space leak where a finalised interface is compiled against a HPT which contains a non-finalised interface we have to restrict the HUG to only the visible modules. The visible modules is recording in the ModuleNameSet, this is propagated upwards whilst compiling and explains which transitive modules are visible from a certain point. This set is then used to restrict the HUG before the module is compiled to only the visible modules and thus avoiding this tricky space leak. Efficiency of the ModuleNameSet is of utmost importance because a union occurs for each edge in the module graph. Therefore the set is represented directly as an IntSet which provides suitable performance, even using a UniqSet (which is backed by an IntMap) is too slow. The crucial test of performance here is the time taken to a do a no-op build in --make mode. See test "jspace" for an example which used to trigger this problem. Fixes #21900 - - - - - 1d94a59f by Matthew Pickering at 2022-08-04T13:58:01-04:00 Store interfaces in ModIfaceCache more directly I realised hydration was completely irrelavant for this cache because the ModDetails are pruned from the result. So now it simplifies things a lot to just store the ModIface and Linkable, which we can put into the cache straight away rather than wait for the final version of a HomeModInfo to appear. - - - - - 6c7cd50f by Cheng Shao at 2022-08-04T23:01:45-04:00 cmm: Remove unused ReadOnlyData16 We don't actually emit rodata16 sections anywhere. - - - - - 16333ad7 by Andreas Klebinger at 2022-08-04T23:02:20-04:00 findExternalRules: Don't needlessly traverse the list of rules. - - - - - 52c15674 by Krzysztof Gogolewski at 2022-08-05T12:47:05-04:00 Remove backported items from 9.6 release notes They have been backported to 9.4 in commits 5423d84bd9a28f, 13c81cb6be95c5, 67ccbd6b2d4b9b. - - - - - 78d232f5 by Matthew Pickering at 2022-08-05T12:47:40-04:00 ci: Fix pages job The job has been failing because we don't bundle haddock docs anymore in the docs dist created by hadrian. Fixes #21789 - - - - - 037bc9c9 by Ben Gamari at 2022-08-05T22:00:29-04:00 codeGen/X86: Don't clobber switch variable in switch generation Previously ce8745952f99174ad9d3bdc7697fd086b47cdfb5 assumed that it was safe to clobber the switch variable when generating code for a jump table since we were at the end of a block. However, this assumption is wrong; the register could be live in the jump target. Fixes #21968. - - - - - 50c8e1c5 by Matthew Pickering at 2022-08-05T22:01:04-04:00 Fix equality operator in jspace test - - - - - e9c77a22 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Improve BUILD_PAP comments - - - - - 41234147 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Make dropTail comment a haddock comment - - - - - ff11d579 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Add one more sanity check in stg_restore_cccs - - - - - 1f6c56ae by Andreas Klebinger at 2022-08-06T06:13:17-04:00 StgToCmm: Fix isSimpleScrut when profiling is enabled. When profiling is enabled we must enter functions that might represent thunks in order for their sccs to show up in the profile. We might allocate even if the function is already evaluated in this case. So we can't consider any potential function thunk to be a simple scrut when profiling. Not doing so caused profiled binaries to segfault. - - - - - fab0ee93 by Andreas Klebinger at 2022-08-06T06:13:17-04:00 Change `-fprof-late` to insert cost centres after unfolding creation. The former behaviour of adding cost centres after optimization but before unfoldings are created is not available via the flag `prof-late-inline` instead. I also reduced the overhead of -fprof-late* by pushing the cost centres into lambdas. This means the cost centres will only account for execution of functions and not their partial application. Further I made LATE_CC cost centres it's own CC flavour so they now won't clash with user defined ones if a user uses the same string for a custom scc. LateCC: Don't put cost centres inside constructor workers. With -fprof-late they are rarely useful as the worker is usually inlined. Even if the worker is not inlined or we use -fprof-late-linline they are generally not helpful but bloat compile and run time significantly. So we just don't add sccs inside constructor workers. ------------------------- Metric Decrease: T13701 ------------------------- - - - - - f8bec4e3 by Ben Gamari at 2022-08-06T06:13:53-04:00 gitlab-ci: Fix hadrian bootstrapping of release pipelines Previously we would attempt to test hadrian bootstrapping in the `validate` build flavour. However, `ci.sh` refuses to run validation builds during release pipelines, resulting in job failures. Fix this by testing bootstrapping in the `release` flavour during release pipelines. We also attempted to record perf notes for these builds, which is redundant work and undesirable now since we no longer build in a consistent flavour. - - - - - c0348865 by Ben Gamari at 2022-08-06T11:45:17-04:00 compiler: Eliminate two uses of foldr in favor of foldl' These two uses constructed maps, which is a case where foldl' is generally more efficient since we avoid constructing an intermediate O(n)-depth stack. - - - - - d2e4e123 by Ben Gamari at 2022-08-06T11:45:17-04:00 rts: Fix code style - - - - - 57f530d3 by Ben Gamari at 2022-08-06T11:45:17-04:00 genprimopcode: Drop ArrayArray# references As ArrayArray# no longer exists - - - - - 7267cd52 by Ben Gamari at 2022-08-06T11:45:17-04:00 base: Organize Haddocks in GHC.Conc.Sync - - - - - aa818a9f by Ben Gamari at 2022-08-06T11:48:50-04:00 Add primop to list threads A user came to #ghc yesterday wondering how best to check whether they were leaking threads. We ended up using the eventlog but it seems to me like it would be generally useful if Haskell programs could query their own threads. - - - - - 6d1700b6 by Ben Gamari at 2022-08-06T11:51:35-04:00 rts: Move thread labels into TSO This eliminates the thread label HashTable and instead tracks this information in the TSO, allowing us to use proper StgArrBytes arrays for backing the label and greatly simplifying management of object lifetimes when we expose them to the user with the coming `threadLabel#` primop. - - - - - 1472044b by Ben Gamari at 2022-08-06T11:54:52-04:00 Add a primop to query the label of a thread - - - - - 43f2b271 by Ben Gamari at 2022-08-06T11:55:14-04:00 base: Share finalization thread label For efficiency's sake we float the thread label assigned to the finalization thread to the top-level, ensuring that we only need to encode the label once. - - - - - 1d63b4fb by Ben Gamari at 2022-08-06T11:57:11-04:00 users-guide: Add release notes entry for thread introspection support - - - - - 09bca1de by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix binary distribution install attributes Previously we would use plain `cp` to install various parts of the binary distribution. However, `cp`'s behavior w.r.t. file attributes is quite unclear; for this reason it is much better to rather use `install`. Fixes #21965. - - - - - 2b8ea16d by Ben Gamari at 2022-08-07T01:19:35-04:00 hadrian: Fix installation of system-cxx-std-lib package conf - - - - - 7b514848 by Ben Gamari at 2022-08-07T01:20:10-04:00 gitlab-ci: Bump Docker images To give the ARMv7 job access to lld, fixing #21875. - - - - - afa584a3 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Don't use mk/config.mk.in Ultimately we want to drop mk/config.mk so here I extract the bits needed by the Hadrian bindist installation logic into a Hadrian-specific file. While doing this I fixed binary distribution installation, #21901. - - - - - b9bb45d7 by Ben Gamari at 2022-08-07T05:08:52-04:00 hadrian: Fix naming of cross-compiler wrappers - - - - - 78d04cfa by Ben Gamari at 2022-08-07T11:44:58-04:00 hadrian: Extend xattr Darwin hack to cover /lib As noted in #21506, it is now necessary to remove extended attributes from `/lib` as well as `/bin` to avoid SIP issues on Darwin. Fixes #21506. - - - - - 20457d77 by Andreas Klebinger at 2022-08-08T14:42:26+02:00 NCG(x86): Compile add+shift as lea if possible. - - - - - 742292e4 by Andreas Klebinger at 2022-08-08T16:46:37-04:00 dataToTag#: Skip runtime tag check if argument is infered tagged This addresses one part of #21710. - - - - - 1504a93e by Cheng Shao at 2022-08-08T16:47:14-04:00 rts: remove redundant stg_traceCcszh This out-of-line primop has no Haskell wrapper and hasn't been used anywhere in the tree. Furthermore, the code gets in the way of !7632, so it should be garbage collected. - - - - - a52de3cb by Andreas Klebinger at 2022-08-08T16:47:50-04:00 Document a divergence from the report in parsing function lhss. GHC is happy to parse `(f) x y = x + y` when it should be a parse error based on the Haskell report. Seems harmless enough so we won't fix it but it's documented now. Fixes #19788 - - - - - 5765e133 by Ben Gamari at 2022-08-08T16:48:25-04:00 gitlab-ci: Add release job for aarch64/debian 11 - - - - - 5b26f324 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Introduce validation job for aarch64 cross-compilation Begins to address #11958. - - - - - e866625c by Ben Gamari at 2022-08-08T19:39:20-04:00 Bump process submodule - - - - - ae707762 by Ben Gamari at 2022-08-08T19:39:20-04:00 gitlab-ci: Add basic support for cross-compiler testiing Here we add a simple qemu-based test for cross-compilers. - - - - - 50912d68 by Ben Gamari at 2022-08-08T19:39:57-04:00 rts: Ensure that Array# card arrays are initialized In #19143 I noticed that newArray# failed to initialize the card table of newly-allocated arrays. However, embarrassingly, I then only fixed the issue in newArrayArray# and, in so doing, introduced the potential for an integer underflow on zero-length arrays (#21962). Here I fix the issue in newArray#, this time ensuring that we do not underflow in pathological cases. Fixes #19143. - - - - - e5ceff56 by Ben Gamari at 2022-08-08T19:39:57-04:00 testsuite: Add test for #21962 - - - - - c1c08bd8 by Ben Gamari at 2022-08-09T02:31:14-04:00 gitlab-ci: Don't use coreutils on Darwin In general we want to ensure that the tested environment is as similar as possible to the environment the user will use. In the case of Darwin, this means we want to use the system's BSD command-line utilities, not coreutils. This would have caught #21974. - - - - - 1c582f44 by Ben Gamari at 2022-08-09T02:31:14-04:00 hadrian: Fix bindist installation on Darwin It turns out that `cp -P` on Darwin does not always copy a symlink as a symlink. In order to get these semantics one must pass `-RP`. It's not entirely clear whether this is valid under POSIX, but it is nevertheless what Apple does. - - - - - 681aa076 by Ben Gamari at 2022-08-09T02:31:49-04:00 hadrian: Fix access mode of installed package registration files Previously hadrian's bindist Makefile would modify package registrations placed by `install` via a shell pipeline and `mv`. However, the use of `mv` means that if umask is set then the user may otherwise end up with package registrations which are inaccessible. Fix this by ensuring that the mode is 0644. - - - - - e9dfd26a by Krzysztof Gogolewski at 2022-08-09T02:32:24-04:00 Cleanups around pretty-printing * Remove hack when printing OccNames. No longer needed since e3dcc0d5 * Remove unused `pprCmms` and `instance Outputable Instr` * Simplify `pprCLabel` (no need to pass platform) * Remove evil `Show`/`Eq` instances for `SDoc`. They were needed by ImmLit, but that can take just a String instead. * Remove instance `Outputable CLabel` - proper output of labels needs a platform, and is done by the `OutputableP` instance - - - - - 66d2e927 by Ben Gamari at 2022-08-09T13:46:48-04:00 rts/linker: Resolve iconv_* on FreeBSD FreeBSD's libiconv includes an implementation of the iconv_* functions in libc. Unfortunately these can only be resolved using dlvsym, which is how the RTS linker usually resolves such functions. To fix this we include an ad-hoc special case for iconv_*. Fixes #20354. - - - - - 5d66a0ce by Ben Gamari at 2022-08-09T13:46:48-04:00 system-cxx-std-lib: Add support for FreeBSD libcxxrt - - - - - ea90e61d by Ben Gamari at 2022-08-09T13:46:48-04:00 gitlab-ci: Bump to use freebsd13 runners - - - - - d71a2051 by sheaf at 2022-08-09T13:47:28-04:00 Fix size_up_alloc to account for UnliftedDatatypes The size_up_alloc function mistakenly considered any type that isn't lifted to not allocate anything, which is wrong. What we want instead is to check the type isn't boxed. This accounts for (BoxedRep Unlifted). Fixes #21939 - - - - - 76b52cf0 by Douglas Wilson at 2022-08-10T06:01:53-04:00 testsuite: 21651 add test for closeFdWith + setNumCapabilities This bug does not affect windows, which does not use the base module GHC.Event.Thread. - - - - - 7589ee72 by Douglas Wilson at 2022-08-10T06:01:53-04:00 base: Fix races in IOManager (setNumCapabilities,closeFdWith) Fix for #21651 Fixes three bugs: - writes to eventManager should be atomic. It is accessed concurrently by ioManagerCapabilitiesChanged and closeFdWith. - The race in closeFdWith described in the ticket. - A race in getSystemEventManager where it accesses the 'IOArray' in 'eventManager' before 'ioManagerCapabilitiesChanged' has written to 'eventManager', causing an Array Index exception. The fix here is to 'yield' and retry. - - - - - dc76439d by Trevis Elser at 2022-08-10T06:02:28-04:00 Updates language extension documentation Adding a 'Status' field with a few values: - Deprecated - Experimental - InternalUseOnly - Noting if included in 'GHC2021', 'Haskell2010' or 'Haskell98' Those values are pulled from the existing descriptions or elsewhere in the documentation. While at it, include the :implied by: where appropriate, to provide more detail. Fixes #21475 - - - - - 823fe5b5 by Jens Petersen at 2022-08-10T06:03:07-04:00 hadrian RunRest: add type signature for stageNumber avoids warning seen on 9.4.1: src/Settings/Builders/RunTest.hs:264:53: warning: [-Wtype-defaults] • Defaulting the following constraints to type ‘Integer’ (Show a0) arising from a use of ‘show’ at src/Settings/Builders/RunTest.hs:264:53-84 (Num a0) arising from a use of ‘stageNumber’ at src/Settings/Builders/RunTest.hs:264:59-83 • In the second argument of ‘(++)’, namely ‘show (stageNumber (C.stage ctx))’ In the second argument of ‘($)’, namely ‘"config.stage=" ++ show (stageNumber (C.stage ctx))’ In the expression: arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | 264 | , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compilation tested locally - - - - - f95bbdca by Sylvain Henry at 2022-08-10T09:44:46-04:00 Add support for external static plugins (#20964) This patch adds a new command-line flag: -fplugin-library=<file-path>;<unit-id>;<module>;<args> used like this: -fplugin-library=path/to/plugin.so;package-123;Plugin.Module;["Argument","List"] It allows a plugin to be loaded directly from a shared library. With this approach, GHC doesn't compile anything for the plugin and doesn't load any .hi file for the plugin and its dependencies. As such GHC doesn't need to support two environments (one for plugins, one for target code), which was the more ambitious approach tracked in #14335. Fix #20964 Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 5bc489ca by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Fix ARMv7 build It appears that the CI refactoring carried out in 5ff690b8474c74e9c968ef31e568c1ad0fe719a1 failed to carry over some critical configuration: setting the build/host/target platforms and forcing use of a non-broken linker. - - - - - 596db9a5 by Ben Gamari at 2022-08-10T09:45:22-04:00 gitlab-ci: Run ARMv7 jobs when ~ARM label is used - - - - - 7cabea7c by Ben Gamari at 2022-08-10T15:37:58-04:00 hadrian: Don't attempt to install documentation if doc/ doesn't exist Previously we would attempt to install documentation even if the `doc` directory doesn't exist (e.g. due to `--docs=none`). This would result in the surprising side-effect of the entire contents of the bindist being installed in the destination documentation directory. Fix this. Fixes #21976. - - - - - 67575f20 by normalcoder at 2022-08-10T15:38:34-04:00 ncg/aarch64: Don't use x18 register on AArch64/Darwin Apple's ABI documentation [1] says: "The platforms reserve register x18. Don’t use this register." While this wasn't problematic in previous Darwin releases, macOS 13 appears to start zeroing this register periodically. See #21964. [1] https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms - - - - - 45eb4cbe by Andreas Klebinger at 2022-08-10T22:41:12-04:00 Note [Trimming auto-rules]: State that this improves compiler perf. - - - - - 5c24b1b3 by Bodigrim at 2022-08-10T22:41:50-04:00 Document that threadDelay / timeout are susceptible to overflows on 32-bit machines - - - - - ff67c79e by Alan Zimmerman at 2022-08-11T16:19:57-04:00 EPA: DotFieldOcc does not have exact print annotations For the code {-# LANGUAGE OverloadedRecordUpdate #-} operatorUpdate f = f{(+) = 1} There are no exact print annotations for the parens around the + symbol, nor does normal ppr print them. This MR fixes that. Closes #21805 Updates haddock submodule - - - - - dca43a04 by Matthew Pickering at 2022-08-11T16:20:33-04:00 Revert "gitlab-ci: Add release job for aarch64/debian 11" This reverts commit 5765e13370634979eb6a0d9f67aa9afa797bee46. The job was not tested before being merged and fails CI (https://gitlab.haskell.org/ghc/ghc/-/jobs/1139392) Ticket #22005 - - - - - ffc9116e by Eric Lindblad at 2022-08-16T09:01:26-04:00 typo - - - - - cd6f5bfd by Ben Gamari at 2022-08-16T09:02:02-04:00 CmmToLlvm: Don't aliasify builtin LLVM variables Our aliasification logic would previously turn builtin LLVM variables into aliases, which apparently confuses LLVM. This manifested in initializers failing to be emitted, resulting in many profiling failures with the LLVM backend. Fixes #22019. - - - - - dc7da356 by Bryan Richter at 2022-08-16T09:02:38-04:00 run_ci: remove monoidal-containers Fixes #21492 MonoidalMap is inlined and used to implement Variables, as before. The top-level value "jobs" is reimplemented as a regular Map, since it doesn't use the monoidal union anyway. - - - - - 64110544 by Cheng Shao at 2022-08-16T09:03:15-04:00 CmmToAsm/AArch64: correct a typo - - - - - f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00 Fix #21979 - compact-share failing with -O I don't have good reason to believe the optimization level should affect if sharing works or not here. So limit the test to the normal way. - - - - - 68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix reference to dead llvm-version substitution Fixes #22052. - - - - - 28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Fix incorrect reference to `:extension: role - - - - - 71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Add :ghc-flag: reference - - - - - 385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00 hadrian: Place manpage in docroot This relocates it from docs/ to doc/ - - - - - 84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00 Bump haddock submodule Includes merge of `main` into `ghc-head` as well as some Haddock users guide fixes. - - - - - 59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00 base: Add changelog entries from ghc-9.2 Closes #21922. - - - - - a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00 relnotes: Add "included libraries" section As noted in #21988, some users rely on this. - - - - - a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00 users-guide: Rephrase the rewrite rule documentation Previously the wording was a tad unclear. Fix this. Closes #21114. - - - - - 3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00 Implement Response File support for HPC This is an improvement to HPC authored by Richard Wallace (https://github.com/purefn) and myself. I have received permission from him to attempt to upstream it. This improvement was originally implemented as a patch to HPC via input-output-hk/haskell.nix: https://github.com/input-output-hk/haskell.nix/pull/1464 Paraphrasing Richard, HPC currently requires all inputs as command line arguments. With large projects this can result in an argument list too long error. I have only seen this error in Nix, but I assume it can occur is a plain Unix environment. This MR adds the standard response file syntax support to HPC. For example you can now pass a file to the command line which contains the arguments. ``` hpc @response_file_1 @response_file_2 ... The contents of a Response File must have this format: COMMAND ... example: report my_library.tix --include=ModuleA --include=ModuleB ``` Updates hpc submodule Co-authored-by: Richard Wallace <rwallace at thewallacepack.net> Fixes #22050 - - - - - 436867d6 by Matthew Pickering at 2022-08-18T09:24:08-04:00 ghc-heap: Fix decoding of TSO closures An extra field was added to the TSO structure in 6d1700b6 but the decoding logic in ghc-heap was not updated for this new field. Fixes #22046 - - - - - a740a4c5 by Matthew Pickering at 2022-08-18T09:24:44-04:00 driver: Honour -x option The -x option is used to manually specify which phase a file should be started to be compiled from (even if it lacks the correct extension). I just failed to implement this when refactoring the driver. In particular Cabal calls GHC with `-E -cpp -x hs Foo.cpphs` to preprocess source files using GHC. I added a test to exercise this case. Fixes #22044 - - - - - e293029d by Simon Peyton Jones at 2022-08-18T09:25:19-04:00 Be more careful in chooseInferredQuantifiers This fixes #22065. We were failing to retain a quantifier that was mentioned in the kind of another retained quantifier. Easy to fix. - - - - - 714c936f by Bryan Richter at 2022-08-18T18:37:21-04:00 testsuite: Add test for #21583 - - - - - 989b844d by Ben Gamari at 2022-08-18T18:37:57-04:00 compiler: Drop --build-id=none hack Since 2011 the object-joining implementation has had a hack to pass `--build-id=none` to `ld` when supported, seemingly to work around a linker bug. This hack is now unnecessary and may break downstream users who expect objects to have valid build-ids. Remove it. Closes #22060. - - - - - 519c712e by Matthew Pickering at 2022-08-19T00:09:11-04:00 Make ru_fn field strict to avoid retaining Ids It's better to perform this projection from Id to Name strictly so we don't retain an old Id (hence IdInfo, hence Unfolding, hence everything etc) - - - - - 7dda04b0 by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force `getOccFS bndr` to avoid retaining reference to Bndr. This is another symptom of #19619 - - - - - 4303acba by Matthew Pickering at 2022-08-19T00:09:11-04:00 Force unfoldings when they are cleaned-up in Tidy and CorePrep If these thunks are not forced then the entire unfolding for the binding is live throughout the whole of CodeGen despite the fact it should have been discarded. Fixes #22071 - - - - - 2361b3bc by Matthew Pickering at 2022-08-19T00:09:47-04:00 haddock docs: Fix links from identifiers to dependent packages When implementing the base_url changes I made the pretty bad mistake of zipping together two lists which were in different orders. The simpler thing to do is just modify `haddockDependencies` to also return the package identifier so that everything stays in sync. Fixes #22001 - - - - - 9a7e2ea1 by Matthew Pickering at 2022-08-19T00:10:23-04:00 Revert "Refactor SpecConstr to use treat bindings uniformly" This reverts commit 415468fef8a3e9181b7eca86de0e05c0cce31729. This refactoring introduced quite a severe residency regression (900MB live from 650MB live when compiling mmark), see #21993 for a reproducer and more discussion. Ticket #21993 - - - - - 9789e845 by Zachary Wood at 2022-08-19T14:17:28-04:00 tc: warn about lazy annotations on unlifted arguments (fixes #21951) - - - - - e5567289 by Andreas Klebinger at 2022-08-19T14:18:03-04:00 Fix #22048 where we failed to drop rules for -fomit-interface-pragmas. Now we also filter the local rules (again) which fixes the issue. - - - - - 51ffd009 by Swann Moreau at 2022-08-19T18:29:21-04:00 Print constraints in quotes (#21167) This patch improves the uniformity of error message formatting by printing constraints in quotes, as we do for types. Fix #21167 - - - - - ab3e0f5a by Sasha Bogicevic at 2022-08-19T18:29:57-04:00 19217 Implicitly quantify type variables in :kind command - - - - - 9939e95f by MorrowM at 2022-08-21T16:51:38-04:00 Recognize file-header pragmas in GHCi (#21507) - - - - - fb7c2d99 by Matthew Pickering at 2022-08-21T16:52:13-04:00 hadrian: Fix bootstrapping with ghc-9.4 The error was that we were trying to link together containers from boot package library (which depends template-haskell in boot package library) template-haskell from in-tree package database So the fix is to build containers in stage0 (and link against template-haskell built in stage0). Fixes #21981 - - - - - b946232c by Mario Blažević at 2022-08-22T22:06:21-04:00 Added pprType with precedence argument, as a prerequisite to fix issues #21723 and #21942. * refines the precedence levels, adding `qualPrec` and `funPrec` to better control parenthesization * `pprParendType`, `pprFunArgType`, and `instance Ppr Type` all just call `pprType` with proper precedence * `ParensT` constructor is now always printed parenthesized * adds the precedence argument to `pprTyApp` as well, as it needs to keep track and pass it down * using `>=` instead of former `>` to match the Core type printing logic * some test outputs have changed, losing extraneous parentheses - - - - - fe4ff0f7 by Mario Blažević at 2022-08-22T22:06:21-04:00 Fix and test for issue #21723 - - - - - 33968354 by Mario Blažević at 2022-08-22T22:06:21-04:00 Test for issue #21942 - - - - - c9655251 by Mario Blažević at 2022-08-22T22:06:21-04:00 Updated the changelog - - - - - 80102356 by Ben Gamari at 2022-08-22T22:06:57-04:00 hadrian: Don't duplicate binaries on installation Previously we used `install` on symbolic links, which ended up copying the target file rather than installing a symbolic link. Fixes #22062. - - - - - b929063e by M Farkas-Dyck at 2022-08-24T02:37:01-04:00 Unbreak Haddock comments in `GHC.Core.Opt.WorkWrap.Utils`. Closes #22092. - - - - - 112e4f9c by Cheng Shao at 2022-08-24T02:37:38-04:00 driver: don't actually merge objects when ar -L works - - - - - a9f0e68e by Ben Gamari at 2022-08-24T02:38:13-04:00 rts: Consistently use MiB in stats output Previously we would say `MB` even where we meant `MiB`. - - - - - a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. * And finally, it was the strange treatment of join-point Ids in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 15111af6 by Zubin Duggal at 2022-09-01T01:18:50-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 7d3a055d by Krzysztof Gogolewski at 2022-09-01T01:19:26-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 31a8989a by Tommy Bidne at 2022-09-01T12:01:20-04:00 Change Ord defaults per CLC proposal Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/24#issuecomment-1233331267 - - - - - 7f527f01 by Matthew Pickering at 2022-09-01T12:01:56-04:00 Fix bootstrap with ghc-9.0 It turns out Solo is a very recent addition to base, so for older GHC versions we just defined it inline here the one place we use it in the compiler. - - - - - d2be80fd by Sebastian Graf at 2022-09-05T23:12:14-04:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 25f68ace by Ben Gamari at 2022-09-05T23:12:50-04:00 gitlab-ci: Ensure that ghc derivation is in scope Previously the lint-ci job attempted to use cabal-install (specifically `cabal update`) without a GHC in PATH. However, cabal-install-3.8 appears to want GHC, even for `cabal update`. - - - - - f37b621f by sheaf at 2022-09-06T11:51:53+00:00 Update instances.rst, clarifying InstanceSigs Fixes #22103 - - - - - d4f908f7 by Jan Hrček at 2022-09-06T15:36:58-04:00 Fix :add docs in user guide - - - - - 808bb793 by Cheng Shao at 2022-09-06T15:37:35-04:00 ci: remove unused build_make/test_make in ci script - - - - - d0a2efb2 by Eric Lindblad at 2022-09-07T16:42:45-04:00 typo - - - - - fac0098b by Eric Lindblad at 2022-09-07T16:42:45-04:00 typos - - - - - a581186f by Eric Lindblad at 2022-09-07T16:42:45-04:00 whitespace - - - - - 04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00 CmmToAsm: remove unused ModLocation from NatM_State - - - - - ee1cfaa9 by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Minor SDoc cleanup Change calls to renderWithContext with showSDocOneLine; it's more efficient and explanatory. Remove polyPatSig (unused) - - - - - 7918265d by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Remove Outputable Char instance Use 'text' instead of 'ppr'. Using 'ppr' on the list "hello" rendered as "h,e,l,l,o". - - - - - 77209ab3 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Export liftA2 from Prelude Changes: In order to be warning free and compatible, we hide Applicative(..) from Prelude in a few places and instead import it directly from Control.Applicative. Please see the migration guide at https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md for more details. This means that Applicative is now exported in its entirety from Prelude. Motivation: This change is motivated by a few things: * liftA2 is an often used function, even more so than (<*>) for some people. * When implementing Applicative, the compiler will prompt you for either an implementation of (<*>) or of liftA2, but trying to use the latter ends with an error, without further imports. This could be confusing for newbies. * For teaching, it is often times easier to introduce liftA2 first, as it is a natural generalisation of fmap. * This change seems to have been unanimously and enthusiastically accepted by the CLC members, possibly indicating a lot of love for it. * This change causes very limited breakage, see the linked issue below for an investigation on this. See https://github.com/haskell/core-libraries-committee/issues/50 for the surrounding discussion and more details. - - - - - 442a94e8 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Add changelog entry for liftA2 export from Prelude - - - - - fb968680 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule containers to one with liftA2 warnings fixed - - - - - f54ff818 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule Cabal to one with liftA2 warnings fixed - - - - - a4b34808 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Isolate some Applicative hidings to GHC.Prelude By reexporting the entirety of Applicative from GHC.Prelude, we can save ourselves some `hiding` and importing of `Applicative` in consumers of GHC.Prelude. This also has the benefit of isolating this type of change to GHC.Prelude, so that people in the future don't have to think about it. - - - - - 9c4ea90c by Cheng Shao at 2022-09-08T17:49:47-04:00 CmmToC: enable 64-bit CallishMachOp on 32-bit targets Normally, the unregisterised builds avoid generating 64-bit CallishMachOp in StgToCmm, so CmmToC doesn't support these. However, there do exist cases where we'd like to invoke cmmToC for other cmm inputs which may contain such CallishMachOps, and it's a rather low effort to add support for these since they only require calling into existing ghc-prim cbits. - - - - - 04062510 by Alexis King at 2022-09-11T11:30:32+02:00 Add native delimited continuations to the RTS This patch implements GHC proposal 313, "Delimited continuation primops", by adding native support for delimited continuations to the GHC RTS. All things considered, the patch is relatively small. It almost exclusively consists of changes to the RTS; the compiler itself is essentially unaffected. The primops come with fairly extensive Haddock documentation, and an overview of the implementation strategy is given in the Notes in rts/Continuation.c. This first stab at the implementation prioritizes simplicity over performance. Most notably, every continuation is always stored as a single, contiguous chunk of stack. If one of these chunks is particularly large, it can result in poor performance, as the current implementation does not attempt to cleverly squeeze a subset of the stack frames into the existing stack: it must fit all at once. If this proves to be a performance issue in practice, a cleverer strategy would be a worthwhile target for future improvements. - - - - - ee471dfb by Cheng Shao at 2022-09-12T07:07:33-04:00 rts: fix missing dirty_MVAR argument in stg_writeIOPortzh - - - - - a5f9c35f by Cheng Shao at 2022-09-12T13:29:05-04:00 ci: enable parallel compression for xz - - - - - 3a815f30 by Ryan Scott at 2022-09-12T13:29:41-04:00 Windows: Always define _UCRT when compiling C code As seen in #22159, this is required to ensure correct behavior when MinGW-w64 headers are in the `C_INCLUDE_PATH`. Fixes #22159. - - - - - 65a0bd69 by sheaf at 2022-09-13T10:27:52-04:00 Add diagnostic codes This MR adds diagnostic codes, assigning unique numeric codes to error and warnings, e.g. error: [GHC-53633] Pattern match is redundant This is achieved as follows: - a type family GhcDiagnosticCode that gives the diagnostic code for each diagnostic constructor, - a type family ConRecursInto that specifies whether to recur into an argument of the constructor to obtain a more fine-grained code (e.g. different error codes for different 'deriving' errors), - generics machinery to generate the value-level function assigning each diagnostic its error code; see Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. The upshot is that, to add a new diagnostic code, contributors only need to modify the two type families mentioned above. All logic relating to diagnostic codes is thus contained to the GHC.Types.Error.Codes module, with no code duplication. This MR also refactors error message datatypes a bit, ensuring we can derive Generic for them, and cleans up the logic around constraint solver reports by splitting up 'TcSolverReportInfo' into separate datatypes (see #20772). Fixes #21684 - - - - - 362cca13 by sheaf at 2022-09-13T10:27:53-04:00 Diagnostic codes: acccept test changes The testsuite output now contains diagnostic codes, so many tests need to be updated at once. We decided it was best to keep the diagnostic codes in the testsuite output, so that contributors don't inadvertently make changes to the diagnostic codes. - - - - - 08f6730c by Adam Gundry at 2022-09-13T10:28:29-04:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - c14370d7 by Cheng Shao at 2022-09-13T10:29:07-04:00 ci: remove unused appveyor config - - - - - dc6af9ed by Cheng Shao at 2022-09-13T10:29:45-04:00 compiler: remove unused lazy state monad - - - - - 646d15ad by Eric Lindblad at 2022-09-14T03:13:56-04:00 Fix typos This fixes various typos and spelling mistakes in the compiler. Fixes #21891 - - - - - 7d7e71b0 by Matthew Pickering at 2022-09-14T03:14:32-04:00 hadrian: Bump index state This bumps the index state so a build plan can also be found when booting with 9.4. Fixes #22165 - - - - - 98b62871 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - b42cedbe by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6515c32b by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - e470e91f by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - c4438347 by Matthew Pickering at 2022-09-14T17:17:04-04:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 71d8db86 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add extra implicit dependencies from DeriveLift ghc -M should know that modules which use DeriveLift (or TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have to add these extra edges manually or the modules will be compiled before TH.Lib.Internal is compiled which leads to a desugarer error. - - - - - 43e574f0 by Greg Steuck at 2022-09-14T17:17:43-04:00 Repair c++ probing on OpenBSD Failure without this change: ``` checking C++ standard library flavour... libc++ checking for linkage against 'c++ c++abi'... failed checking for linkage against 'c++ cxxrt'... failed configure: error: Failed to find C++ standard library ``` - - - - - 534b39ee by Douglas Wilson at 2022-09-14T17:18:21-04:00 libraries: template-haskell: vendor filepath differently Vendoring with ../ in hs-source-dirs prevents upload to hackage. (cherry picked from commit 1446be7586ba70f9136496f9b67f792955447842) - - - - - bdd61cd6 by M Farkas-Dyck at 2022-09-14T22:39:34-04:00 Unbreak Hadrian with Cabal 3.8. - - - - - df04d6ec by Krzysztof Gogolewski at 2022-09-14T22:40:09-04:00 Fix typos - - - - - d6ea8356 by Andreas Klebinger at 2022-09-15T10:12:41+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 7cce7007 by Andreas Klebinger at 2022-09-15T10:12:42+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 88c4cbdb by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: enable -fprof-late only for profiling ways - - - - - d7235831 by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: add late_ccs flavour transformer - - - - - ce203753 by Cheng Shao at 2022-09-16T13:58:34-04:00 configure: remove unused program checks - - - - - 9b4c1056 by Pierre Le Marre at 2022-09-16T13:59:16-04:00 Update to Unicode 15.0 - - - - - c6e9b89a by Bodigrim at 2022-09-16T13:59:55-04:00 Avoid partial head and tail in ghc-heap; replace with total pattern-matching - - - - - 616afde3 by Cheng Shao at 2022-09-16T14:00:33-04:00 hadrian: relax Cabal upper bound to allow building with Cabal-3.8 A follow up of !8910. - - - - - df35d994 by Alexis King at 2022-09-16T14:01:11-04:00 Add links to the continuations haddocks in the docs for each primop fixes #22176 - - - - - 383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 5031bf49 by sheaf at 2022-09-16T21:42:49-04:00 Hadrian: Don't try to build terminfo on Windows Commit b42cedbe introduced a dependency on terminfo on Windows, but that package isn't available on Windows. - - - - - c9afe221 by M Farkas-Dyck at 2022-09-17T06:44:47-04:00 Clean up some. In particular: • Delete some dead code, largely under `GHC.Utils`. • Clean up a few definitions in `GHC.Utils.(Misc, Monad)`. • Clean up `GHC.Types.SrcLoc`. • Derive stock `Functor, Foldable, Traversable` for more types. • Derive more instances for newtypes. Bump haddock submodule. - - - - - 85431ac3 by Cheng Shao at 2022-09-17T06:45:25-04:00 driver: pass original Cmm filename in ModLocation When compiling Cmm, the ml_hs_file field is used to indicate Cmm filename when later generating DWARF information. We should pass the original filename here, otherwise for preprocessed Cmm files, the filename will be a temporary filename which is confusing. - - - - - 63aa0069 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: remove legacy logging cabal flag - - - - - bd0f4184 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: make threaded ways optional For certain targets (e.g. wasm32-wasi), the threaded rts is known not to work. This patch adds a "threaded" cabal flag to rts to make threaded rts ways optional. Hadrian enables this flag iff the flavour rtsWays contains threaded ways. - - - - - 8a666ad2 by Ryan Scott at 2022-09-18T08:00:44-04:00 DeriveFunctor: Check for last type variables using dataConUnivTyVars Previously, derived instances of `Functor` (as well as the related classes `Foldable`, `Traversable`, and `Generic1`) would determine which constraints to infer by checking for fields that contain the last type variable. The problem was that this last type variable was taken from `tyConTyVars`. For GADTs, the type variables in each data constructor are _not_ the same type variables as in `tyConTyVars`, leading to #22167. This fixes the issue by instead checking for the last type variable using `dataConUnivTyVars`. (This is very similar in spirit to the fix for #21185, which also replaced an errant use of `tyConTyVars` with type variables from each data constructor.) Fixes #22167. - - - - - 78037167 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: pass updated buffer to actions (#22201) In the lexer, predicates have the following type: { ... } :: user -- predicate state -> AlexInput -- input stream before the token -> Int -- length of the token -> AlexInput -- input stream after the token -> Bool -- True <=> accept the token This is documented in the Alex manual. There is access to the input stream both before and after the token. But when the time comes to construct the token, GHC passes only the initial string buffer to the lexer action. This patch fixes it: - type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token) + type Action = PsSpan -> StringBuffer -> Int -> StringBuffer -> P (PsLocated Token) Now lexer actions have access to the string buffer both before and after the token, just like the predicates. It's just a matter of passing an additional function parameter throughout the lexer. - - - - - 75746594 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: define varsym without predicates (#22201) Before this patch, the varsym lexing rules were defined as follows: <0> { @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix } @varsym / { followedByOpeningToken } { varsym_prefix } @varsym / { precededByClosingToken } { varsym_suffix } @varsym { varsym_loose_infix } } Unfortunately, this meant that the predicates 'precededByClosingToken' and 'followedByOpeningToken' were recomputed several times before we could figure out the whitespace context. With this patch, we check for whitespace context directly in the lexer action: <0> { @varsym { with_op_ws varsym } } The checking for opening/closing tokens happens in 'with_op_ws' now, which is part of the lexer action rather than the lexer predicate. - - - - - c1f81b38 by M Farkas-Dyck at 2022-09-19T09:07:05-04:00 Scrub partiality about `NewOrData`. Rather than a list of constructors and a `NewOrData` flag, we define `data DataDefnCons a = NewTypeCon a | DataTypeCons [a]`, which enforces a newtype to have exactly one constructor. Closes #22070. Bump haddock submodule. - - - - - 1e1ed8c5 by Cheng Shao at 2022-09-19T09:07:43-04:00 CmmToC: emit __builtin_unreachable() after noreturn ccalls Emit a __builtin_unreachable() call after a foreign call marked as CmmNeverReturns. This is crucial to generate correctly typed code for wasm; as for other archs, this is also beneficial for the C compiler optimizations. - - - - - 19f45a25 by Jan Hrček at 2022-09-20T03:49:29-04:00 Document :unadd GHCi command in user guide - - - - - 545ff490 by sheaf at 2022-09-20T03:50:06-04:00 Hadrian: merge archives even in stage 0 We now always merge .a archives when ar supports -L. This change is necessary in order to bootstrap GHC using GHC 9.4 on Windows, as nested archives aren't supported. Not doing so triggered bug #21990 when trying to use the Win32 package, with errors such as: Not a x86_64 PE+ file. Unknown COFF 4 type in getHeaderInfo. ld.lld: error: undefined symbol: Win32zm2zi12zi0zi0_SystemziWin32ziConsoleziCtrlHandler_withConsoleCtrlHandler1_info We have to be careful about which ar is meant: in stage 0, the check should be done on the system ar (system-ar in system.config). - - - - - 59fe128c by Vladislav Zavialov at 2022-09-20T03:50:42-04:00 Fix -Woperator-whitespace for consym (part of #19372) Due to an oversight, the initial specification and implementation of -Woperator-whitespace focused on varsym exclusively and completely ignored consym. This meant that expressions such as "x+ y" would produce a warning, while "x:+ y" would not. The specification was corrected in ghc-proposals pull request #404, and this patch updates the implementation accordingly. Regression test included. - - - - - c4c2cca0 by John Ericson at 2022-09-20T13:11:49-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 7beb356e by John Ericson at 2022-09-20T13:11:50-04:00 Relax instances for Functor combinators; put superclass on Class1 and Class2 to make non-breaking This change is approved by the Core Libraries commitee in https://github.com/haskell/core-libraries-committee/issues/10 The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 6a8c6b5e by Tom Ellis at 2022-09-20T13:12:27-04:00 Add notes to ghc-prim Haddocks that users should not import it - - - - - ee9d0f5c by matoro at 2022-09-20T13:13:06-04:00 docs: clarify that LLVM codegen is not available in unregisterised mode The current docs are misleading and suggest that it is possible to use LLVM codegen from an unregisterised build. This is not the case; attempting to pass `-fllvm` to an unregisterised build warns: ``` when making flags consistent: warning: Target platform uses unregisterised ABI, so compiling via C ``` and uses the C codegen anyway. - - - - - 854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00 rts: remove copy-paste error from `cabal.rts.in` This was, likely accidentally, introduced in 4bf542bf1c. See: 4bf542bf1cdf2fa468457fc0af21333478293476 - - - - - c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00 hadrian: Add extra_dependencies edges for all different ways The hack to add extra dependencies needed by DeriveLift extension missed the cases for profiles and dynamic ways. For the profiled way this leads to errors like: ``` GHC error in desugarer lookup in Data.IntSet.Internal: Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’ Perhaps you haven't installed the profiling libraries for package ‘template-haskell’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. ghc: panic! (the 'impossible' happened) GHC version 9.5.20220916: initDs ``` Therefore the fix is to add these extra edges in. Fixes #22197 - - - - - a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00 users-guide: fix incorrect ghcappdata folder for unix and windows - - - - - 06ccad0d by sheaf at 2022-09-21T08:28:49-04:00 Don't use isUnliftedType in isTagged The function GHC.Stg.InferTags.Rewrite.isTagged can be given the Id of a join point, which might be representation polymorphic. This would cause the call to isUnliftedType to crash. It's better to use typeLevity_maybe instead. Fixes #22212 - - - - - c0ba775d by Teo Camarasu at 2022-09-21T14:30:37-04:00 Add fragmentation statistic to GHC.Stats Implements #21537 - - - - - 2463df2f by Torsten Schmits at 2022-09-21T14:31:24-04:00 Rename Solo[constructor] to MkSolo Part of proposal 475 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst) Moves all tuples to GHC.Tuple.Prim Updates ghc-prim version (and bumps bounds in dependents) updates haddock submodule updates deepseq submodule updates text submodule - - - - - 9034fada by Matthew Pickering at 2022-09-22T09:25:29-04:00 Update filepath to filepath-1.4.100.0 Updates submodule * Always rely on vendored filepath * filepath must be built as stage0 dependency because it uses template-haskell. Towards #22098 - - - - - 615e2278 by Krzysztof Gogolewski at 2022-09-22T09:26:05-04:00 Minor refactor around Outputable * Replace 'text . show' and 'ppr' with 'int'. * Remove Outputable.hs-boot, no longer needed * Use pprWithCommas * Factor out instructions in AArch64 codegen - - - - - aeafdba5 by Sebastian Graf at 2022-09-27T15:14:54+02:00 Demand: Clear distinction between Call SubDmd and eval Dmd (#21717) In #21717 we saw a reportedly unsound strictness signature due to an unsound definition of plusSubDmd on Calls. This patch contains a description and the fix to the unsoundness as outlined in `Note [Call SubDemand vs. evaluation Demand]`. This fix means we also get rid of the special handling of `-fpedantic-bottoms` in eta-reduction. Thanks to less strict and actually sound strictness results, we will no longer eta-reduce the problematic cases in the first place, even without `-fpedantic-bottoms`. So fixing the unsoundness also makes our eta-reduction code simpler with less hacks to explain. But there is another, more unfortunate side-effect: We *unfix* #21085, but fortunately we have a new fix ready: See `Note [mkCall and plusSubDmd]`. There's another change: I decided to make `Note [SubDemand denotes at least one evaluation]` a lot simpler by using `plusSubDmd` (instead of `lubPlusSubDmd`) even if both argument demands are lazy. That leads to less precise results, but in turn rids ourselves from the need for 4 different `OpMode`s and the complication of `Note [Manual specialisation of lub*Dmd/plus*Dmd]`. The result is simpler code that is in line with the paper draft on Demand Analysis. I left the abandoned idea in `Note [Unrealised opportunity in plusDmd]` for posterity. The fallout in terms of regressions is negligible, as the testsuite and NoFib shows. ``` Program Allocs Instrs -------------------------------------------------------------------------------- hidden +0.2% -0.2% linear -0.0% -0.7% -------------------------------------------------------------------------------- Min -0.0% -0.7% Max +0.2% +0.0% Geometric Mean +0.0% -0.0% ``` Fixes #21717. - - - - - 9b1595c8 by Ross Paterson at 2022-09-27T14:12:01-04:00 implement proposal 106 (Define Kinds Without Promotion) (fixes #6024) includes corresponding changes to haddock submodule - - - - - c2d73cb4 by Andreas Klebinger at 2022-09-28T15:07:30-04:00 Apply some tricks to speed up core lint. Below are the noteworthy changes and if given their impact on compiler allocations for a type heavy module: * Use the oneShot trick on LintM * Use a unboxed tuple for the result of LintM: ~6% reduction * Avoid a thunk for the result of typeKind in lintType: ~5% reduction * lint_app: Don't allocate the error msg in the hot code path: ~4% reduction * lint_app: Eagerly force the in scope set: ~4% * nonDetCmpType: Try to short cut using reallyUnsafePtrEquality#: ~2% * lintM: Use a unboxed maybe for the `a` result: ~12% * lint_app: make go_app tail recursive to avoid allocating the go function as heap closure: ~7% * expandSynTyCon_maybe: Use a specialized data type For a less type heavy module like nofib/spectral/simple compiled with -O -dcore-lint allocations went down by ~24% and compile time by ~9%. ------------------------- Metric Decrease: T1969 ------------------------- - - - - - b74b6191 by sheaf at 2022-09-28T15:08:10-04:00 matchLocalInst: do domination analysis When multiple Given quantified constraints match a Wanted, and there is a quantified constraint that dominates all others, we now pick it to solve the Wanted. See Note [Use only the best matching quantified constraint]. For example: [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b [G] d2: forall a . C a Int => D a Int [W] {w}: D a Int When solving the Wanted, we find that both Givens match, but we pick the second, because it has a weaker precondition, C a Int, compared to (Eq a, Num Int, C a Int). We thus say that d2 dominates d1; see Note [When does a quantified instance dominate another?]. This domination test is done purely in terms of superclass expansion, in the function GHC.Tc.Solver.Interact.impliedBySCs. We don't attempt to do a full round of constraint solving; this simple check suffices for now. Fixes #22216 and #22223 - - - - - 2a53ac18 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that module * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times. This is compiler/perf, showing only changes over 1%: Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -50.2% GOOD ManyConstructors(normal) +1.0% MultiLayerModulesTH_OneShot(normal) +2.6% PmSeriesG(normal) -1.1% T10547(normal) -1.2% T11195(normal) -1.2% T11276(normal) -1.0% T11303b(normal) -1.6% T11545(normal) -1.4% T11822(normal) -1.3% T12150(optasm) -1.0% T12234(optasm) -1.2% T13056(optasm) -9.3% GOOD T13253(normal) -3.8% GOOD T15164(normal) -3.6% GOOD T16190(normal) -2.1% T16577(normal) -2.8% GOOD T16875(normal) -1.6% T17836(normal) +2.2% T17977b(normal) -1.0% T18223(normal) -33.3% GOOD T18282(normal) -3.4% GOOD T18304(normal) -1.4% T18698a(normal) -1.4% GOOD T18698b(normal) -1.3% GOOD T19695(normal) -2.5% GOOD T5837(normal) -2.3% T9630(normal) -33.0% GOOD WWRec(normal) -9.7% GOOD hard_hole_fits(normal) -2.1% GOOD hie002(normal) +1.6% geo. mean -2.2% minimum -50.2% maximum +2.6% I diligently investigated some of the big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlessly specialising wrappers LargeRecord, T9630 For runtimes, here is perf/should+_run: Metrics: runtime/bytes allocated -------------------------------- T12990(normal) -3.8% T5205(normal) -1.3% T9203(normal) -10.7% GOOD haddock.Cabal(normal) +0.1% haddock.base(normal) -1.1% haddock.compiler(normal) -0.3% lazy-bs-alloc(normal) -0.2% ------------------------------------------ geo. mean -0.3% minimum -10.7% maximum +0.1% I did not investigate exactly what happens in T9203. Nofib is a wash: +-------------------------------++--+-----------+-----------+ | || | tsv (rel) | std. err. | +===============================++==+===========+===========+ | real/anna || | -0.13% | 0.0% | | real/fem || | +0.13% | 0.0% | | real/fulsom || | -0.16% | 0.0% | | real/lift || | -1.55% | 0.0% | | real/reptile || | -0.11% | 0.0% | | real/smallpt || | +0.51% | 0.0% | | spectral/constraints || | +0.20% | 0.0% | | spectral/dom-lt || | +1.80% | 0.0% | | spectral/expert || | +0.33% | 0.0% | +===============================++==+===========+===========+ | geom mean || | | | +-------------------------------++--+-----------+-----------+ I spent quite some time investigating dom-lt, but it's pretty complicated. See my note on !7847. Conclusion: it's just a delicate inlining interaction, and we have plenty of those. Metric Decrease: LargeRecord T13056 T13253 T15164 T16577 T18223 T18282 T18698a T18698b T19695 T9630 WWRec hard_hole_fits T9203 - - - - - addeefc0 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Refactor UnfoldingSource and IfaceUnfolding I finally got tired of the way that IfaceUnfolding reflected a previous structure of unfoldings, not the current one. This MR refactors UnfoldingSource and IfaceUnfolding to be simpler and more consistent. It's largely just a refactor, but in UnfoldingSource (which moves to GHC.Types.Basic, since it is now used in IfaceSyn too), I distinguish between /user-specified/ and /system-generated/ stable unfoldings. data UnfoldingSource = VanillaSrc | StableUserSrc -- From a user-specified pragma | StableSystemSrc -- From a system-generated unfolding | CompulsorySrc This has a minor effect in CSE (see the use of isisStableUserUnfolding in GHC.Core.Opt.CSE), which I tripped over when working on specialisation, but it seems like a Good Thing to know anyway. - - - - - 7be6f9a4 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 INLINE/INLINEABLE pragmas in Foreign.Marshal.Array Foreign.Marshal.Array contains many small functions, all of which are overloaded, and which are critical for performance. Yet none of them had pragmas, so it was a fluke whether or not they got inlined. This patch makes them all either INLINE (small ones) or INLINEABLE and hence specialisable (larger ones). See Note [Specialising array operations] in that module. - - - - - b0c89dfa by Jade Lovelace at 2022-09-28T17:49:49-04:00 Export OnOff from GHC.Driver.Session I was working on fixing an issue where HLS was trying to pass its DynFlags to HLint, but didn't pass any of the disabled language extensions, which HLint would then assume are on because of their default values. Currently it's not possible to get any of the "No" flags because the `DynFlags.extensions` field can't really be used since it is [OnOff Extension] and OnOff is not exported. So let's export it. - - - - - 2f050687 by Bodigrim at 2022-09-28T17:50:28-04:00 Avoid Data.List.group; prefer Data.List.NonEmpty.group This allows to avoid further partiality, e. g., map head . group is replaced by map NE.head . NE.group, and there are less panic calls. - - - - - bc0020fa by M Farkas-Dyck at 2022-09-28T22:51:59-04:00 Clean up `findWiredInUnit`. In particular, avoid `head`. - - - - - 6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00 Eliminate headFS, use unconsFS instead A small step towards #22185 to avoid partial functions + safe implementation of `startsWithUnderscore`. - - - - - 5a535172 by Sebastian Graf at 2022-09-29T17:04:20+02:00 Demand: Format Call SubDemands `Cn(sd)` as `C(n,sd)` (#22231) Justification in #22231. Short form: In a demand like `1C1(C1(L))` it was too easy to confuse which `1` belongs to which `C`. Now that should be more obvious. Fixes #22231 - - - - - ea0083bf by Bryan Richter at 2022-09-29T15:48:38-04:00 Revert "ci: enable parallel compression for xz" Combined wxth XZ_OPT=9, this blew the memory capacity of CI runners. This reverts commit a5f9c35f5831ef5108e87813a96eac62803852ab. - - - - - f5e8f493 by Sebastian Graf at 2022-09-30T18:42:13+02:00 Boxity: Don't update Boxity unless worker/wrapper follows (#21754) A small refactoring in our Core Opt pipeline and some new functions for transfering argument boxities from one signature to another to facilitate `Note [Don't change boxity without worker/wrapper]`. Fixes #21754. - - - - - 4baf7b1c by M Farkas-Dyck at 2022-09-30T17:45:47-04:00 Scrub various partiality involving empty lists. Avoids some uses of `head` and `tail`, and some panics when an argument is null. - - - - - 95ead839 by Alexis King at 2022-10-01T00:37:43-04:00 Fix a bug in continuation capture across multiple stack chunks - - - - - 22096652 by Bodigrim at 2022-10-01T00:38:22-04:00 Enforce internal invariant of OrdList and fix bugs in viewCons / viewSnoc `viewCons` used to ignore `Many` constructor completely, returning `VNothing`. `viewSnoc` violated internal invariant of `Many` being a non-empty list. - - - - - 48ab9ca5 by Nicolas Trangez at 2022-10-04T20:34:10-04:00 chore: extend `.editorconfig` for C files - - - - - b8df5c72 by Brandon Chinn at 2022-10-04T20:34:46-04:00 Fix docs for pattern synonyms - - - - - 463ffe02 by Oleg Grenrus at 2022-10-04T20:35:24-04:00 Use sameByteArray# in sameByteArray - - - - - fbe1e86e by Pierre Le Marre at 2022-10-05T15:58:43+02:00 Minor fixes following Unicode 15.0.0 update - Fix changelog for Unicode 15.0.0 - Fix the checksums of the downloaded Unicode files, in base's tool: "ucd2haskell". - - - - - 8a31d02e by Cheng Shao at 2022-10-05T20:40:41-04:00 rts: don't enforce aligned((8)) on 32-bit targets We simply need to align to the word size for pointer tagging to work. On 32-bit targets, aligned((8)) is wasteful. - - - - - 532de368 by Ryan Scott at 2022-10-06T07:45:46-04:00 Export symbolSing, SSymbol, and friends (CLC#85) This implements this Core Libraries Proposal: https://github.com/haskell/core-libraries-committee/issues/85 In particular, it: 1. Exposes the `symbolSing` method of `KnownSymbol`, 2. Exports the abstract `SSymbol` type used in `symbolSing`, and 3. Defines an API for interacting with `SSymbol`. This also makes corresponding changes for `natSing`/`KnownNat`/`SNat` and `charSing`/`KnownChar`/`SChar`. This fixes #15183 and addresses part (2) of #21568. - - - - - d83a92e6 by sheaf at 2022-10-07T07:36:30-04:00 Remove mention of make from README.md - - - - - 945e8e49 by Bodigrim at 2022-10-10T17:13:31-04:00 Add a newline before since pragma in Data.Array.Byte - - - - - 44fcdb04 by Vladislav Zavialov at 2022-10-10T17:14:06-04:00 Parser/PostProcess: rename failOp* functions There are three functions named failOp* in the parser: failOpNotEnabledImportQualifiedPost failOpImportQualifiedTwice failOpFewArgs Only the last one has anything to do with operators. The other two were named this way either by mistake or due to a misunderstanding of what "op" stands for. This small patch corrects this. - - - - - 96d32ff2 by Simon Peyton Jones at 2022-10-10T22:30:21+01:00 Make rewrite rules "win" over inlining If a rewrite rule and a rewrite rule compete in the simplifier, this patch makes sure that the rewrite rule "win". That is, in general a bit fragile, but it's a huge help when making specialisation work reliably, as #21851 and #22097 showed. The change is fairly straightforwad, and documented in Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration. Compile-times change, up and down a bit -- in some cases because we get better specialisation. But the payoff (more reliable specialisation) is large. Metrics: compile_time/bytes allocated ----------------------------------------------- T10421(normal) +3.7% BAD T10421a(normal) +5.5% T13253(normal) +1.3% T14052(ghci) +1.8% T15304(normal) -1.4% T16577(normal) +3.1% BAD T17516(normal) +2.3% T17836(normal) -1.9% T18223(normal) -1.8% T8095(normal) -1.3% T9961(normal) +2.5% BAD geo. mean +0.0% minimum -1.9% maximum +5.5% Nofib results are (bytes allocated) +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || +0.27% | | imaginary/rfib || -0.04% | | real/anna || +0.02% | | real/fem || -0.04% | | real/fluid || +1.68% | | real/gamteb || -0.34% | | real/gg || +1.54% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/infer || -0.03% | | real/prolog || +0.02% | | real/veritas || -0.47% | | shootout/fannkuch-redux || -0.03% | | shootout/k-nucleotide || -0.02% | | shootout/n-body || -0.06% | | shootout/spectral-norm || -0.01% | | spectral/cryptarithm2 || +1.25% | | spectral/fibheaps || +18.33% | | spectral/last-piece || -0.34% | +===============================++==========+ | geom mean || +0.17% | There are extensive notes in !8897 about the regressions. Briefly * fibheaps: there was a very delicately balanced inlining that tipped over the wrong way after this change. * cryptarithm2 and paraffins are caused by #22274, which is a separate issue really. (I.e. the right fix is *not* to make inlining "win" over rules.) So I'm accepting these changes Metric Increase: T10421 T16577 T9961 - - - - - ed4b5885 by Joachim Breitner at 2022-10-10T23:16:11-04:00 Utils.JSON: do not escapeJsonString in ToJson String instance as `escapeJsonString` is used in `renderJSON`, so the `JSString` constructor is meant to carry the unescaped string. - - - - - fbb88740 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - e058b138 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Interface Files with Core Definitions This commit adds three new flags * -fwrite-if-simplified-core: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for including the core bindings in an interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of these extended interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 9789ea8e by Matthew Pickering at 2022-10-11T12:48:45-04:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - caced757 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Don't keep exit join points so much We were religiously keeping exit join points throughout, which had some bad effects (#21148, #22084). This MR does two things: * Arranges that exit join points are inhibited from inlining only in /one/ Simplifier pass (right after Exitification). See Note [Be selective about not-inlining exit join points] in GHC.Core.Opt.Exitify It's not a big deal, but it shaves 0.1% off compile times. * Inline used-once non-recursive join points very aggressively Given join j x = rhs in joinrec k y = ....j x.... where this is the only occurrence of `j`, we want to inline `j`. (Unless sm_keep_exits is on.) See Note [Inline used-once non-recursive join points] in GHC.Core.Opt.Simplify.Utils This is just a tidy-up really. It doesn't change allocation, but getting rid of a binding is always good. Very effect on nofib -- some up and down. - - - - - 284cf387 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Make SpecConstr bale out less often When doing performance debugging on #22084 / !8901, I found that the algorithm in SpecConstr.decreaseSpecCount was so aggressive that if there were /more/ specialisations available for an outer function, that could more or less kill off specialisation for an /inner/ function. (An example was in nofib/spectral/fibheaps.) This patch makes it a bit more aggressive, by dividing by 2, rather than by the number of outer specialisations. This makes the program bigger, temporarily: T19695(normal) ghc/alloc +11.3% BAD because we get more specialisation. But lots of other programs compile a bit faster and the geometric mean in perf/compiler is 0.0%. Metric Increase: T19695 - - - - - 66af1399 by Cheng Shao at 2022-10-11T12:49:59-04:00 CmmToC: emit explicit tail calls when the C compiler supports it Clang 13+ supports annotating a return statement using the musttail attribute, which guarantees that it lowers to a tail call if compilation succeeds. This patch takes advantage of that feature for the unregisterised code generator. The configure script tests availability of the musttail attribute, if it's available, the Cmm tail calls will become C tail calls that avoids the mini interpreter trampoline overhead. Nothing is affected if the musttail attribute is not supported. Clang documentation: https://clang.llvm.org/docs/AttributeReference.html#musttail - - - - - 7f0decd5 by Matthew Pickering at 2022-10-11T12:50:40-04:00 Don't include BufPos in interface files Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162 - - - - - dce9f320 by Cheng Shao at 2022-10-11T12:51:19-04:00 CLabel: fix isInfoTableLabel isInfoTableLabel does not take Cmm info table into account. This patch is required for data section layout of wasm32 NCG to work. - - - - - da679f2e by Bodigrim at 2022-10-11T18:02:59-04:00 Extend documentation for Data.List, mostly wrt infinite lists - - - - - 9c099387 by jwaldmann at 2022-10-11T18:02:59-04:00 Expand comment for Data.List.permutations - - - - - d3863cb7 by Bodigrim at 2022-10-11T18:03:37-04:00 ByteArray# is unlifted, not unboxed - - - - - f6260e8b by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 69ccec2c by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6e8feb4 by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 866c736e by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Refactor IPE tracing support - - - - - 6b0d2022 by Ben Gamari at 2022-10-11T23:45:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 9b572d54 by Ben Gamari at 2022-10-11T23:45:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 27978ceb by Krzysztof Gogolewski at 2022-10-11T23:45:46-04:00 Make Cmm Lint messages use dump style Lint errors indicate an internal error in GHC, so it makes sense to use it instead of the user style. This is consistent with Core Lint and STG Lint: https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Core/Lint.hs#L429 https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Stg/Lint.hs#L144 Fixes #22218. - - - - - 64a390d9 by Bryan Richter at 2022-10-12T09:52:51+03:00 Mark T7919 as fragile On x86_64-linux, T7919 timed out ~30 times during July 2022. And again ~30 times in September 2022. - - - - - 481467a5 by Ben Gamari at 2022-10-12T08:08:37-04:00 rts: Don't hint inlining of appendToRunQueue These hints have resulted in compile-time warnings due to failed inlinings for quite some time. Moreover, it's quite unlikely that inlining them is all that beneficial given that they are rather sizeable functions. Resolves #22280. - - - - - 81915089 by Curran McConnell at 2022-10-12T16:32:26-04:00 remove name shadowing - - - - - 626652f7 by Tamar Christina at 2022-10-12T16:33:13-04:00 winio: do not re-translate input when handle is uncooked - - - - - 5172789a by Charles Taylor at 2022-10-12T16:33:57-04:00 Unrestricted OverloadedLabels (#11671) Implements GHC proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - ce293908 by Andreas Klebinger at 2022-10-13T05:58:19-04:00 Add a perf test for the generics code pattern from #21839. This code showed a strong shift between compile time (got worse) and run time (got a lot better) recently which is perfectly acceptable. However it wasn't clear why the compile time regression was happening initially so I'm adding this test to make it easier to track such changes in the future. - - - - - 78ab7afe by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 44692713 by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Add support for .fini sections - - - - - beebf546 by Simon Hengel at 2022-10-13T05:59:37-04:00 Update phases.rst (the name of the original source file is $1, not $2) - - - - - eda6c05e by Finley McIlwaine at 2022-10-13T06:00:17-04:00 Clearer error msg for newtype GADTs with defaulted kind When a newtype introduces GADT eq_specs due to a defaulted RuntimeRep, we detect this and print the error message with explicit kinds. This also refactors newtype type checking to use the new diagnostic infra. Fixes #21447 - - - - - 43ab435a by Pierre Le Marre at 2022-10-14T07:45:43-04:00 Add standard Unicode case predicates isUpperCase and isLowerCase. These predicates use the standard Unicode case properties and are more intuitive than isUpper and isLower. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/90#issuecomment-1276649403. Fixes #14589 - - - - - aec5a443 by Bodigrim at 2022-10-14T07:46:21-04:00 Add type signatures in where-clause of Data.List.permutations The type of interleave' is very much revealing, otherwise it's extremely tough to decipher. - - - - - ee0deb80 by Ben Gamari at 2022-10-14T18:29:20-04:00 rts: Use pthread_setname_np correctly on Darwin As noted in #22206, pthread_setname_np on Darwin only supports setting the name of the calling thread. Consequently we must introduce a trampoline which first sets the thread name before entering the thread entrypoint. - - - - - 8eff62a4 by Ben Gamari at 2022-10-14T18:29:57-04:00 testsuite: Add test for #22282 This will complement mpickering's more general port of foundation's numerical testsuite, providing a test for the specific case found in #22282. - - - - - 62a55001 by Ben Gamari at 2022-10-14T18:29:57-04:00 ncg/aarch64: Fix sub-word sign extension yet again In adc7f108141a973b6dcb02a7836eed65d61230e8 we fixed a number of issues to do with sign extension in the AArch64 NCG found by ghc/test-primops>. However, this patch made a critical error, assuming that getSomeReg would allocate a fresh register for the result of its evaluation. However, this is not the case as `getSomeReg (CmmReg r) == r`. Consequently, any mutation of the register returned by `getSomeReg` may have unwanted side-effects on other expressions also mentioning `r`. In the fix listed above, this manifested as the registers containing the operands of binary arithmetic operations being incorrectly sign-extended. This resulted in #22282. Sadly, the rather simple structure of the tests generated by `test-primops` meant that this particular case was not exercised. Even more surprisingly, none of our testsuite caught this case. Here we fix this by ensuring that intermediate sign extension is performed in a fresh register. Fixes #22282. - - - - - 54e41b16 by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: ensure we are below maxHeapSize after returning megablocks When the heap is heavily block fragmented the live byte size might be low while the memory usage is high. We want to ensure that heap overflow triggers in these cases. We do so by checking that we can return enough megablocks to under maxHeapSize at the end of GC. - - - - - 29bb90db by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: trigger a major collection if megablock usage exceeds maxHeapSize When the heap is suffering from block fragmentation, live bytes might be low while megablock usage is high. If megablock usage exceeds maxHeapSize, we want to trigger a major GC to try to recover some memory otherwise we will die from a heapOverflow at the end of the GC. Fixes #21927 - - - - - 4a4641ca by Teo Camarasu at 2022-10-15T18:11:29+01:00 Add realease note for #21927 - - - - - c1e5719a by Sebastian Graf at 2022-10-17T11:58:46-04:00 DmdAnal: Look through unfoldings of DataCon wrappers (#22241) Previously, the demand signature we computed upfront for a DataCon wrapper lacked boxity information and was much less precise than the demand transformer for the DataCon worker. In this patch we adopt the solution to look through unfoldings of DataCon wrappers during Demand Analysis, but still attach a demand signature for other passes such as the Simplifier. See `Note [DmdAnal for DataCon wrappers]` for more details. Fixes #22241. - - - - - 8c72411d by Gergo ERDI at 2022-10-17T19:20:04-04:00 Add `Enum (Down a)` instance that swaps `succ` and `pred` See https://github.com/haskell/core-libraries-committee/issues/51 for discussion. The key points driving the implementation are the following two ideas: * For the `Int` type, `comparing (complement @Int)` behaves exactly as an order-swapping `compare @Int`. * `enumFrom @(Down a)` can be implemented in terms of `enumFromThen @a`, if only the corner case of starting at the very end is handled specially - - - - - d80ad2f4 by Alan Zimmerman at 2022-10-17T19:20:40-04:00 Update the check-exact infrastructure to match ghc-exactprint GHC tests the exact print annotations using the contents of utils/check-exact. The same functionality is provided via https://github.com/alanz/ghc-exactprint The latter was updated to ensure it works with all of the files on hackage when 9.2 was released, as well as updated to ensure users of the library could work properly (apply-refact, retrie, etc). This commit brings the changes from ghc-exactprint into GHC/utils/check-exact, adapting for the changes to master. Once it lands, it will form the basis for the 9.4 version of ghc-exactprint. See also discussion around this process at #21355 - - - - - 08ab5419 by Andreas Klebinger at 2022-10-17T19:21:15-04:00 Avoid allocating intermediate lists for non recursive bindings. We do so by having an explicit folding function that doesn't need to allocate intermediate lists first. Fixes #22196 - - - - - ff6275ef by Andreas Klebinger at 2022-10-17T19:21:52-04:00 Testsuite: Add a new tables_next_to_code predicate. And use it to avoid T21710a failing on non-tntc archs. Fixes #22169 - - - - - abb82f38 by Eric Lindblad at 2022-10-17T19:22:33-04:00 example rewrite - - - - - 39beb801 by Eric Lindblad at 2022-10-17T19:22:33-04:00 remove redirect - - - - - 0d9fb651 by Eric Lindblad at 2022-10-17T19:22:33-04:00 use heredoc - - - - - 0fa2d185 by Matthew Pickering at 2022-10-17T19:23:10-04:00 testsuite: Fix typo when setting llvm_ways Since 2014 llvm_ways has been set to [] so none of the tests which use only_ways(llvm_ways) have worked as expected. Hopefully the tests still pass with this typo fix! - - - - - ced664a2 by Krzysztof Gogolewski at 2022-10-17T19:23:10-04:00 Fix T15155l not getting -fllvm - - - - - 0ac60423 by Andreas Klebinger at 2022-10-18T03:34:47-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 9ecd1ac0 by M Farkas-Dyck at 2022-10-18T03:35:38-04:00 Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions. - - - - - f60244d7 by Ben Gamari at 2022-10-18T03:36:15-04:00 configure: Bump minimum bootstrap GHC version Fixes #22245 - - - - - ba4bd4a4 by Matthew Pickering at 2022-10-18T03:36:55-04:00 Build System: Remove out-of-date comment about make build system Both make and hadrian interleave compilation of modules of different modules and don't respect the package boundaries. Therefore I just remove this comment which points out this "difference". Fixes #22253 - - - - - e1bbd368 by Matthew Pickering at 2022-10-18T16:15:49+02:00 Allow configuration of error message printing This MR implements the idea of #21731 that the printing of a diagnostic method should be configurable at the printing time. The interface of the `Diagnostic` class is modified from: ``` class Diagnostic a where diagnosticMessage :: a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` to ``` class Diagnostic a where type DiagnosticOpts a defaultDiagnosticOpts :: DiagnosticOpts a diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` and so each `Diagnostic` can implement their own configuration record which can then be supplied by a client in order to dictate how to print out the error message. At the moment this only allows us to implement #21722 nicely but in future it is more natural to separate the configuration of how much information we put into an error message and how much we decide to print out of it. Updates Haddock submodule - - - - - 99dc3e3d by Matthew Pickering at 2022-10-18T16:15:53+02:00 Add -fsuppress-error-contexts to disable printing error contexts in errors In many development environments, the source span is the primary means of seeing what an error message relates to, and the In the expression: and In an equation for: clauses are not particularly relevant. However, they can grow to be quite long, which can make the message itself both feel overwhelming and interact badly with limited-space areas. It's simple to implement this flag so we might as well do it and give the user control about how they see their messages. Fixes #21722 - - - - - 5b3a992f by Dai at 2022-10-19T10:45:45-04:00 Add VecSlot for unboxed sums of SIMD vectors This patch adds the missing `VecRep` case to `primRepSlot` function and all the necessary machinery to carry this new `VecSlot` through code generation. This allows programs involving unboxed sums of SIMD vectors to be written and compiled. Fixes #22187 - - - - - 6d7d9181 by sheaf at 2022-10-19T10:45:45-04:00 Remove SIMD conversions This patch makes it so that packing/unpacking SIMD vectors always uses the right sized types, e.g. unpacking a Word16X4# will give a tuple of Word16#s. As a result, we can get rid of the conversion instructions that were previously required. Fixes #22296 - - - - - 3be48877 by sheaf at 2022-10-19T10:45:45-04:00 Cmm Lint: relax SIMD register assignment check As noted in #22297, SIMD vector registers can be used to store different kinds of values, e.g. xmm1 can be used both to store integer and floating point values. The Cmm type system doesn't properly account for this, so we weaken the Cmm register assignment lint check to only compare widths when comparing a vector type with its allocated vector register. - - - - - f7b7a312 by sheaf at 2022-10-19T10:45:45-04:00 Disable some SIMD tests on non-X86 architectures - - - - - 83638dce by M Farkas-Dyck at 2022-10-19T10:46:29-04:00 Scrub various partiality involving lists (again). Lets us avoid some use of `head` and `tail`, and some panics. - - - - - c3732c62 by M Farkas-Dyck at 2022-10-19T10:47:13-04:00 Enforce invariant of `ListBag` constructor. - - - - - 488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00 More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches` and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches` contains a single instance, but these invariants are immediately lost afterwards and not encoded in types. This patch enforces the invariants by pattern matching and makes types more precise, avoiding asserts and partial functions such as `head`. - - - - - 607ce263 by sheaf at 2022-10-19T10:47:52-04:00 Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap - - - - - 1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00 Add SpliceTypes test for hie files This test checks that typed splices and quotes get the right type information when used in hiefiles. See #21619 - - - - - a8b52786 by Jan Hrček at 2022-10-19T10:49:09-04:00 Small language fixes in 'Using GHC' - - - - - 1dab1167 by Gergő Érdi at 2022-10-19T10:49:51-04:00 Fix typo in `Opt_WriteIfSimplifiedCore`'s name - - - - - b17cfc9c by sheaf at 2022-10-19T10:50:37-04:00 TyEq:N assertion: only for saturated applications The assertion that checked TyEq:N in canEqCanLHSFinish incorrectly triggered in the case of an unsaturated newtype TyCon heading the RHS, even though we can't unwrap such an application. Now, we only trigger an assertion failure in case of a saturated application of a newtype TyCon. Fixes #22310 - - - - - ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - f40c2b66 by Ryan Scott at 2023-07-19T08:55:31-04:00 Draft: Use HsExpanded for untyped TH expression splices This changes the way that untyped Template Haskell expression splices are handled such that they are folded into the `HsExpanded` machinery. This, in turn, makes `splitHsApps` look through TH splices, which fixes #21077. TODO RGS: Add a more detailed description of the changes in the commit message, and add more documentation. - - - - - 19 changed files: - − .appveyor.sh - .editorconfig - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - + .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - + .gitlab/hello.hs - + .gitlab/hie.yaml The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1d48bcffcf70dcd38c12531ec6541f3067d2eda...f40c2b6638286fb052ef470065a2b5242d744c9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c1d48bcffcf70dcd38c12531ec6541f3067d2eda...f40c2b6638286fb052ef470065a2b5242d744c9c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 13:06:12 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 19 Jul 2023 09:06:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21077-take-two Message-ID: <64b7dfc439be7_3a4b0fb7430447852@gitlab.mail> Ryan Scott pushed new branch wip/T21077-take-two at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21077-take-two You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 13:23:44 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 19 Jul 2023 09:23:44 -0400 Subject: [Git][ghc/ghc][wip/T21077] Draft: Use HsExpanded for untyped TH expression splices Message-ID: <64b7e3e031280_3a4b0f406ce40469158@gitlab.mail> Ryan Scott pushed to branch wip/T21077 at Glasgow Haskell Compiler / GHC Commits: 608fe90d by Ryan Scott at 2023-07-19T09:23:29-04:00 Draft: Use HsExpanded for untyped TH expression splices This changes the way that untyped Template Haskell expression splices are handled such that they are folded into the `HsExpanded` machinery. This, in turn, makes `splitHsApps` look through TH splices, which fixes #21077. TODO RGS: Add a more detailed description of the changes in the commit message, and add more documentation. - - - - - 11 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Types/Origin.hs - + testsuite/tests/th/T21077.hs - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -441,10 +441,17 @@ tupArgPresent (Missing {}) = False ********************************************************************* -} type instance XXExpr GhcPs = DataConCantHappen -type instance XXExpr GhcRn = HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) +type instance XXExpr GhcRn = XXExprGhcRn type instance XXExpr GhcTc = XXExprGhcTc -- HsExpansion: see Note [Rebindable syntax and HsExpansion] below +-- | TODO RGS: Docs +data XXExprGhcRn + = ExpansionRn + {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcRn)) + | AddModFinalizers + ThModFinalizers + (HsExpr GhcRn) data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions @@ -709,14 +716,19 @@ ppr_expr (XExpr x) = case ghcPass @p of GhcRn -> ppr x GhcTc -> ppr x +instance Outputable XXExprGhcRn where + ppr (ExpansionRn e) + = ppr e + + ppr (AddModFinalizers _ e) + = ppr e + instance Outputable XXExprGhcTc where ppr (WrapExpr (HsWrap co_fn e)) = pprHsWrapper co_fn (\_parens -> pprExpr e) ppr (ExpansionExpr e) - = ppr e -- e is an HsExpansion, we print the original - -- expression (LHsExpr GhcPs), not the - -- desugared one (LHsExpr GhcTc). + = ppr e ppr (ConLikeTc con _ _) = pprPrefixOcc con -- Used in error messages generated by @@ -747,15 +759,19 @@ ppr_infix_expr (XExpr x) = case ghcPass @p of GhcTc -> ppr_infix_expr_tc x ppr_infix_expr _ = Nothing -ppr_infix_expr_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Maybe SDoc -ppr_infix_expr_rn (HsExpanded a _) = ppr_infix_expr a +ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc +ppr_infix_expr_rn (ExpansionRn e) = ppr_infix_expansion e +ppr_infix_expr_rn (AddModFinalizers _ e) = ppr_infix_expr e ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc -ppr_infix_expr_tc (WrapExpr (HsWrap _ e)) = ppr_infix_expr e -ppr_infix_expr_tc (ExpansionExpr (HsExpanded a _)) = ppr_infix_expr a -ppr_infix_expr_tc (ConLikeTc {}) = Nothing -ppr_infix_expr_tc (HsTick {}) = Nothing -ppr_infix_expr_tc (HsBinTick {}) = Nothing +ppr_infix_expr_tc (WrapExpr (HsWrap _ e)) = ppr_infix_expr e +ppr_infix_expr_tc (ExpansionExpr e) = ppr_infix_expansion e +ppr_infix_expr_tc (ConLikeTc {}) = Nothing +ppr_infix_expr_tc (HsTick {}) = Nothing +ppr_infix_expr_tc (HsBinTick {}) = Nothing + +ppr_infix_expansion :: HsExpansion (HsExpr GhcRn) expansion -> Maybe SDoc +ppr_infix_expansion (HsExpanded a _) = ppr_infix_expr a ppr_apps :: (OutputableBndrId p) => HsExpr (GhcPass p) @@ -851,14 +867,18 @@ hsExprNeedsParens prec = go #endif go_x_tc :: XXExprGhcTc -> Bool - go_x_tc (WrapExpr (HsWrap _ e)) = hsExprNeedsParens prec e - go_x_tc (ExpansionExpr (HsExpanded a _)) = hsExprNeedsParens prec a - go_x_tc (ConLikeTc {}) = False - go_x_tc (HsTick _ (L _ e)) = hsExprNeedsParens prec e - go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e + go_x_tc (WrapExpr (HsWrap _ e)) = hsExprNeedsParens prec e + go_x_tc (ExpansionExpr e) = go_expansion e + go_x_tc (ConLikeTc {}) = False + go_x_tc (HsTick _ (L _ e)) = hsExprNeedsParens prec e + go_x_tc (HsBinTick _ _ (L _ e)) = hsExprNeedsParens prec e + + go_x_rn :: XXExprGhcRn -> Bool + go_x_rn (ExpansionRn e) = go_expansion e + go_x_rn (AddModFinalizers _ e) = hsExprNeedsParens prec e - go_x_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Bool - go_x_rn (HsExpanded a _) = hsExprNeedsParens prec a + go_expansion :: HsExpansion (HsExpr GhcRn) expansion -> Bool + go_expansion (HsExpanded a _) = hsExprNeedsParens prec a -- | Parenthesize an expression without token information @@ -894,14 +914,18 @@ isAtomicHsExpr (XExpr x) | GhcRn <- ghcPass @p = go_x_rn x where go_x_tc :: XXExprGhcTc -> Bool - go_x_tc (WrapExpr (HsWrap _ e)) = isAtomicHsExpr e - go_x_tc (ExpansionExpr (HsExpanded a _)) = isAtomicHsExpr a - go_x_tc (ConLikeTc {}) = True - go_x_tc (HsTick {}) = False - go_x_tc (HsBinTick {}) = False - - go_x_rn :: HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> Bool - go_x_rn (HsExpanded a _) = isAtomicHsExpr a + go_x_tc (WrapExpr (HsWrap _ e)) = isAtomicHsExpr e + go_x_tc (ExpansionExpr e) = go_expansion e + go_x_tc (ConLikeTc {}) = True + go_x_tc (HsTick {}) = False + go_x_tc (HsBinTick {}) = False + + go_x_rn :: XXExprGhcRn -> Bool + go_x_rn (ExpansionRn e) = go_expansion e + go_x_rn (AddModFinalizers _ e) = isAtomicHsExpr e + + go_expansion :: HsExpansion (HsExpr GhcRn) expansion -> Bool + go_expansion (HsExpanded a _) = isAtomicHsExpr a isAtomicHsExpr _ = False ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -566,6 +566,7 @@ deriving instance Eq (IE GhcTc) -- --------------------------------------------------------------------- +deriving instance Data XXExprGhcRn deriving instance Data XXExprGhcTc deriving instance Data XXPatGhcTc ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1666,11 +1666,18 @@ repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do e1 <- repLE e repGetField e1 f repE (HsProjection _ xs) = repProjection (fmap (field_label . unLoc . dfoLabel . unLoc) xs) -repE (XExpr (HsExpanded orig_expr ds_expr)) - = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax - ; if rebindable_on -- See Note [Quotation and rebindable syntax] - then repE ds_expr - else repE orig_expr } +repE (XExpr x) = + case x of + ExpansionRn (HsExpanded orig_expr ds_expr) -> + do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax + ; if rebindable_on -- See Note [Quotation and rebindable syntax] + then repE ds_expr + else repE orig_expr } + AddModFinalizers{} -> + -- TODO RGS: Is this right? I believe so, since there is an invariant + -- that no AddModFinalizers should appear inside an HsBracket. Spell + -- this out explicitly somewhere. + pprPanic "repE XExpr" (ppr x) repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e) repE e@(HsTypedBracket{}) = notHandled (ThExpressionForm e) repE e@(HsUntypedBracket{}) = notHandled (ThExpressionForm e) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -2719,7 +2719,7 @@ mkExpandedExpr :: HsExpr GhcRn -- ^ source expression -> HsExpr GhcRn -- ^ expanded expression -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedExpr a b = XExpr (HsExpanded a b) +mkExpandedExpr a b = XExpr (ExpansionRn (HsExpanded a b)) ----------------------------------------- -- Bits and pieces for RecordDotSyntax. ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -483,8 +483,8 @@ rnUntypedSpliceExpr splice runRnSplice UntypedExpSplice runMetaE ppr rn_splice ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr) -- See Note [Delaying modFinalizers in untyped splices]. - ; let e = flip HsUntypedSplice rn_splice - . HsUntypedSpliceTop (ThModFinalizers mod_finalizers) + ; let e = XExpr + . AddModFinalizers (ThModFinalizers mod_finalizers) <$> lexpr3 ; return (gHsPar e, fvs) } @@ -597,6 +597,7 @@ This note and approach originated in #18102. {- Note [Delaying modFinalizers in untyped splices] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +TODO RGS: Update this When splices run in the renamer, 'reify' does not have access to the local type environment (#11832, [1]). ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -142,11 +142,11 @@ tcInferSigma :: Bool -> LHsExpr GhcRn -> TcM TcSigmaType -- True <=> instantiate -- return a rho-type -- False <=> don't instantiate -- return a sigma-type tcInferSigma inst (L loc rn_expr) - | (fun@(rn_fun,fun_ctxt), rn_args) <- splitHsApps rn_expr = addExprCtxt rn_expr $ setSrcSpanA loc $ - do { do_ql <- wantQuickLook rn_fun - ; (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args + do { (fun@(rn_fun,fun_ctxt), rn_args) <- splitHsApps rn_expr + ; do_ql <- wantQuickLook rn_fun + ; (tc_fun, fun_sigma) <- tcInferAppHead fun ; (_delta, inst_args, app_res_sigma) <- tcInstFun do_ql inst (tc_fun, fun_ctxt) fun_sigma rn_args ; _tc_args <- tcValArgs do_ql inst_args ; return app_res_sigma } @@ -174,7 +174,6 @@ head ::= f -- HsVar: variables | fld -- HsRecSel: record field selectors | (expr :: ty) -- ExprWithTySig: expr with user type sig | lit -- HsOverLit: overloaded literals - | $([| head |]) -- HsSpliceE+HsSpliced+HsSplicedExpr: untyped TH expression splices | other_expr -- Other expressions When tcExpr sees something that starts an application chain (namely, @@ -204,16 +203,6 @@ Clearly this should work! But it will /only/ work because if we instantiate that (forall b. b) impredicatively! And that only happens in tcApp. -We also wish to typecheck application chains with untyped Template Haskell -splices in the head, such as this example from #21038: - data Foo = MkFoo (forall a. a -> a) - f = $([| MkFoo |]) $ \x -> x -This should typecheck just as if the TH splice was never in the way—that is, -just as if the user had written `MkFoo $ \x -> x`. We could conceivably have -a case for typed TH expression splices too, but it wouldn't be useful in -practice, since the types of typed TH expressions aren't allowed to have -polymorphic types, such as the type of MkFoo. - Note [tcApp: typechecking applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tcApp implements the APP-Downarrow/Uparrow rule of @@ -329,12 +318,13 @@ before tcValArgs. tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- See Note [tcApp: typechecking applications] tcApp rn_expr exp_res_ty - | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr - = do { traceTc "tcApp {" $ + = do { (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr + + ; traceTc "tcApp {" $ vcat [ text "rn_fun:" <+> ppr rn_fun , text "rn_args:" <+> ppr rn_args ] - ; (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args + ; (tc_fun, fun_sigma) <- tcInferAppHead fun -- Instantiate ; do_ql <- wantQuickLook rn_fun @@ -974,8 +964,8 @@ isGuardedTy ty quickLookArg1 :: Bool -> Delta -> LHsExpr GhcRn -> TcSigmaTypeFRR -> TcM (Delta, EValArg 'TcpInst) quickLookArg1 guarded delta larg@(L _ arg) arg_ty - = do { let ((rn_fun, fun_ctxt), rn_args) = splitHsApps arg - ; mb_fun_ty <- tcInferAppHead_maybe rn_fun rn_args + = do { ((rn_fun, fun_ctxt), rn_args) <- splitHsApps arg + ; mb_fun_ty <- tcInferAppHead_maybe rn_fun ; traceTc "quickLookArg 1" $ vcat [ text "arg:" <+> ppr arg , text "head:" <+> ppr rn_fun <+> dcolon <+> ppr mb_fun_ty ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -207,7 +207,7 @@ tcExpr e@(OpApp {}) res_ty = tcApp e res_ty tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty -tcExpr e@(XExpr (HsExpanded {})) res_ty = tcApp e res_ty +tcExpr e@(XExpr {}) res_ty = tcApp e res_ty tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty @@ -571,6 +571,7 @@ tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not -- Here we get rid of it and add the finalizers to the global environment. -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. +-- TODO RGS: Update this tcExpr (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty tcExpr e@(HsTypedBracket _ body) res_ty = tcTypedBracket e body res_ty @@ -733,7 +734,7 @@ tcSyntaxOpGen :: CtOrigin -> ([TcSigmaTypeFRR] -> [Mult] -> TcM a) -> TcM (a, SyntaxExprTc) tcSyntaxOpGen orig (SyntaxExprRn op) arg_tys res_ty thing_inside - = do { (expr, sigma) <- tcInferAppHead (op, VACall op 0 noSrcSpan) [] + = do { (expr, sigma) <- tcInferAppHead (op, VACall op 0 noSrcSpan) -- Ugh!! But all this code is scheduled for demolition anyway ; traceTc "tcSyntaxOpGen" (ppr op $$ ppr expr $$ ppr sigma) ; (result, expr_wrap, arg_wraps, res_wrap) ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -278,8 +278,8 @@ addArgWrap wrap args | otherwise = EWrap (EHsWrap wrap) : args splitHsApps :: HsExpr GhcRn - -> ( (HsExpr GhcRn, AppCtxt) -- Head - , [HsExprArg 'TcpRn]) -- Args + -> TcM ( (HsExpr GhcRn, AppCtxt) -- Head + , [HsExprArg 'TcpRn]) -- Args -- See Note [splitHsApps] splitHsApps e = go e (top_ctxt 0 e) [] where @@ -291,13 +291,15 @@ splitHsApps e = go e (top_ctxt 0 e) [] top_ctxt n (HsPragE _ _ fun) = top_lctxt n fun top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun - top_ctxt n (XExpr (HsExpanded orig _)) = VACall orig n noSrcSpan + top_ctxt n (XExpr x) = case x of + ExpansionRn (HsExpanded orig _) -> VACall orig n noSrcSpan + AddModFinalizers _ fun -> VACall fun n noSrcSpan top_ctxt n other_fun = VACall other_fun n noSrcSpan top_lctxt n (L _ fun) = top_ctxt n fun go :: HsExpr GhcRn -> AppCtxt -> [HsExprArg 'TcpRn] - -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn]) + -> TcM ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn]) -- Modify the AppCtxt as we walk inwards, so it describes the next argument go (HsPar _ _ (L l fun) _) ctxt args = go fun (set l ctxt) (EWrap (EPar ctxt) : args) go (HsPragE _ p (L l fun)) ctxt args = go fun (set l ctxt) (EPrag ctxt p : args) @@ -305,19 +307,29 @@ splitHsApps e = go e (top_ctxt 0 e) [] go (HsApp _ (L l fun) arg) ctxt args = go fun (dec l ctxt) (mkEValArg ctxt arg : args) -- See Note [Looking through HsExpanded] - go (XExpr (HsExpanded orig fun)) ctxt args - = go fun (VAExpansion orig (appCtxtLoc ctxt)) - (EWrap (EExpand orig) : args) + go (XExpr x) ctxt args + = case x of + ExpansionRn (HsExpanded orig fun) + -> go fun (VAExpansion orig (appCtxtLoc ctxt)) + (EWrap (EExpand orig) : args) + AddModFinalizers mod_finalizers fun + -> do addModFinalizersWithLclEnv mod_finalizers + let orig = HsUntypedSplice + (HsUntypedSpliceTop mod_finalizers fun) + (HsUntypedSpliceExpr + (error "TODO RGS: What do I put here?") + (L (error "TODO RGS: Which location?") fun)) + go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args) -- See Note [Desugar OpApp in the typechecker] go e@(OpApp _ arg1 (L l op) arg2) _ args - = ( (op, VACall op 0 (locA l)) - , mkEValArg (VACall op 1 generatedSrcSpan) arg1 - : mkEValArg (VACall op 2 generatedSrcSpan) arg2 - : EWrap (EExpand e) - : args ) + = pure ( (op, VACall op 0 (locA l)) + , mkEValArg (VACall op 1 generatedSrcSpan) arg1 + : mkEValArg (VACall op 2 generatedSrcSpan) arg2 + : EWrap (EExpand e) + : args ) - go e ctxt args = ((e,ctxt), args) + go e ctxt args = pure ((e,ctxt), args) set :: SrcSpanAnnA -> AppCtxt -> AppCtxt set l (VACall f n _) = VACall f n (locA l) @@ -749,6 +761,7 @@ where Note [Looking through HsExpanded] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +TODO RGS: Update me When creating an application chain in splitHsApps, we must deal with HsExpanded f1 (f `HsApp` e1) `HsApp` e2 `HsApp` e3 @@ -765,7 +778,6 @@ It's easy to achieve this: `splitHsApps` unwraps `HsExpanded`. ********************************************************************* -} tcInferAppHead :: (HsExpr GhcRn, AppCtxt) - -> [HsExprArg 'TcpRn] -> TcM (HsExpr GhcTc, TcSigmaType) -- Infer type of the head of an application -- i.e. the 'f' in (f e1 ... en) @@ -776,11 +788,6 @@ tcInferAppHead :: (HsExpr GhcRn, AppCtxt) -- * An expression with a type signature (e :: ty) -- See Note [Application chains and heads] in GHC.Tc.Gen.App -- --- Why do we need the arguments to infer the type of the head of the --- application? Simply to inform add_head_ctxt about whether or not --- to put push a new "In the expression..." context. (We don't push a --- new one if there are no arguments, because we already have.) --- -- Note that [] and (,,) are both HsVar: -- see Note [Empty lists] and [ExplicitTuple] in GHC.Hs.Expr -- @@ -788,28 +795,30 @@ tcInferAppHead :: (HsExpr GhcRn, AppCtxt) -- cases are dealt with by splitHsApps. -- -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App -tcInferAppHead (fun,ctxt) args +tcInferAppHead (fun,ctxt) = addHeadCtxt ctxt $ - do { mb_tc_fun <- tcInferAppHead_maybe fun args + do { mb_tc_fun <- tcInferAppHead_maybe fun ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) Nothing -> tcInfer (tcExpr fun) } tcInferAppHead_maybe :: HsExpr GhcRn - -> [HsExprArg 'TcpRn] -> TcM (Maybe (HsExpr GhcTc, TcSigmaType)) -- See Note [Application chains and heads] in GHC.Tc.Gen.App -- Returns Nothing for a complicated head -tcInferAppHead_maybe fun args +tcInferAppHead_maybe fun = case fun of HsVar _ (L _ nm) -> Just <$> tcInferId nm HsRecSel _ f -> Just <$> tcInferRecSelId f ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty HsOverLit _ lit -> Just <$> tcInferOverLit lit - HsUntypedSplice (HsUntypedSpliceTop _ e) _ - -> tcInferAppHead_maybe e args _ -> return Nothing +-- TODO RGS: Figure out how to adapt Richard's suggestion from +-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7574#note_409921 +-- to this new version of addHeadCtxt, which doesn't have arguments. Perhaps +-- we should pass the arguments separately? If so, it's not clear to me how +-- that is meant to interact with the `isGoodSrcSpan` check. addHeadCtxt :: AppCtxt -> TcM a -> TcM a addHeadCtxt fun_ctxt thing_inside | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -739,7 +739,10 @@ exprCtOrigin (HsTypedSplice {}) = Shouldn'tHappenOrigin "TH typed splice" exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice" exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" -exprCtOrigin (XExpr (HsExpanded a _)) = exprCtOrigin a +exprCtOrigin (XExpr x) = + case x of + ExpansionRn (HsExpanded a _) -> exprCtOrigin a + AddModFinalizers{} -> Shouldn'tHappenOrigin "TH splice" -- TODO RGS: Is this right? -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin ===================================== testsuite/tests/th/T21077.hs ===================================== @@ -0,0 +1,31 @@ +{-# LANGUAGE TemplateHaskell #-} +module T21077 where + +import Language.Haskell.TH.Syntax + +data Foo = MkFoo () (forall a. a -> a) + +worksOnAllGHCs1 :: Foo +worksOnAllGHCs1 = MkFoo () (\x -> x) + +worksOnAllGHCs2 :: Foo +worksOnAllGHCs2 = MkFoo () $ \x -> x + +worksOnAllGHCs3 :: Foo +worksOnAllGHCs3 = $([| MkFoo () |]) (\x -> x) + +doesn'tWorkOnGHC9'2A :: Foo +doesn'tWorkOnGHC9'2A = $([| MkFoo () |]) $ \x -> x + +doesn'tWorkOnGHC9'2B :: Foo +doesn'tWorkOnGHC9'2B = $([| $([| MkFoo () |]) |]) $ \x -> x + +doesn'tWorkOnGHC9'2C :: Foo +doesn'tWorkOnGHC9'2C = $(do addModFinalizer (runIO (putStrLn "C")) + [| MkFoo () |]) $ \x -> x + +doesn'tWorkOnGHC9'2D :: Foo +doesn'tWorkOnGHC9'2D = $(do addModFinalizer (runIO (putStrLn "D2")) + [| $(do addModFinalizer (runIO (putStrLn "D1")) + [| MkFoo () |]) + |]) $ \x -> x ===================================== testsuite/tests/th/all.T ===================================== @@ -560,6 +560,7 @@ test('T15433b', [extra_files(['T15433_aux.hs'])], multimod_compile, ['T15433b', test('T20711', normal, compile_and_run, ['']) test('T20868', normal, compile_and_run, ['']) test('Lift_ByteArray', normal, compile_and_run, ['']) +test('T21077', normal, compile, ['']) test('T21920', normal, compile_and_run, ['']) test('T21723', normal, compile_and_run, ['']) test('T21942', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/608fe90db254e86275e8879063ce036e0f12fff8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/608fe90db254e86275e8879063ce036e0f12fff8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 14:22:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 19 Jul 2023 10:22:16 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Split ghc-toolchain executable to new packge Message-ID: <64b7f19823335_3a4b0fb746c48687@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: d9f01323 by Rodrigo Mesquita at 2023-07-19T15:15:33+01:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 10e2f0fe by Rodrigo Mesquita at 2023-07-19T15:19:24+01:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 8 changed files: - configure.ac - distrib/configure.ac.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs → utils/ghc-toolchain/exe/Main.hs - + utils/ghc-toolchain/exe/ghc-toolchain.cabal - utils/ghc-toolchain/ghc-toolchain.cabal Changes: ===================================== configure.ac ===================================== @@ -1177,7 +1177,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([hadrian/cfg]) +FIND_GHC_TOOLCHAIN([hadrian/cfg],[NO]) AC_CONFIG_FILES( [ mk/project.mk ===================================== distrib/configure.ac.in ===================================== @@ -312,7 +312,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([.]) +FIND_GHC_TOOLCHAIN([.],[YES]) VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) ===================================== hadrian/src/Packages.hs ===================================== @@ -5,7 +5,8 @@ module Packages ( checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, @@ -37,7 +38,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs + , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain + , haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml @@ -53,7 +55,8 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -93,6 +96,7 @@ ghciWrapper = prg "ghci-wrapper" `setPath` "driver/ghci" -- See Note [Hadrian's ghci-wrapper package] ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" +ghcToolchain = prg "ghc-toolchain" `setPath` "utils/ghc-toolchain/exe" -- workaround for #23690 haddock = util "haddock" haskeline = lib "haskeline" hsc2hs = util "hsc2hs" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -146,6 +146,7 @@ stage1Packages = do , semaphoreCompat , stm , unlit + , ghcToolchain , xhtml , if winTarget then win32 else unix ] ===================================== m4/ghc_toolchain.m4 ===================================== @@ -33,21 +33,38 @@ AC_DEFUN([INVOKE_GHC_TOOLCHAIN], while read -r arg; do set -- "[$]@" "$arg" done - # For now, we don't exit even if ghc-toolchain fails. We don't want to + # For now, we don't 'exit' even if ghc-toolchain fails. We don't want to # fail configure due to it, since the target file is still being generated by configure. - ./acghc-toolchain -v2 "[$]@" # || exit 1 - python3 -c 'import sys; print(sys.argv)' "[$]@" - ) From gitlab at gitlab.haskell.org Wed Jul 19 15:21:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 11:21:48 -0400 Subject: [Git][ghc/ghc][wip/T22011] 39 commits: Improve the situation with the stimes cycle Message-ID: <64b7ff8c62619_3a4b0fb746c5021b@gitlab.mail> Ben Gamari pushed to branch wip/T22011 at Glasgow Haskell Compiler / GHC Commits: 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - 542073cc by Ben Gamari at 2023-07-11T09:15:00-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python ops = [] ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.append(f'__aarch64_{op}{n}_{order}') for m in [1,2,4,8,16]: ops.append(f'__aarch64_cas{n}_{order}') print('\n'.join(f' SymE_NeedsProto({op}),' for op in sorted(ops))) ``` - - - - - c6951512 by Ben Gamari at 2023-07-19T11:21:41-04:00 rts: Add generator for RtsSymbols from libgcc - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7a3b3b2fcdc7eefe80df6994c347310f29e18ef...c695151212668d5ff3914f7575f23af05e4dcd32 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b7a3b3b2fcdc7eefe80df6994c347310f29e18ef...c695151212668d5ff3914f7575f23af05e4dcd32 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 15:34:32 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 19 Jul 2023 11:34:32 -0400 Subject: [Git][ghc/ghc][wip/T23645] 2 commits: Add back exceptions for wasm and js Message-ID: <64b802881f690_3a4b0fb74805054c4@gitlab.mail> Jaro Reinders pushed to branch wip/T23645 at Glasgow Haskell Compiler / GHC Commits: 7e70de5e by Jaro Reinders at 2023-07-19T17:33:56+02:00 Add back exceptions for wasm and js - - - - - e696f783 by Jaro Reinders at 2023-07-19T17:34:23+02:00 Try to fix AArch64 - - - - - 2 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1039,8 +1039,8 @@ getRegister' config plat expr code_x `appOL` code_y `snocOL` mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` - CSET (OpReg w dst) NE) + CMP (OpReg tmp_w tmp) (OpRegExt W32 tmp ext_mode 0) `snocOL` + CSET (OpReg W32 dst) NE) -- | Is a given number encodable as a bitmask immediate? -- ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -232,6 +232,9 @@ test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) # Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. test('MulMayOflo_full', [ extra_files(['MulMayOflo.hs']), - when(unregisterised(), skip) ], + when(unregisterised(), skip), + when(arch('wasm32'), skip), # See #22532 + when(arch('javascript'), skip) + ], multi_compile_and_run, ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9513973b37c0cce03b7a57f28be124cdd54efb69...e696f783747a1591d629a1189c62e49820d00ff2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9513973b37c0cce03b7a57f28be124cdd54efb69...e696f783747a1591d629a1189c62e49820d00ff2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 15:43:24 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 19 Jul 2023 11:43:24 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Split ghc-toolchain executable to new packge Message-ID: <64b8049caa233_3a4b0f2ddcfd70510748@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c2340c86 by Rodrigo Mesquita at 2023-07-19T16:43:06+01:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 72ff798c by Rodrigo Mesquita at 2023-07-19T16:43:08+01:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 8 changed files: - configure.ac - distrib/configure.ac.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs → utils/ghc-toolchain/exe/Main.hs - + utils/ghc-toolchain/exe/ghc-toolchain-bin.cabal - utils/ghc-toolchain/ghc-toolchain.cabal Changes: ===================================== configure.ac ===================================== @@ -1177,7 +1177,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([hadrian/cfg]) +FIND_GHC_TOOLCHAIN([hadrian/cfg],[NO]) AC_CONFIG_FILES( [ mk/project.mk ===================================== distrib/configure.ac.in ===================================== @@ -312,7 +312,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([.]) +FIND_GHC_TOOLCHAIN([.],[YES]) VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) ===================================== hadrian/src/Packages.hs ===================================== @@ -5,7 +5,8 @@ module Packages ( checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, @@ -37,7 +38,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs + , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin + , haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml @@ -53,7 +55,8 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -93,6 +96,8 @@ ghciWrapper = prg "ghci-wrapper" `setPath` "driver/ghci" -- See Note [Hadrian's ghci-wrapper package] ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" +ghcToolchain = lib "ghc-toolchain" `setPath` "utils/ghc-toolchain" +ghcToolchainBin = prg "ghc-toolchain-bin" `setPath` "utils/ghc-toolchain/exe" -- workaround for #23690 haddock = util "haddock" haskeline = lib "haskeline" hsc2hs = util "hsc2hs" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -87,6 +87,7 @@ stage0Packages = do , ghcBootTh , ghcPlatform , ghcHeap + , ghcToolchain , ghci , ghcPkg , haddock @@ -154,6 +155,7 @@ stage1Packages = do , hpcBin , iserv , runGhc + , ghcToolchainBin ] , when (winTarget && not cross) [ touchy ===================================== m4/ghc_toolchain.m4 ===================================== @@ -33,21 +33,38 @@ AC_DEFUN([INVOKE_GHC_TOOLCHAIN], while read -r arg; do set -- "[$]@" "$arg" done - # For now, we don't exit even if ghc-toolchain fails. We don't want to + # For now, we don't 'exit' even if ghc-toolchain fails. We don't want to # fail configure due to it, since the target file is still being generated by configure. - ./acghc-toolchain -v2 "[$]@" # || exit 1 - python3 -c 'import sys; print(sys.argv)' "[$]@" - ) From gitlab at gitlab.haskell.org Wed Jul 19 15:47:12 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 19 Jul 2023 11:47:12 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Ship ghc-toolchain in the bindist Message-ID: <64b805804266c_3a4b0fb74085173cb@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: ee2810e2 by Rodrigo Mesquita at 2023-07-19T16:46:55+01:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 9 changed files: - configure.ac - distrib/configure.ac.in - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - m4/ghc_toolchain.m4 - utils/ghc-toolchain/src/GHC/Toolchain/CheckArm.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs Changes: ===================================== configure.ac ===================================== @@ -1177,7 +1177,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([hadrian/cfg]) +FIND_GHC_TOOLCHAIN([hadrian/cfg],[NO]) AC_CONFIG_FILES( [ mk/project.mk ===================================== distrib/configure.ac.in ===================================== @@ -312,7 +312,7 @@ checkMake380 gmake # Toolchain target files PREP_TARGET_FILE -FIND_GHC_TOOLCHAIN([.]) +FIND_GHC_TOOLCHAIN([.],[YES]) VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) ===================================== hadrian/src/Packages.hs ===================================== @@ -5,7 +5,8 @@ module Packages ( checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, @@ -37,7 +38,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs + , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, ghcToolchainBin + , haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml @@ -53,7 +55,8 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, ghcToolchain, + haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -93,6 +96,8 @@ ghciWrapper = prg "ghci-wrapper" `setPath` "driver/ghci" -- See Note [Hadrian's ghci-wrapper package] ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" +ghcToolchain = lib "ghc-toolchain" `setPath` "utils/ghc-toolchain" +ghcToolchainBin = prg "ghc-toolchain-bin" `setPath` "utils/ghc-toolchain/exe" -- workaround for #23690 haddock = util "haddock" haskeline = lib "haskeline" hsc2hs = util "hsc2hs" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -87,6 +87,7 @@ stage0Packages = do , ghcBootTh , ghcPlatform , ghcHeap + , ghcToolchain , ghci , ghcPkg , haddock @@ -154,6 +155,7 @@ stage1Packages = do , hpcBin , iserv , runGhc + , ghcToolchainBin ] , when (winTarget && not cross) [ touchy ===================================== m4/ghc_toolchain.m4 ===================================== @@ -33,21 +33,38 @@ AC_DEFUN([INVOKE_GHC_TOOLCHAIN], while read -r arg; do set -- "[$]@" "$arg" done - # For now, we don't exit even if ghc-toolchain fails. We don't want to + # For now, we don't 'exit' even if ghc-toolchain fails. We don't want to # fail configure due to it, since the target file is still being generated by configure. - ./acghc-toolchain -v2 "[$]@" # || exit 1 - python3 -c 'import sys; print(sys.argv)' "[$]@" - ) From gitlab at gitlab.haskell.org Wed Jul 19 16:34:57 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 19 Jul 2023 12:34:57 -0400 Subject: [Git][ghc/ghc][wip/T22404] 60 commits: base: fix haddock syntax in GHC.Profiling Message-ID: <64b810b195e87_3a4b0fb755c5294e9@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ef5e18a0 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Work in progress on #22404 Very much not ready! - - - - - c258fc61 by Sebastian Graf at 2023-07-19T17:34:47+01:00 Partition into OneOccs and ManyOccs - - - - - 556cb9ed by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibbles - - - - - 907a3195 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Refactor WithTailJoinDetails - - - - - 5aa10500 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibbles - - - - - e37fde9d by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibbles - - - - - 1d12265b by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Major wibbles - - - - - 4d470ccf by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibble - - - - - 1aad5ff6 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Vital fix to alt_env - - - - - 8796af2a by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Comments - - - - - 7eadb0fd by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Another crucial change Fixing a wrongly-zapped occ_join_points ..and a DEBUG check to catch it if it happens again - - - - - 359d554e by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Fast path for addInScope - - - - - 5ea102f2 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Tiny fix - - - - - e639e454 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Simplify the shadowing case - - - - - e93bbf47 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 More efficient now - - - - - 3856a4c0 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibbles - - - - - 8288624c by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibble - - - - - 9aa10785 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibbles - - - - - ac40f734 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Comments only - - - - - ef6a7cdb by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibbles - - - - - 8ed317d7 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Sundry perf improvements - - - - - bf09c585 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Wibbles to efficiency Esp simplify occ_join_points - - - - - b02269ad by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Further wibbles - - - - - bd02e1bc by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 More wibbles - - - - - ddf8223c by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Remove the in-scope set from OccAnal - - - - - 55e2d3c4 by Simon Peyton Jones at 2023-07-19T17:34:47+01:00 Fix stupid bug - - - - - 19 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/DmdAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78aae1b094ea9b225fc696e9c33e9728a18ae2ee...55e2d3c4894abfecd8e4fb10ec1a3c876a414e88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78aae1b094ea9b225fc696e9c33e9728a18ae2ee...55e2d3c4894abfecd8e4fb10ec1a3c876a414e88 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 16:42:18 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Wed, 19 Jul 2023 12:42:18 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] Aarch64 NCG: Use encoded immediates for literals. Message-ID: <64b8126a14e29_3a4b0f2ddcfd7053161f@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: 9597e36c by Andreas Klebinger at 2023-07-19T18:06:43+02:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 4 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -372,6 +372,93 @@ getSomeReg expr = do Fixed rep reg code -> return (reg, rep, code) +{- Note [Aarch64 immediates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Aarch64 with it's fixed width instruction encoding uses leftover space for +immediates. +If you want the full rundown consult the arch reference document: +"Arm® Architecture Reference Manual" - "C3.4 Data processing - immediate" + +The gist of it is that different instructions allow for different immediate encodings. +The ones we care about for better code generation are: + +* Simple but potentially repeated bit-patterns for logic instructions. +* 16bit numbers shifted by multiples of 16. +* 12 bit numbers optionally shifted by 12 bits. + +It might seem like the ISA allows for 64bit immediates but this isn't the case. +Rather there are some instruction aliases which allow for large unencoded immediates +which will then be transalted to one of the immediate encodings implicitly. + +For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, lsl #16 +-} + +-- | Move (wide immediate) +-- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. +-- Used with MOVZ,MOVN, MOVK +-- See Note [Aarch64 immediates] +getMovWideImm :: Integer -> Maybe Operand +getMovWideImm n + -- TODO: Handle sign extension + | n <= 0 + = Nothing + -- Fits in 16 bits + | sized_n < 2^(16 :: Int) + = Just $ OpImm (ImmInteger n) + + -- 0x0000 0000 xxxx 0000 + | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) + = Just $ OpImmShift (ImmInteger $ n `shiftR` 16) SLSL 16 + + -- 0x 0000 xxxx 0000 0000 + | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) + = Just $ OpImmShift (ImmInteger $ n `shiftR` 32) SLSL 32 + + -- 0x xxxx 0000 0000 0000 + | trailing_zeros >= 48 + = Just $ OpImmShift (ImmInteger $ n `shiftR` 48) SLSL 48 + + | otherwise + = Nothing + where + sized_n = fromIntegral n :: Word64 + trailing_zeros = countTrailingZeros sized_n + +-- | Arithmetic(immediate) +-- Allows for 12bit immediates which can be shifted by 0 or 12 bits. +-- Used with ADD, ADDS, SUB, SUBS, CMP, CMN +-- See Note [Aarch64 immediates] +getArithImm :: Integer -> Maybe Operand +getArithImm n + -- TODO: Handle sign extension + | n <= 0 + = Nothing + -- Fits in 16 bits + -- Fits in 12 bits + | sized_n < 2^(12::Int) + = Just $ OpImm (ImmInteger n) + + -- 12 bits shifted by 12 places. + | trailing_zeros >= 12 && sized_n < 2^(24::Int) + = Just $ OpImmShift (ImmInteger $ n `shiftR` 12) SLSL 12 + + | otherwise + = Nothing + where + sized_n = fromIntegral n :: Word64 + trailing_zeros = countTrailingZeros sized_n + +-- | Logical (immediate) +-- Allows encoding of some repeated bitpatterns +-- Used with AND, ANDS, EOR, ORR, TST +-- and their aliases which includes at least MOV (bitmask immediate) +-- See Note [Aarch64 immediates] +getBitmaskImm :: Integer -> Maybe Operand +getBitmaskImm n + | isAArch64Bitmask n = Just $ OpImm (ImmInteger n) + | otherwise = Nothing + + -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) @@ -494,8 +581,14 @@ getRegister' config plat expr CmmLit lit -> case lit of - -- TODO handle CmmInt 0 specially, use wzr or xzr. - + -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move. + -- TODO: Reenable after https://gitlab.haskell.org/ghc/ghc/-/issues/23632 is fixed. + -- CmmInt 0 W32 -> do + -- let format = intFormat W32 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) + -- CmmInt 0 W64 -> do + -- let format = intFormat W64 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) CmmInt i W16 | i >= 0 -> do @@ -510,8 +603,13 @@ getRegister' config plat expr -- Those need the upper bits set. We'd either have to explicitly sign -- or figure out something smarter. Lowered to -- `MOV dst XZR` + CmmInt i w | i >= 0 + , Just imm_op <- getMovWideImm i -> do + return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op))) + CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger i))))) + CmmInt i w | isNbitEncodeable 32 i, i >= 0 -> do let half0 = fromIntegral (fromIntegral i :: Word16) half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16) @@ -586,7 +684,6 @@ getRegister' config plat expr (op, imm_code) <- litToImm' lit let rep = cmmLitType plat lit format = cmmTypeFormat rep - -- width = typeWidth rep return (Any format (\dst -> imm_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op)) CmmLabelOff lbl off -> do @@ -791,17 +888,51 @@ getRegister' config plat expr -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op -- A "plain" operation. - bitOp w op = do + bitOpImm w op encode_imm = do -- compute x <- x -- compute x <- y -- x, x, x (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, format_y, code_y) <- getSomeReg y - massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOp: incompatible" + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOpImm: incompatible" return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` - op (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) + op (OpReg w dst) (OpReg w reg_x) op_y) + + -- A (potentially signed) integer operation. + -- In the case of 8- and 16-bit signed arithmetic we must first + -- sign-extend both arguments to 32-bits. + -- See Note [Signed arithmetic on AArch64]. + intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Maybe Operand) -> NatM (Register) + intOpImm {- is signed -} True w op _encode_imm = intOp True w op + intOpImm False w op encode_imm = do + -- compute x <- x + -- compute x <- y + -- x, x, x + (reg_x, format_x, code_x) <- getSomeReg x + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" + -- This is the width of the registers on which the operation + -- should be performed. + let w' = opRegWidth w + return $ Any (intFormat w) $ \dst -> + code_x `appOL` + code_y `appOL` + op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL` + truncateReg w' w dst -- truncate back to the operand's original width -- A (potentially signed) integer operation. -- In the case of 8- and 16-bit signed arithmetic we must first @@ -847,9 +978,9 @@ getRegister' config plat expr case op of -- Integer operations -- Add/Sub should only be Integer Options. - MO_Add w -> intOp False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) + MO_Add w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) getArithImm -- TODO: Handle sub-word case - MO_Sub w -> intOp False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) + MO_Sub w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) getArithImm -- Note [CSET] -- ~~~~~~~~~~~ @@ -891,8 +1022,8 @@ getRegister' config plat expr -- N.B. We needn't sign-extend sub-word size (in)equality comparisons -- since we don't care about ordering. - MO_Eq w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d EQ ]) - MO_Ne w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d NE ]) + MO_Eq w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d EQ ]) getArithImm + MO_Ne w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d NE ]) getArithImm -- Signed multiply/divide MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) @@ -921,10 +1052,10 @@ getRegister' config plat expr MO_S_Lt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLT ]) -- Unsigned comparisons - MO_U_Ge w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) - MO_U_Le w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) - MO_U_Gt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) - MO_U_Lt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) + MO_U_Ge w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm + MO_U_Le w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm + MO_U_Gt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm + MO_U_Lt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm -- Floating point arithmetic MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) @@ -947,9 +1078,9 @@ getRegister' config plat expr MO_F_Lt w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OLT ]) -- x < y <=> y >= x -- Bitwise operations - MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) + MO_And w -> bitOpImm w (\d x y -> unitOL $ AND d x y) getBitmaskImm + MO_Or w -> bitOpImm w (\d x y -> unitOL $ ORR d x y) getBitmaskImm + MO_Xor w -> bitOpImm w (\d x y -> unitOL $ EOR d x y) getBitmaskImm MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) @@ -999,7 +1130,7 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool - isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) + isNbitEncodeable n_bits i = let shift = n_bits - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -110,6 +110,7 @@ regUsageOfInstr platform instr = case instr of LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) + MOVZ dst src -> usage (regOp src, regOp dst) MVN dst src -> usage (regOp src, regOp dst) ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -251,6 +252,7 @@ patchRegsOfInstr instr env = case instr of LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) + MOVZ o1 o2 -> MOVZ (patchOp o1) (patchOp o2) MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) @@ -381,9 +383,8 @@ mkSpillInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) + mkIp0SpillAddr imm = ANN (text "Spill: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkStrSp imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) mkStrIp0 imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) @@ -408,9 +409,7 @@ mkLoadInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) mkIp0SpillAddr imm = ANN (text "Reload: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkLdrSp imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) @@ -619,7 +618,7 @@ data Instr | MOV Operand Operand -- rd = rn or rd = #i | MOVK Operand Operand -- | MOVN Operand Operand - -- | MOVZ Operand Operand + | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 | ORR Operand Operand Operand -- rd = rn | op2 @@ -708,6 +707,7 @@ instrCon i = LSR{} -> "LSR" MOV{} -> "MOV" MOVK{} -> "MOVK" + MOVZ{} -> "MOVZ" MVN{} -> "MVN" ORN{} -> "ORN" ORR{} -> "ORR" @@ -782,6 +782,9 @@ wzr = OpReg W32 (RegReal (RealRegSingle (-1))) sp = OpReg W64 (RegReal (RealRegSingle 31)) ip0 = OpReg W64 (RegReal (RealRegSingle 16)) +reg_zero :: Reg +reg_zero = RegReal (RealRegSingle (-1)) + _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) x0, x1, x2, x3, x4, x5, x6, x7 :: Operand ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -417,6 +417,7 @@ pprInstr platform instr = case instr of | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 | otherwise -> op2 (text "\tmov") o1 o2 MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 + MOVZ o1 o2 -> op2 (text "\tmovz") o1 o2 MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3 ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -147,6 +147,13 @@ classOfRealReg (RealRegSingle i) | i < 32 = RcInteger | otherwise = RcDouble +fmtOfRealReg :: RealReg -> Format +fmtOfRealReg real_reg = + case classOfRealReg real_reg of + RcInteger -> II64 + RcDouble -> FF64 + RcFloat -> panic "No float regs on arm" + regDotColor :: RealReg -> SDoc regDotColor reg = case classOfRealReg reg of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9597e36c9aae2532752862e34191ce286ff40ad1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9597e36c9aae2532752862e34191ce286ff40ad1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 16:53:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 12:53:43 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 2 commits: users guide: Fix release notes and other documentation issues Message-ID: <64b815173e7e1_3a4b0f2ddcfd705344b0@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 58ed19d8 by Ben Gamari at 2023-07-19T12:51:25-04:00 users guide: Fix release notes and other documentation issues - - - - - 612f1736 by Ben Gamari at 2023-07-19T12:53:12-04:00 Bump array submodule to v0.5.6.0 - - - - - 5 changed files: - − docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/ghc_config.py.in - libraries/containers Changes: ===================================== docs/users_guide/9.6.1-notes.rst deleted ===================================== @@ -1,264 +0,0 @@ -.. _release-9-6-1: - -Version 9.6.1 -============== - -Language -~~~~~~~~ - -- GHC is now more conservative when solving constraints that arise from - superclass expansion in terms of other constraints that also arise from - superclass expansion. - - For example: :: - - class C a - class C a => D a b - instance D a a => D a b - - When typechecking the instance, we need to also solve the constraints arising - from the superclasses of ``D``; in this case, we need ``C a``. We could obtain - evidence for this constraint by expanding the superclasses of the context, - as ``D a a`` also has a superclass context of ``C a``. - However, is it unsound to do so in general, as we might be assuming precisely - the predicate we want to prove! This can lead to programs that loop at runtime. - - When such potentially-loopy situations arise, GHC now emits a warning. - In future releases, this behaviour will no longer be supported, and the - typechecker will outright refuse to solve these constraints, emitting a - ``Could not deduce`` error. - - In practice, you should be able to fix these issues by adding the necessary - constraint to the context, e.g. for the above example: :: - - instance (C a, D a a) => D a b - -- Record updates for GADTs and other existential datatypes are now - fully supported. - - For example: :: - - data D b where - MkD :: { fld1 :: a -> a, fld2 :: a -> (), fld3 :: b } -> D b - - foo :: D b -> D b - foo d = d { fld1 = id, fld2 = const () } - - In this example, we have an existential variable ``a``, and we update - all fields whose type involves ``a`` at once, so the update is valid. - - A side-effect of this change is that GHC now rejects some record updates - involving fields whose types contain type families (these record updates - were previously erroneously accepted). - - Example: :: - - type family F a where - F Int = Char - F Float = Char - - data T b = MkT { x :: [Int], y :: [F b] } - - emptyT :: forall b. T b - emptyT = MkT [] [] - - bar :: T Int - bar = emptyT { x = [3] } - - In this example, we can't infer the type of ``emptyT`` in ``bar``: it could be - ``T Int``, but it could also be ``T Float`` because the type family ``F`` - is not injective and ``T Float ~ T Int``. Indeed, the following typechecks :: - - baz :: T Int - baz = case ( emptyT :: T Float ) of { MkT _ y -> MkT [3] y } - - This means that the type of ``emptyT`` is ambiguous in the definition - of ``bar`` above, and thus GHC rejects the record update: :: - - Couldn't match type `F b0' with `Char' - Expected: [F Int] - Actual: [F b0] - NB: ‘F’ is a non-injective type family - The type variable ‘b0’ is ambiguous - - To fix these issues, add a type signature to the expression that the - record update is applied to (``emptyT`` in the example above), or - add an injectivity annotation to the type family in the case that - the type family is in fact injective. - -- Error messages are now assigned unique error codes, of the form ``[GHC-12345]``. - -- GHC Proposal `#106 - `_ - has been implemented, introducing a new language extension - :extension:`TypeData`. This extension permits ``type data`` declarations - as a more fine-grained alternative to :extension:`DataKinds`. - -- GHC now does a better job of solving constraints in the presence of multiple - matching quantified constraints. For example, if we want to solve - ``C a b Int`` and we have matching quantified constraints: :: - - forall x y z. (Ord x, Enum y, Num z) => C x y z - forall u v. (Enum v, Eq u) => C u v Int - - Then GHC will use the second quantified constraint to solve ``C a b Int``, - as it has a strictly weaker precondition. - -- GHC proposal `#170 Unrestricted OverloadedLabels - `_ - has been implemented. - This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. - Examples of newly allowed syntax: - - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` - -Compiler -~~~~~~~~ - -- The `WebAssembly backend - `_ - has been merged. This allows GHC to be built as a cross-compiler - that targets ``wasm32-wasi`` and compiles Haskell code to - self-contained WebAssembly modules that can be executed on a variety - of different runtimes. There are a few caveats to be aware of: - - - To use the WebAssembly backend, one would need to follow the - instructions on `ghc-wasm-meta - `_. The WebAssembly - backend is not included in the GHC release bindists for the time - being, nor is it supported by ``ghcup`` or ``stack`` yet. - - The WebAssembly backend is still under active development. It's - presented in this GHC version as a technology preview, bugs and - missing features are expected. - -- The JavaScript backend has been merged. GHC is now able to be built as a - cross-compiler targeting the JavaScript platform. The backend should be - considered a technology preview. As such it is not ready for use in - production, is not distributed in the GHC release bindists and requires the - user to manually build GHC as a cross-compiler. See the JavaScript backend - `wiki `_ page - on the GHC wiki for the current status, project roadmap, build instructions - and demos. - -- The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included - in :extension:`PolyKinds` and :extension:`DataKinds`. - -- The :ghc-flag:`-Woperator-whitespace` warning no longer ignores constructor symbols - (operators starting with ``:``). - -- The :ghc-flag:`-Wstar-is-type` warning is now enabled by default. - -GHCi -~~~~ - -- GHCi will now accept any file-header pragmas it finds, such as - ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, - instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, - you could instead write: - - .. code-block:: none - - ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} - -This can be convenient when pasting large multi-line blocks of code into GHCi. - -Runtime system -~~~~~~~~~~~~~~ - -- The `Delimited continuation primops `_ - proposal has been implemented, adding native support for first-class, - delimited continuations to the RTS. For the reasons given in the proposal, - no safe API to access this functionality is provided anywhere in ``base``. - Instead, the ``prompt#`` and ``control0#`` primops are intended to be consumed - by library authors directly, who may wrap them a safe API that maintains the - necessary invariants. See the documentation in ``GHC.Prim`` for more details. - -- The behaviour of the ``-M`` flag has been made more strict. It will now trigger - a heap overflow if the total amount of memory used by the Haskell heap exceeds the limit. - Previously only live blocks were taken into account. - This makes it more likely to trigger promptly when the heap is highly fragmented. - -- Fixed a bug that sometimes caused live sparks to be GC'ed too early either during - minor GC or major GC with workstealing disabled. See #22528. - - -``base`` library -~~~~~~~~~~~~~~~~ - -- Exceptions thrown by weak pointer finalizers can now be reported by setting - a global exception handler, using ``GHC.Weak.Finalize.setFinalizerExceptionHandler``. - The default behaviour is unchanged (exceptions are ignored and not reported). - -- GHC now provides a set of operations for introspecting on the threads of a - program, ``GHC.Conc.listThreads``, as well as operations for querying a thread's - label (:base-ref:`GHC.Conc.Sync.threadLabel`) and status - (:base-ref:`GHC.Conc.threadStatus`). - -- Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use - ``(<=)`` instead of ``compare`` per CLC proposal: - https://github.com/haskell/core-libraries-committee/issues/24 - -- Updated to `Unicode 15.0.0 `_. - -- Add standard Unicode case predicates :base-ref:`Data.Char.isUpperCase` and - :base-ref:`Data.Char.isLowerCase`. These predicates use the standard Unicode - case properties and are more intuitive than :base-ref:`Data.Char.isUpper` and - :base-ref:`Data.Char.isLower`. - -``ghc-prim`` library -~~~~~~~~~~~~~~~~~~~~ - -``ghc`` library -~~~~~~~~~~~~~~~ - -- Add `Foreign.C.Types.ConstPtr` was added to encode ``const``-qualified pointer return - types in foreign declarations when using ``CApiFFI`` extension. - -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ - - -Included libraries ------------------- - -The package database provided with this distribution also contains a number of -packages other than GHC itself. See the changelogs provided with these packages -for further change information. - -.. ghc-package-list:: - - libraries/array/array.cabal: Dependency of ``ghc`` library - libraries/base/base.cabal: Core library - libraries/binary/binary.cabal: Dependency of ``ghc`` library - libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library - libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility - libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility - libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library - libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library - libraries/directory/directory.cabal: Dependency of ``ghc`` library - libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library - libraries/filepath/filepath.cabal: Dependency of ``ghc`` library - compiler/ghc.cabal: The compiler itself - libraries/ghci/ghci.cabal: The REPL interface - libraries/ghc-boot/ghc-boot.cabal: Internal compiler library - libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library - libraries/ghc-compact/ghc-compact.cabal: Core library - libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library - libraries/ghc-prim/ghc-prim.cabal: Core library - libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable - libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable - libraries/integer-gmp/integer-gmp.cabal: Core library - libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library - libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library - libraries/pretty/pretty.cabal: Dependency of ``ghc`` library - libraries/process/process.cabal: Dependency of ``ghc`` library - libraries/stm/stm.cabal: Dependency of ``haskeline`` library - libraries/template-haskell/template-haskell.cabal: Core library - libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library - libraries/text/text.cabal: Dependency of ``Cabal`` library - libraries/time/time.cabal: Dependency of ``ghc`` library - libraries/transformers/transformers.cabal: Dependency of ``ghc`` library - libraries/unix/unix.cabal: Dependency of ``ghc`` library - libraries/Win32/Win32.cabal: Dependency of ``ghc`` library - libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -3,6 +3,14 @@ Version 9.8.1 ============= +The significant changes to the various parts of the compiler are listed in the +following sections. See the `migration guide +`_ on the GHC Wiki +for specific guidance on migrating programs to this release. + +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +11, 12, 13, 14 or 15. + Language ~~~~~~~~ @@ -115,8 +123,8 @@ Compiler deriving instance TypeError (Text "Boo") => Bar Baz -- GHC Proposal `#540 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0540-jsem.rst`_ has been implemented. - This adds the `-jsem`:ghc-flag: flag, which instructs GHC to act as a jobserver client. +- GHC Proposal `#540 `_ has been implemented. + This adds the :ghc-flag:`-jsem` flag, which instructs GHC to act as a jobserver client. This enables multiple GHC processes running at once to share system resources with each other, communicating via the system semaphore specified by the flag argument. @@ -142,22 +150,26 @@ Compiler k :: (Int ~ Bool) => Int -> Bool k x = x - GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. + GHC used to accept the contradictory ``Int~Bool`` in the type signature, but + reject the ``Int~Bool`` constraint that arises from typechecking the + definition itself. Now it accepts both. More details in + :ghc-ticket:`23413`, which gives examples of the previous inconsistency. GHC + now implements the "PermissivePlan" described in that ticket. -- The `-ddump-spec` flag has been split into `-ddump-spec` and - `-ddump-spec-constr`, allowing only output from the typeclass specialiser or - `SpecConstr` to be seen if desired. +- The :ghc-flag:`-ddump-spec` flag has been split into :ghc-flag:`-ddump-spec` and + :ghc-flag:`-ddump-spec-constr`, allowing only output from the typeclass specialiser or + data-constructor specialiser to be dumped if desired. - The compiler may now be configured to compress the debugging information included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must build GHC from source (see - `here` for directions) + `here `_ for directions) and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` script. **Note**: This feature requires that the machine building GHC has `libzstd `_ version 1.4.0 or greater installed. The compression library `libzstd` may optionally be statically linked in the resulting compiler (on non-darwin machines) using the - `--enable-static-libzstd` configure flag. + ``--enable-static-libzstd`` configure flag. In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. @@ -169,11 +181,11 @@ Compiler For example :: - module X ( - {-# WARNING "do not use that constructor" D(D1), - D(D2) - ) - D = D1 | D2 + module X + ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-} + D(D1, D2) + ) where + data D = D1 | D2 This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface @@ -182,7 +194,10 @@ Compiler GHCi ~~~~ -- The deprecated `:ctags` and `:etags` GHCi commands have been removed. See this `wiki page `_ if you want to add a macro to recover similar functionality. +- The deprecated ``:ctags`` and ``:etags`` GHCi commands have been removed. See + this `wiki page + `_ if you + want to add a macro to recover similar functionality. Runtime system ~~~~~~~~~~~~~~ @@ -211,7 +226,7 @@ Runtime system - New primops for fused multiply-add operations. These primops combine a multiplication and an addition, compiling to a single instruction when - the ``-mfma`` flag is enabled and the architecture supports it. + the :ghc-flag:`-mfma` flag is enabled and the architecture supports it. The new primops are ``fmaddFloat#, fmsubFloat#, fnmaddFloat#, fnmsubFloat# :: Float# -> Float# -> Float# -> Float#`` and ``fmaddDouble#, fmsubDouble#, fnmaddDouble#, fnmsubDouble# :: Double# -> Double# -> Double# -> Double#``. @@ -245,19 +260,16 @@ Runtime system This represents the warning assigned to a certain export item, which is used for :ref:`deprecated-exports`. -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ - ``template-haskell`` library ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Record fields now belong to separate ``NameSpace``s, keyed by the parent of +- Record fields now belong to separate ``NameSpace``\ s, keyed by the parent of the record field. This is the name of the first constructor of the parent type, even if this constructor does not have the field in question. - This change enables TemplateHaskell support for ``DuplicateRecordFields``. + This change enables :extension:`TemplateHaskell` support for :extension:`DuplicateRecordFields`. Included libraries ------------------- +~~~~~~~~~~~~~~~~~~ The package database provided with this distribution also contains a number of packages other than GHC itself. See the changelogs provided with these packages @@ -290,6 +302,7 @@ for further change information. libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library libraries/pretty/pretty.cabal: Dependency of ``ghc`` library libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/semaphore-compat/semaphore-compat.cabal: Dependency of ``ghc`` library libraries/stm/stm.cabal: Dependency of ``haskeline`` library libraries/template-haskell/template-haskell.cabal: Core library libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library ===================================== docs/users_guide/exts/implicit_parameters.rst ===================================== @@ -181,7 +181,7 @@ Adding a type signature dramatically changes the result! This is a rather counter-intuitive phenomenon, worth watching out for. Implicit parameters scoping guarantees -------------------------------------- +-------------------------------------- GHC always takes the most nested implicit parameter binding from the context to find the value. Consider the following code:: ===================================== docs/users_guide/ghc_config.py.in ===================================== @@ -1,6 +1,6 @@ extlinks = { - 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '%s'), - 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '#%s'), + 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#%s'), + 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '%s'), } libs_base_uri = '../libraries' ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit f61b0c9104a3c436361f56a0974c5eeef40c1b89 +Subproject commit 8663795322622ac77cc78566185bffbc84e299f2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed28b0f2cac246e9dad669fd59631b8f9e5db2f5...612f17367708d70b6264b85520457789f90be4da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed28b0f2cac246e9dad669fd59631b8f9e5db2f5...612f17367708d70b6264b85520457789f90be4da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 17:39:22 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 19 Jul 2023 13:39:22 -0400 Subject: [Git][ghc/ghc][wip/az/epa-improve-sl1] 23 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64b81fca7c6a3_3a4b0fb741c54186e@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-improve-sl1 at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 647920c2 by Alan Zimmerman at 2023-07-19T18:39:01+01:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c4e5953b2ed2e9001f2370e06a3238f7d2f453f...647920c263f77e3de30b5bc478bcad12ec087c81 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c4e5953b2ed2e9001f2370e06a3238f7d2f453f...647920c263f77e3de30b5bc478bcad12ec087c81 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 17:54:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 13:54:54 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 2 commits: Bump array submodule to v0.5.6.0 Message-ID: <64b8236e27ea1_3a4b0fb755c548084@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 68cc675d by Ben Gamari at 2023-07-19T13:54:38-04:00 Bump array submodule to v0.5.6.0 - - - - - 7063b2a5 by Ben Gamari at 2023-07-19T13:54:38-04:00 users guide: Fix release notes and other documentation issues - - - - - 5 changed files: - − docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/ghc_config.py.in - libraries/containers Changes: ===================================== docs/users_guide/9.6.1-notes.rst deleted ===================================== @@ -1,264 +0,0 @@ -.. _release-9-6-1: - -Version 9.6.1 -============== - -Language -~~~~~~~~ - -- GHC is now more conservative when solving constraints that arise from - superclass expansion in terms of other constraints that also arise from - superclass expansion. - - For example: :: - - class C a - class C a => D a b - instance D a a => D a b - - When typechecking the instance, we need to also solve the constraints arising - from the superclasses of ``D``; in this case, we need ``C a``. We could obtain - evidence for this constraint by expanding the superclasses of the context, - as ``D a a`` also has a superclass context of ``C a``. - However, is it unsound to do so in general, as we might be assuming precisely - the predicate we want to prove! This can lead to programs that loop at runtime. - - When such potentially-loopy situations arise, GHC now emits a warning. - In future releases, this behaviour will no longer be supported, and the - typechecker will outright refuse to solve these constraints, emitting a - ``Could not deduce`` error. - - In practice, you should be able to fix these issues by adding the necessary - constraint to the context, e.g. for the above example: :: - - instance (C a, D a a) => D a b - -- Record updates for GADTs and other existential datatypes are now - fully supported. - - For example: :: - - data D b where - MkD :: { fld1 :: a -> a, fld2 :: a -> (), fld3 :: b } -> D b - - foo :: D b -> D b - foo d = d { fld1 = id, fld2 = const () } - - In this example, we have an existential variable ``a``, and we update - all fields whose type involves ``a`` at once, so the update is valid. - - A side-effect of this change is that GHC now rejects some record updates - involving fields whose types contain type families (these record updates - were previously erroneously accepted). - - Example: :: - - type family F a where - F Int = Char - F Float = Char - - data T b = MkT { x :: [Int], y :: [F b] } - - emptyT :: forall b. T b - emptyT = MkT [] [] - - bar :: T Int - bar = emptyT { x = [3] } - - In this example, we can't infer the type of ``emptyT`` in ``bar``: it could be - ``T Int``, but it could also be ``T Float`` because the type family ``F`` - is not injective and ``T Float ~ T Int``. Indeed, the following typechecks :: - - baz :: T Int - baz = case ( emptyT :: T Float ) of { MkT _ y -> MkT [3] y } - - This means that the type of ``emptyT`` is ambiguous in the definition - of ``bar`` above, and thus GHC rejects the record update: :: - - Couldn't match type `F b0' with `Char' - Expected: [F Int] - Actual: [F b0] - NB: ‘F’ is a non-injective type family - The type variable ‘b0’ is ambiguous - - To fix these issues, add a type signature to the expression that the - record update is applied to (``emptyT`` in the example above), or - add an injectivity annotation to the type family in the case that - the type family is in fact injective. - -- Error messages are now assigned unique error codes, of the form ``[GHC-12345]``. - -- GHC Proposal `#106 - `_ - has been implemented, introducing a new language extension - :extension:`TypeData`. This extension permits ``type data`` declarations - as a more fine-grained alternative to :extension:`DataKinds`. - -- GHC now does a better job of solving constraints in the presence of multiple - matching quantified constraints. For example, if we want to solve - ``C a b Int`` and we have matching quantified constraints: :: - - forall x y z. (Ord x, Enum y, Num z) => C x y z - forall u v. (Enum v, Eq u) => C u v Int - - Then GHC will use the second quantified constraint to solve ``C a b Int``, - as it has a strictly weaker precondition. - -- GHC proposal `#170 Unrestricted OverloadedLabels - `_ - has been implemented. - This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. - Examples of newly allowed syntax: - - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` - -Compiler -~~~~~~~~ - -- The `WebAssembly backend - `_ - has been merged. This allows GHC to be built as a cross-compiler - that targets ``wasm32-wasi`` and compiles Haskell code to - self-contained WebAssembly modules that can be executed on a variety - of different runtimes. There are a few caveats to be aware of: - - - To use the WebAssembly backend, one would need to follow the - instructions on `ghc-wasm-meta - `_. The WebAssembly - backend is not included in the GHC release bindists for the time - being, nor is it supported by ``ghcup`` or ``stack`` yet. - - The WebAssembly backend is still under active development. It's - presented in this GHC version as a technology preview, bugs and - missing features are expected. - -- The JavaScript backend has been merged. GHC is now able to be built as a - cross-compiler targeting the JavaScript platform. The backend should be - considered a technology preview. As such it is not ready for use in - production, is not distributed in the GHC release bindists and requires the - user to manually build GHC as a cross-compiler. See the JavaScript backend - `wiki `_ page - on the GHC wiki for the current status, project roadmap, build instructions - and demos. - -- The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included - in :extension:`PolyKinds` and :extension:`DataKinds`. - -- The :ghc-flag:`-Woperator-whitespace` warning no longer ignores constructor symbols - (operators starting with ``:``). - -- The :ghc-flag:`-Wstar-is-type` warning is now enabled by default. - -GHCi -~~~~ - -- GHCi will now accept any file-header pragmas it finds, such as - ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, - instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, - you could instead write: - - .. code-block:: none - - ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} - -This can be convenient when pasting large multi-line blocks of code into GHCi. - -Runtime system -~~~~~~~~~~~~~~ - -- The `Delimited continuation primops `_ - proposal has been implemented, adding native support for first-class, - delimited continuations to the RTS. For the reasons given in the proposal, - no safe API to access this functionality is provided anywhere in ``base``. - Instead, the ``prompt#`` and ``control0#`` primops are intended to be consumed - by library authors directly, who may wrap them a safe API that maintains the - necessary invariants. See the documentation in ``GHC.Prim`` for more details. - -- The behaviour of the ``-M`` flag has been made more strict. It will now trigger - a heap overflow if the total amount of memory used by the Haskell heap exceeds the limit. - Previously only live blocks were taken into account. - This makes it more likely to trigger promptly when the heap is highly fragmented. - -- Fixed a bug that sometimes caused live sparks to be GC'ed too early either during - minor GC or major GC with workstealing disabled. See #22528. - - -``base`` library -~~~~~~~~~~~~~~~~ - -- Exceptions thrown by weak pointer finalizers can now be reported by setting - a global exception handler, using ``GHC.Weak.Finalize.setFinalizerExceptionHandler``. - The default behaviour is unchanged (exceptions are ignored and not reported). - -- GHC now provides a set of operations for introspecting on the threads of a - program, ``GHC.Conc.listThreads``, as well as operations for querying a thread's - label (:base-ref:`GHC.Conc.Sync.threadLabel`) and status - (:base-ref:`GHC.Conc.threadStatus`). - -- Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use - ``(<=)`` instead of ``compare`` per CLC proposal: - https://github.com/haskell/core-libraries-committee/issues/24 - -- Updated to `Unicode 15.0.0 `_. - -- Add standard Unicode case predicates :base-ref:`Data.Char.isUpperCase` and - :base-ref:`Data.Char.isLowerCase`. These predicates use the standard Unicode - case properties and are more intuitive than :base-ref:`Data.Char.isUpper` and - :base-ref:`Data.Char.isLower`. - -``ghc-prim`` library -~~~~~~~~~~~~~~~~~~~~ - -``ghc`` library -~~~~~~~~~~~~~~~ - -- Add `Foreign.C.Types.ConstPtr` was added to encode ``const``-qualified pointer return - types in foreign declarations when using ``CApiFFI`` extension. - -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ - - -Included libraries ------------------- - -The package database provided with this distribution also contains a number of -packages other than GHC itself. See the changelogs provided with these packages -for further change information. - -.. ghc-package-list:: - - libraries/array/array.cabal: Dependency of ``ghc`` library - libraries/base/base.cabal: Core library - libraries/binary/binary.cabal: Dependency of ``ghc`` library - libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library - libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility - libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility - libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library - libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library - libraries/directory/directory.cabal: Dependency of ``ghc`` library - libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library - libraries/filepath/filepath.cabal: Dependency of ``ghc`` library - compiler/ghc.cabal: The compiler itself - libraries/ghci/ghci.cabal: The REPL interface - libraries/ghc-boot/ghc-boot.cabal: Internal compiler library - libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library - libraries/ghc-compact/ghc-compact.cabal: Core library - libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library - libraries/ghc-prim/ghc-prim.cabal: Core library - libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable - libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable - libraries/integer-gmp/integer-gmp.cabal: Core library - libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library - libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library - libraries/pretty/pretty.cabal: Dependency of ``ghc`` library - libraries/process/process.cabal: Dependency of ``ghc`` library - libraries/stm/stm.cabal: Dependency of ``haskeline`` library - libraries/template-haskell/template-haskell.cabal: Core library - libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library - libraries/text/text.cabal: Dependency of ``Cabal`` library - libraries/time/time.cabal: Dependency of ``ghc`` library - libraries/transformers/transformers.cabal: Dependency of ``ghc`` library - libraries/unix/unix.cabal: Dependency of ``ghc`` library - libraries/Win32/Win32.cabal: Dependency of ``ghc`` library - libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -3,21 +3,16 @@ Version 9.8.1 ============= -Language -~~~~~~~~ - -- There is a new extension :extension:`ExtendedLiterals`, which enables - sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. - See the GHC proposal `#451 `_. +The significant changes to the various parts of the compiler are listed in the +following sections. See the `migration guide +`_ on the GHC Wiki +for specific guidance on migrating programs to this release. -- GHC Proposal `#425 - `_ - has been partially implemented. Namely, the ``@k``-binders in type declarations are now permitted:: - - type T :: forall k. k -> forall j. j -> Type - data T @k (a :: k) @(j :: Type) (b :: j) +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +11, 12, 13, 14 or 15. - This feature is guarded behind :extension:`TypeAbstractions`. +Breaking changes +~~~~~~~~~~~~~~~~ - In accordance with GHC proposal `#425 `_ @@ -35,6 +30,49 @@ Language type instance forall j . F1 Int = Any :: j -> j +- Data types with ``deriving`` clauses now reject inferred instance contexts + that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as + this one: :: + + newtype Foo = Foo Int + + class Bar a where + bar :: a + + instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined + + newtype Baz = Baz Foo + deriving Bar + + Here, the derived ``Bar`` instance for ``Baz`` would look like this: :: + + instance TypeError (Text "Boo") => Bar Baz + + While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``" + in the resulting error message. If you really want to derive this instance and + defer the error to sites where the instance is used, you must do so manually + with :extension:`StandaloneDeriving`, e.g. :: + + deriving instance TypeError (Text "Boo") => Bar Baz + + +Language +~~~~~~~~ + +- There is a new extension :extension:`ExtendedLiterals`, which enables + sized primitive numeric literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. + See the GHC proposal `#451 `_. + +- GHC Proposal `#425 + `_ + has been partially implemented. Namely, the ``@k``-binders in type declarations are now permitted:: + + type T :: forall k. k -> forall j. j -> Type + data T @k (a :: k) @(j :: Type) (b :: j) + + This feature is guarded behind :extension:`TypeAbstractions`. + Compiler ~~~~~~~~ @@ -58,9 +96,9 @@ Compiler - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking - the specification described in the documentation of the `INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. + the specification described in the documentation of the :pragma:`INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. -- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. +- Fix a bug in TemplateHaskell evaluation causing excessive calls to ``setNumCapabilities`` when :ghc-flag:`-j` is greater than :rts-flag:`-N`. See :ghc-ticket:`23049`. - The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are @@ -86,45 +124,21 @@ Compiler blah x = x { foo = 5, bar = 6 } - The point is that only the type S has a constructor with both fields "foo" - and "bar", so this record update is unambiguous. - -- Data types with ``deriving`` clauses now reject inferred instance contexts - that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as - this one: :: - - newtype Foo = Foo Int - - class Bar a where - bar :: a - - instance (TypeError (Text "Boo")) => Bar Foo where - bar = undefined - - newtype Baz = Baz Foo - deriving Bar - - Here, the derived ``Bar`` instance for ``Baz`` would look like this: :: - - instance TypeError (Text "Boo") => Bar Baz + The point is that only the type S has a constructor with both fields ``foo`` + and ``bar``, so this record update is unambiguous. - While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``" - in the resulting error message. If you really want to derive this instance and - defer the error to sites where the instance is used, you must do so manually - with :extension:`StandaloneDeriving`, e.g. :: - - deriving instance TypeError (Text "Boo") => Bar Baz - -- GHC Proposal `#540 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0540-jsem.rst`_ has been implemented. - This adds the `-jsem`:ghc-flag: flag, which instructs GHC to act as a jobserver client. +- GHC Proposal `#540 `_ has been implemented. + This adds the :ghc-flag:`-jsem` flag, which instructs GHC to act as a jobserver client. This enables multiple GHC processes running at once to share system resources with each other, communicating via the system semaphore specified by the flag argument. + Complementary support for this feature in ``cabal-install`` will come soon. + - GHC Proposal `#433 `_ has been implemented. This adds the class ``Unsatisfiable :: ErrorMessage -> Constraint`` - to the ``GHC.TypeError`` module. Constraints of the form ``Unsatisfiable msg`` + to the :base-ref:`GHC.TypeError` module. Constraints of the form ``Unsatisfiable msg`` provide a mechanism for custom type errors that reports the errors in a more predictable behaviour than ``TypeError``, as these constraints are handled purely during constraint solving. @@ -137,27 +151,31 @@ Compiler This allows errors to be reported when users use the instance, even when type errors are being deferred. -- GHC is now deals "insoluble Givens" in a consistent way. For example: :: +- GHC now deals with "insoluble Givens" in a consistent way. For example: :: k :: (Int ~ Bool) => Int -> Bool k x = x - GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. + GHC used to accept the contradictory ``Int~Bool`` in the type signature, but + reject the ``Int~Bool`` constraint that arises from typechecking the + definition itself. Now it accepts both. More details in + :ghc-ticket:`23413`, which gives examples of the previous inconsistency. GHC + now implements the "PermissivePlan" described in that ticket. -- The `-ddump-spec` flag has been split into `-ddump-spec` and - `-ddump-spec-constr`, allowing only output from the typeclass specialiser or - `SpecConstr` to be seen if desired. +- The :ghc-flag:`-ddump-spec` flag has been split into :ghc-flag:`-ddump-spec` and + :ghc-flag:`-ddump-spec-constr`, allowing only output from the typeclass specialiser or + data-constructor specialiser to be dumped if desired. - The compiler may now be configured to compress the debugging information included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must build GHC from source (see - `here` for directions) + `here `_ for directions) and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` script. **Note**: This feature requires that the machine building GHC has `libzstd `_ version 1.4.0 or greater installed. The compression library `libzstd` may optionally be statically linked in the resulting compiler (on non-darwin machines) using the - `--enable-static-libzstd` configure flag. + ``--enable-static-libzstd`` configure flag. In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. @@ -169,11 +187,11 @@ Compiler For example :: - module X ( - {-# WARNING "do not use that constructor" D(D1), - D(D2) - ) - D = D1 | D2 + module X + ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-} + D(D1, D2) + ) where + data D = D1 | D2 This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface @@ -182,7 +200,10 @@ Compiler GHCi ~~~~ -- The deprecated `:ctags` and `:etags` GHCi commands have been removed. See this `wiki page `_ if you want to add a macro to recover similar functionality. +- The deprecated ``:ctags`` and ``:etags`` GHCi commands have been removed. See + this `wiki page + `_ if you + want to add a macro to recover similar functionality. Runtime system ~~~~~~~~~~~~~~ @@ -193,7 +214,7 @@ Runtime system ``base`` library ~~~~~~~~~~~~~~~~ -- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. +- :base-ref:`Data.Tuple` now exports ``getSolo :: Solo a -> a``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ @@ -211,7 +232,7 @@ Runtime system - New primops for fused multiply-add operations. These primops combine a multiplication and an addition, compiling to a single instruction when - the ``-mfma`` flag is enabled and the architecture supports it. + the :ghc-flag:`-mfma` flag is enabled and the architecture supports it. The new primops are ``fmaddFloat#, fmsubFloat#, fnmaddFloat#, fnmsubFloat# :: Float# -> Float# -> Float# -> Float#`` and ``fmaddDouble#, fmsubDouble#, fnmaddDouble#, fnmsubDouble# :: Double# -> Double# -> Double# -> Double#``. @@ -245,19 +266,16 @@ Runtime system This represents the warning assigned to a certain export item, which is used for :ref:`deprecated-exports`. -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ - ``template-haskell`` library ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Record fields now belong to separate ``NameSpace``s, keyed by the parent of +- Record fields now belong to separate ``NameSpace``\ s, keyed by the parent of the record field. This is the name of the first constructor of the parent type, even if this constructor does not have the field in question. - This change enables TemplateHaskell support for ``DuplicateRecordFields``. + This change enables :extension:`TemplateHaskell` support for :extension:`DuplicateRecordFields`. Included libraries ------------------- +~~~~~~~~~~~~~~~~~~ The package database provided with this distribution also contains a number of packages other than GHC itself. See the changelogs provided with these packages @@ -290,6 +308,7 @@ for further change information. libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library libraries/pretty/pretty.cabal: Dependency of ``ghc`` library libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/semaphore-compat/semaphore-compat.cabal: Dependency of ``ghc`` library libraries/stm/stm.cabal: Dependency of ``haskeline`` library libraries/template-haskell/template-haskell.cabal: Core library libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library ===================================== docs/users_guide/exts/implicit_parameters.rst ===================================== @@ -181,7 +181,7 @@ Adding a type signature dramatically changes the result! This is a rather counter-intuitive phenomenon, worth watching out for. Implicit parameters scoping guarantees -------------------------------------- +-------------------------------------- GHC always takes the most nested implicit parameter binding from the context to find the value. Consider the following code:: ===================================== docs/users_guide/ghc_config.py.in ===================================== @@ -1,6 +1,6 @@ extlinks = { - 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '%s'), - 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '#%s'), + 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#%s'), + 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '%s'), } libs_base_uri = '../libraries' ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit f61b0c9104a3c436361f56a0974c5eeef40c1b89 +Subproject commit 8663795322622ac77cc78566185bffbc84e299f2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/612f17367708d70b6264b85520457789f90be4da...7063b2a5558ef51859eac5a1572fcef79a03b438 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/612f17367708d70b6264b85520457789f90be4da...7063b2a5558ef51859eac5a1572fcef79a03b438 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 18:47:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 14:47:41 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] Bump containers submodule Message-ID: <64b82fcd75381_3a4b0fb74585564cd@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 846ecee9 by Ben Gamari at 2023-07-19T14:46:57-04:00 Bump containers submodule - - - - - 1 changed file: - libraries/containers Changes: ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 8663795322622ac77cc78566185bffbc84e299f2 +Subproject commit f61b0c9104a3c436361f56a0974c5eeef40c1b89 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/846ecee9b9663a51868ec0d232b77c6e3faf235c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/846ecee9b9663a51868ec0d232b77c6e3faf235c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 19:28:12 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 15:28:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-internals-2 Message-ID: <64b8394ca3f5d_3a4b0fb755c56493a@gitlab.mail> Ben Gamari pushed new branch wip/ghc-internals-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-internals-2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 20:53:19 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 19 Jul 2023 16:53:19 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 46 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64b84d3f4cab7_3a4b0f406ce405691e0@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 647920c2 by Alan Zimmerman at 2023-07-19T18:39:01+01:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - a85275fa by Alan Zimmerman at 2023-07-19T19:18:04+01:00 Summary: epa-improve-comb4-5 Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-27 23:08:05 +0100 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - e9c059e1 by Alan Zimmerman at 2023-07-19T19:18:10+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - bf6cbd85 by Alan Zimmerman at 2023-07-19T19:18:10+01:00 Summary: EPA make getLocA a synonym for getHasLoc Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-16 09:25:10 +0100 EPA make getLocA a synonym for getHasLoc - - - - - 39e6af9a by Alan Zimmerman at 2023-07-19T19:18:11+01:00 EPA: Fix span for GRHS - - - - - b4b7fd39 by Alan Zimmerman at 2023-07-19T19:18:11+01:00 EPA: Capture full range for a CaseAlt Match - - - - - bb480d1e by Alan Zimmerman at 2023-07-19T20:35:55+01:00 Summary: Patch: summary-epa-use-full-range-for Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:34:57 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] info: patch template saved to `-` - - - - - a85fda1d by Alan Zimmerman at 2023-07-19T20:37:10+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 2016c101 by Alan Zimmerman at 2023-07-19T20:37:15+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 2e9c1bf1 by Alan Zimmerman at 2023-07-19T20:37:15+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - b4e2394b by Alan Zimmerman at 2023-07-19T20:37:15+01:00 WIP - - - - - 1e079b63 by Alan Zimmerman at 2023-07-19T20:37:15+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 1c36540f by Alan Zimmerman at 2023-07-19T20:37:15+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 4da4440e by Alan Zimmerman at 2023-07-19T20:37:15+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - c75e7d2f by Alan Zimmerman at 2023-07-19T20:37:16+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 02382eaf by Alan Zimmerman at 2023-07-19T21:04:23+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 2b41a1b1 by Alan Zimmerman at 2023-07-19T21:04:27+01:00 EPA: Fix simple tests - - - - - 22ddde03 by Alan Zimmerman at 2023-07-19T21:04:27+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 7094e26b by Alan Zimmerman at 2023-07-19T21:04:28+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 57a2b3b4 by Alan Zimmerman at 2023-07-19T21:04:28+01:00 EPA: deal with fallout from getMonoBind - - - - - 1380aca4 by Alan Zimmerman at 2023-07-19T21:04:28+01:00 EPA fix captureLineSpacing - - - - - 7669a8d8 by Alan Zimmerman at 2023-07-19T21:04:28+01:00 EPA print any comments in the span before exiting it - - - - - 27bb5c9f by Alan Zimmerman at 2023-07-19T21:07:46+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - c9c11080 by Alan Zimmerman at 2023-07-19T21:52:49+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c243e62ebd1ac44f332d0538e3273cf2de8ae80c...c9c11080797e55c4174a6bae11e470d8ce5f348d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c243e62ebd1ac44f332d0538e3273cf2de8ae80c...c9c11080797e55c4174a6bae11e470d8ce5f348d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 21:02:32 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 19 Jul 2023 17:02:32 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] EPA: Add '=>' to TrailingAnn Message-ID: <64b84f67cf9af_3a4b0fb74945730b6@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: a361f826 by Alan Zimmerman at 2023-07-19T22:01:50+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 7 changed files: - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/typecheck/should_compile/T15242.stderr - testsuite/tests/typecheck/should_compile/all.T - utils/check-exact/ExactPrint.hs - utils/check-exact/Utils.hs Changes: ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -2381,15 +2381,6 @@ (Nothing) (Nothing))) ,(L -<<<<<<< current - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:5:1-16 }) - (ImportDecl - (XImportDeclPass - (EpAnn - (Anchor - { DumpRenamedAst.hs:5:1-16 } - (UnchangedAnchor)) -======= ((EpAnnS (EpaSpan { DumpRenamedAst.hs:5:1-16 }) (AnnListItem @@ -2399,12 +2390,7 @@ (ImportDecl (XImportDeclPass (EpAnn -<<<<<<< current - (EpaSpan { DumpRenamedAst.hs:6:1-6 }) ->>>>>>> fd352736b6 (Put BufSpan into RealSrcSpan) -======= (EpaSpan { DumpRenamedAst.hs:5:1-16 }) ->>>>>>> patched (EpAnnImportDecl (EpaSpan { DumpRenamedAst.hs:5:1-6 }) (Nothing) @@ -2431,13 +2417,6 @@ (Nothing) (Nothing))) ,(L - (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:7:1-23 }) - (ImportDecl - (XImportDeclPass - (EpAnn - (Anchor - { DumpRenamedAst.hs:7:1-23 } - (UnchangedAnchor)) ((EpAnnS (EpaSpan { DumpRenamedAst.hs:7:1-23 }) (AnnListItem ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -1503,7 +1503,7 @@ (NoExtField) (L (SrcSpanAnn (EpAnn - (EpaSpan { DumpSemis.hs:31:6-23 }) + (EpaSpan { DumpSemis.hs:31:6-20 }) (AnnContext (Just ((,) @@ -1514,7 +1514,7 @@ [(EpaSpan { DumpSemis.hs:31:19 }) ,(EpaSpan { DumpSemis.hs:31:20 })]) (EpaComments - [])) { DumpSemis.hs:31:6-23 }) + [])) { DumpSemis.hs:31:6-20 }) [(L ((EpAnnS (EpaSpan { DumpSemis.hs:31:8-11 }) ===================================== testsuite/tests/parser/should_compile/T15323.stderr ===================================== @@ -160,7 +160,7 @@ (Just (L (SrcSpanAnn (EpAnn - (EpaSpan { T15323.hs:6:31-39 }) + (EpaSpan { T15323.hs:6:31-36 }) (AnnContext (Just ((,) @@ -169,7 +169,7 @@ [] []) (EpaComments - [])) { T15323.hs:6:31-39 }) + [])) { T15323.hs:6:31-36 }) [(L ((EpAnnS (EpaSpan { T15323.hs:6:31-36 }) ===================================== testsuite/tests/typecheck/should_compile/T15242.stderr ===================================== @@ -1,17 +1,1851 @@ -(EpaSpan { T15242.hs:6:5-41 }) -(EpaSpan { T15242.hs:6:6-40 }) -(EpaSpan { T15242.hs:6:7-39 }) -(EpaSpan { T15242.hs:6:8-35 }) -(EpaSpan { T15242.hs:6:9-34 }) -(EpaSpan { T15242.hs:6:10-33 }) -(EpaSpan { T15242.hs:6:11-29 }) -(EpaSpan { T15242.hs:6:12-25 }) -(EpaSpan { T15242.hs:6:13-21 }) -(EpaSpan { T15242.hs:6:14-20 }) -(EpaSpan { T15242.hs:5:5-17 }) -(EpaSpan { T15242.hs:5:6-16 }) -[])) -(EpaSpan { T15242.hs:5:19-37 }) -(EpaSpan { T15242.hs:5:20-32 }) -(EpaSpan { T15242.hs:5:21-31 }) -[])) \ No newline at end of file + +==================== Typechecker AST ==================== + +{Bag(LocatedA (HsBind Var)): + [(L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (VarBind + (NoExtField) + {Var: T15242.$trModule} + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnn + (EpaDelta (SameLine 0) []) + (NoEpAnns) + (EpaComments + [])) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnn + (EpaDelta (SameLine 0) []) + (NoEpAnns) + (EpaComments + [])) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (ConLikeTc + ({abstract:ConLike}) + [] + []))) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnn + (EpaDelta (SameLine 0) []) + (NoEpAnns) + (EpaComments + [])) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (ConLikeTc + ({abstract:ConLike}) + [] + []))) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsLit + (EpAnn + (EpaDelta (SameLine 0) []) + (NoEpAnns) + (EpaComments + [])) + (HsStringPrim + (NoSourceText) + "main"))))) + (L + (NoTokenLoc) + (HsTok)))))) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnn + (EpaDelta (SameLine 0) []) + (NoEpAnns) + (EpaComments + [])) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (ConLikeTc + ({abstract:ConLike}) + [] + []))) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsLit + (EpAnn + (EpaDelta (SameLine 0) []) + (NoEpAnns) + (EpaComments + [])) + (HsStringPrim + (NoSourceText) + "T15242"))))) + (L + (NoTokenLoc) + (HsTok)))))))) + ,(L + ((EpAnnS + (EpaSpan { T15242.hs:6:1-44 }) + (AnnListItem + []) + (EpaComments + []))) + (XHsBindsLR + (AbsBinds + [{Var: a_awV}] + [] + [(ABE + {Var: g} + {Var: g_awX} + (WpHole) + (SpecPrags + []))] + [({abstract:TcEvBinds})] + {Bag(LocatedA (HsBind Var)): + [(L + ((EpAnnS + (EpaSpan { T15242.hs:6:1-44 }) + (AnnListItem + []) + (EpaComments + []))) + (FunBind + ((,) + (WpHole) + []) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:1 }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: g_awX}) + (MG + (MatchGroupTc + [] + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FromSource)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15242.hs:6:1-44 }) + [(L + ((EpAnnS + (EpaSpan { T15242.hs:6:1-44 }) + (AnnListItem + []) + (EpaComments + []))) + (Match + (EpAnnNotUsed) + (FunRhs + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:1 }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Name: g}) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (EpAnnS + (EpaSpan { T15242.hs:6:3-44 }) + (NoEpAnns) + (EpaComments + [])) + (GRHS + (EpAnnNotUsed) + [] + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:5-44 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:5-41 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:6-40 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:7-39 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:8-38 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:8-35 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:9-34 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:10-33 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:11-32 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:11-29 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:12-28 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:12-25 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:13-24 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:13-21 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:14-20 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:15-19 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:15-16 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))))))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: id})))))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:18-19 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))))))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: id})))))))) + (L + (NoTokenLoc) + (HsTok)))) + (L + (NoTokenLoc) + (HsTok)))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:23-24 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: id})))))))) + (L + (NoTokenLoc) + (HsTok)))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:27-28 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: id})))))))) + (L + (NoTokenLoc) + (HsTok)))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:31-32 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})) + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV})))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: id})))))))) + (L + (NoTokenLoc) + (HsTok)))) + (L + (NoTokenLoc) + (HsTok)))) + (L + (NoTokenLoc) + (HsTok)))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:37-38 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (FunTy + (FTF_T_T) + (TyConApp + ({abstract:TyCon}) + []) + (TyVarTy + {Var: a_awV}) + (TyVarTy + {Var: a_awV}))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: id})))))))) + (L + (NoTokenLoc) + (HsTok)))) + (L + (NoTokenLoc) + (HsTok)))) + (L + (NoTokenLoc) + (HsTok)))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:6:43-44 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (TyVarTy + {Var: a_awV})) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: id}))))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))]} + (False)))) + ,(L + ((EpAnnS + (EpaSpan { T15242.hs:5:1-37 }) + (AnnListItem + []) + (EpaComments + []))) + (XHsBindsLR + (AbsBinds + [] + [] + [(ABE + {Var: f} + {Var: f_aAD} + (WpHole) + (SpecPrags + []))] + [({abstract:TcEvBinds})] + {Bag(LocatedA (HsBind Var)): + [(L + ((EpAnnS + (EpaSpan { T15242.hs:5:1-37 }) + (AnnListItem + []) + (EpaComments + []))) + (FunBind + ((,) + (WpHole) + []) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:1 }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: f_aAD}) + (MG + (MatchGroupTc + [] + (TyConApp + ({abstract:TyCon}) + []) + (FromSource)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T15242.hs:5:1-37 }) + [(L + ((EpAnnS + (EpaSpan { T15242.hs:5:1-37 }) + (AnnListItem + []) + (EpaComments + []))) + (Match + (EpAnnNotUsed) + (FunRhs + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:1 }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Name: f}) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (EpaComments + []) + [(L + (EpAnnS + (EpaSpan { T15242.hs:5:3-37 }) + (NoEpAnns) + (EpaComments + [])) + (GRHS + (EpAnnNotUsed) + [] + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:5-37 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:5-17 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:6-16 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:7-15 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:7-13 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpCompose + (WpTyApp + (TyConApp + ({abstract:TyCon}) + [])) + (WpTyApp + (TyConApp + ({abstract:TyCon}) + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:8-12 }) + (AnnListItem + []) + (EpaComments + []))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: const}))) + (L + (NoTokenLoc) + (HsTok))))))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:15 }) + (AnnListItem + []) + (EpaComments + []))) + (HsOverLit + (EpAnnNotUsed) + (OverLit + (OverLitTc + (False) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpCompose + (WpEvApp + (EvExpr + (Var + {Var: $dNum_aAx}))) + (WpTyApp + (TyConApp + ({abstract:TyCon}) + []))) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: fromInteger})))))) + (L + ((EpAnnS + (EpaSpan { }) + (AnnListItem + []) + (EpaComments + []))) + (HsLit + (EpAnnNotUsed) + (HsInteger + (SourceText 3) + (3) + (TyConApp + ({abstract:TyCon}) + []))))) + (TyConApp + ({abstract:TyCon}) + [])) + (HsIntegral + (IL + (SourceText 3) + (False) + (3)))))))) + (L + (NoTokenLoc) + (HsTok)))) + (L + (NoTokenLoc) + (HsTok)))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:19-37 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnn + (EpaSpan { T15242.hs:5:19-37 }) + (NoEpAnns) + (EpaComments + [])) + (L + (TokenLoc + (EpaSpan { T15242.hs:5:19 })) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:20-36 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:20-32 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:21-31 }) + (AnnListItem + []) + (EpaComments + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:22-30 }) + (AnnListItem + []) + (EpaComments + []))) + (HsApp + (EpAnnNotUsed) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:22-26 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpCompose + (WpTyApp + (TyConApp + ({abstract:TyCon}) + [])) + (WpTyApp + (TyConApp + ({abstract:TyCon}) + []))) + (HsPar + (EpAnnNotUsed) + (L + (NoTokenLoc) + (HsTok)) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:23-25 }) + (AnnListItem + []) + (EpaComments + []))) + (XExpr + (WrapExpr + (HsWrap + (WpTyApp + (TyConApp + ({abstract:TyCon}) + [])) + (HsVar + (NoExtField) + (L + ((EpAnnS + (EpaSpan { }) + (NameAnnTrailing + []) + (EpaComments + []))) + {Var: seq})))))) + (L + (NoTokenLoc) + (HsTok))))))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:28-30 }) + (AnnListItem + []) + (EpaComments + []))) + (HsLit + (EpAnn + (EpaSpan { T15242.hs:5:28-30 }) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 'a') + ('a')))))) + (L + (NoTokenLoc) + (HsTok)))) + (L + (NoTokenLoc) + (HsTok)))) + (L + ((EpAnnS + (EpaSpan { T15242.hs:5:34-36 }) + (AnnListItem + []) + (EpaComments + []))) + (HsLit + (EpAnn + (EpaSpan { T15242.hs:5:34-36 }) + (NoEpAnns) + (EpaComments + [])) + (HsChar + (SourceText 'b') + ('b')))))) + (L + (TokenLoc + (EpaSpan { T15242.hs:5:37 })) + (HsTok))))))))] + (EmptyLocalBinds + (NoExtField)))))]))))]} + (False))))]} ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -635,22 +635,7 @@ test('T15788', normal, compile, ['']) test('T15807a', normal, compile, ['']) test('T13833', normal, compile, ['']) test('T14185', expect_broken(14185), compile, ['']) - -def onlyHsParLocs(x): - """ - We only want to check that all the parentheses are present with the correct location, - not compare the entire typechecked AST. - Located (HsPar GhcTc) are pretty printed with the form - ({ - (HsPar - This function tries to extract all such location infos from the typechecked AST. - """ - ls = x.split("\n") - filteredLines = (loc.strip() for (loc,hspar) in zip(ls,ls[5:]) - if hspar.strip().startswith("(HsPar") - and not "" in loc) - return '\n'.join(filteredLines) -test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) +test('T15242', normal, compile, ['']) test('T15431', normal, compile, ['']) test('T15431a', normal, compile, ['']) test('T15428', normal, compile, ['']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -1542,17 +1542,17 @@ instance (ExactPrint a) => ExactPrint (LocatedA a) where exact (L la a) = do debugM $ "LocatedA a:la loc=" ++ show (ss2range $ locA la) a' <- markAnnotated a --- start of variant ANEW --- start of variant A - ann' <- markALocatedA (ann la) - return (L (la { ann = ann'}) a') --- start of variant B - -- return (L la a') --- end of variants - la' <- markALocatedA la - return (L la' a') ---- end end --- end of ANEW +-- -- start of variant ANEW +-- -- start of variant A +-- ann' <- markALocatedA (ann la) +-- return (L (la { ann = ann'}) a') +-- -- start of variant B +-- -- return (L la a') +-- -- end of variants +-- la' <- markALocatedA la +-- return (L la' a') +-- --- end end +-- -- end of ANEW return (L la a') -- end of BNEW @@ -4945,7 +4945,7 @@ instance ExactPrint (HsPatSigType GhcPs) where instance ExactPrint (HsTyPat GhcPs) where getAnnotationEntry = const NoEntryVal - setAnnotationAnchor a _ _ = a + setAnnotationAnchor a _ _ _ = a exact (HsTP an ty) = do ty' <- markAnnotated ty ===================================== utils/check-exact/Utils.hs ===================================== @@ -48,8 +48,8 @@ import Types -- |Global switch to enable debug tracing in ghc-exactprint Delta / Print debugEnabledFlag :: Bool -debugEnabledFlag = True --- debugEnabledFlag = False +-- debugEnabledFlag = True +debugEnabledFlag = False -- |Provide a version of trace that comes at the end of the line, so it can -- easily be commented out when debugging different things. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a361f8269f8440fe65f7ad187c88717780ba3dbd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a361f8269f8440fe65f7ad187c88717780ba3dbd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 21:34:57 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 19 Jul 2023 17:34:57 -0400 Subject: [Git][ghc/ghc][wip/T22404] Try effect of removing fast path in occAnalBind Message-ID: <64b857012b6ea_3a4b0fb741c5762d6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 35eb91c4 by Simon Peyton Jones at 2023-07-19T22:34:17+01:00 Try effect of removing fast path in occAnalBind - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -973,6 +973,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` (combine [NonRec tagged_bndr rhs'] body) +{- -- Fast path for top level, non-recursive bindings, with no rules -- This is a very common case. Semantically though, you can delete this -- entire equation and fall through to the general case @@ -997,6 +998,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine in WUD (full_rhs_uds `andUDs` body_uds) -- Note `andUDs` (combine [NonRec tagged_bndr rhs'] body) +-} -- The normal case, including newly-discovered join points -- Analyse the body and /then/ the RHS View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35eb91c40e0a67c748e494cf8fa2c7cfc42763da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35eb91c40e0a67c748e494cf8fa2c7cfc42763da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 19 22:49:58 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 19 Jul 2023 18:49:58 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] 12 commits: Reg.Liveness: Strictness Message-ID: <64b86896ebc26_3a4b0fb74585829e5@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ac5c6a24 by Vladislav Zavialov at 2023-07-20T00:48:45+02:00 Visible forall in types of terms: Part 1 This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f1cc0f6bc2135b471937725805e35ef9158d2a8...ac5c6a2490c6b4a734e69ee9c2b694e85abde1da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9f1cc0f6bc2135b471937725805e35ef9158d2a8...ac5c6a2490c6b4a734e69ee9c2b694e85abde1da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 01:03:00 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 19 Jul 2023 21:03:00 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] Update the HieVdq test case Message-ID: <64b887c4bd608_3a4b0fb74945889bb@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: f9c86438 by Vladislav Zavialov at 2023-07-20T02:59:51+02:00 Update the HieVdq test case - - - - - 3 changed files: - compiler/GHC/Iface/Ext/Ast.hs - testsuite/tests/hiefile/should_run/HieVdq.hs - testsuite/tests/hiefile/should_run/HieVdq.stdout Changes: ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1027,9 +1027,9 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where sig HieRn -> pure [] ] - EmbTyPat _ _ _ -> - -- TODO (int-index): Return more information? Test case: HieVdq - [] + EmbTyPat _ _ tp -> + [ toHie $ TS (ResolvedScopes [scope, pscope]) tp + ] XPat e -> case hiePass @p of HieRn -> case e of ===================================== testsuite/tests/hiefile/should_run/HieVdq.hs ===================================== @@ -3,16 +3,20 @@ module Main where +import GHC.Types.Name (nameSrcSpan) import TestUtils import qualified Data.Map as M import Data.Foldable +import Data.Either f :: forall a -> a -> Maybe a -f (type t) (x :: t) = Just x +f (type t) (x :: t) = Just (x :: t) +-- ^p1 ^p2 ^p3 p1,p2 :: (Int,Int) -p1 = (11,13) -p2 = (11,28) +p1 = (13,9) +p2 = (13,18) +p3 = (13,34) selectPoint' :: HieFile -> (Int,Int) -> HieAST Int selectPoint' hf loc = @@ -20,8 +24,11 @@ selectPoint' hf loc = main = do (df, hf) <- readTestHie "HieVdq.hie" - forM_ [p1,p2] $ \point -> do - putStr $ "At " ++ show point ++ ", got type: " - let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point - forM_ types $ \typ -> do - putStrLn (renderHieType df $ recoverFullType typ (hie_types hf)) + forM_ [p1,p2,p3] $ \point -> do + putStr $ "At " ++ show point ++ ", got names: " + let names = + concatMap (rights . M.keys . nodeIdentifiers) $ + M.elems $ getSourcedNodeInfo $ + sourcedNodeInfo $ selectPoint' hf point + forM_ names $ \name -> do + putStrLn (render df (nameSrcSpan name, name)) ===================================== testsuite/tests/hiefile/should_run/HieVdq.stdout ===================================== @@ -1,2 +1,3 @@ -At (11,13), got type: a -At (11,28), got type: a +At (13,9), got names: (HieVdq.hs:13:9, t) +At (13,18), got names: (HieVdq.hs:13:9, t) +At (13,34), got names: (HieVdq.hs:13:9, t) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9c864383ba7afa3f956ea9a17b674a33765ddeb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9c864383ba7afa3f956ea9a17b674a33765ddeb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 01:07:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 21:07:02 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 2 commits: Bump containers submodule Message-ID: <64b888b6c45b2_3a4b0fb74585917cc@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 6200e8fa by Ben Gamari at 2023-07-19T21:06:46-04:00 Bump containers submodule - - - - - 8b95c0e8 by Ben Gamari at 2023-07-19T21:06:46-04:00 users guide: Fix release notes and other documentation issues - - - - - 5 changed files: - − docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/ghc_config.py.in - libraries/containers Changes: ===================================== docs/users_guide/9.6.1-notes.rst deleted ===================================== @@ -1,264 +0,0 @@ -.. _release-9-6-1: - -Version 9.6.1 -============== - -Language -~~~~~~~~ - -- GHC is now more conservative when solving constraints that arise from - superclass expansion in terms of other constraints that also arise from - superclass expansion. - - For example: :: - - class C a - class C a => D a b - instance D a a => D a b - - When typechecking the instance, we need to also solve the constraints arising - from the superclasses of ``D``; in this case, we need ``C a``. We could obtain - evidence for this constraint by expanding the superclasses of the context, - as ``D a a`` also has a superclass context of ``C a``. - However, is it unsound to do so in general, as we might be assuming precisely - the predicate we want to prove! This can lead to programs that loop at runtime. - - When such potentially-loopy situations arise, GHC now emits a warning. - In future releases, this behaviour will no longer be supported, and the - typechecker will outright refuse to solve these constraints, emitting a - ``Could not deduce`` error. - - In practice, you should be able to fix these issues by adding the necessary - constraint to the context, e.g. for the above example: :: - - instance (C a, D a a) => D a b - -- Record updates for GADTs and other existential datatypes are now - fully supported. - - For example: :: - - data D b where - MkD :: { fld1 :: a -> a, fld2 :: a -> (), fld3 :: b } -> D b - - foo :: D b -> D b - foo d = d { fld1 = id, fld2 = const () } - - In this example, we have an existential variable ``a``, and we update - all fields whose type involves ``a`` at once, so the update is valid. - - A side-effect of this change is that GHC now rejects some record updates - involving fields whose types contain type families (these record updates - were previously erroneously accepted). - - Example: :: - - type family F a where - F Int = Char - F Float = Char - - data T b = MkT { x :: [Int], y :: [F b] } - - emptyT :: forall b. T b - emptyT = MkT [] [] - - bar :: T Int - bar = emptyT { x = [3] } - - In this example, we can't infer the type of ``emptyT`` in ``bar``: it could be - ``T Int``, but it could also be ``T Float`` because the type family ``F`` - is not injective and ``T Float ~ T Int``. Indeed, the following typechecks :: - - baz :: T Int - baz = case ( emptyT :: T Float ) of { MkT _ y -> MkT [3] y } - - This means that the type of ``emptyT`` is ambiguous in the definition - of ``bar`` above, and thus GHC rejects the record update: :: - - Couldn't match type `F b0' with `Char' - Expected: [F Int] - Actual: [F b0] - NB: ‘F’ is a non-injective type family - The type variable ‘b0’ is ambiguous - - To fix these issues, add a type signature to the expression that the - record update is applied to (``emptyT`` in the example above), or - add an injectivity annotation to the type family in the case that - the type family is in fact injective. - -- Error messages are now assigned unique error codes, of the form ``[GHC-12345]``. - -- GHC Proposal `#106 - `_ - has been implemented, introducing a new language extension - :extension:`TypeData`. This extension permits ``type data`` declarations - as a more fine-grained alternative to :extension:`DataKinds`. - -- GHC now does a better job of solving constraints in the presence of multiple - matching quantified constraints. For example, if we want to solve - ``C a b Int`` and we have matching quantified constraints: :: - - forall x y z. (Ord x, Enum y, Num z) => C x y z - forall u v. (Enum v, Eq u) => C u v Int - - Then GHC will use the second quantified constraint to solve ``C a b Int``, - as it has a strictly weaker precondition. - -- GHC proposal `#170 Unrestricted OverloadedLabels - `_ - has been implemented. - This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. - Examples of newly allowed syntax: - - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` - -Compiler -~~~~~~~~ - -- The `WebAssembly backend - `_ - has been merged. This allows GHC to be built as a cross-compiler - that targets ``wasm32-wasi`` and compiles Haskell code to - self-contained WebAssembly modules that can be executed on a variety - of different runtimes. There are a few caveats to be aware of: - - - To use the WebAssembly backend, one would need to follow the - instructions on `ghc-wasm-meta - `_. The WebAssembly - backend is not included in the GHC release bindists for the time - being, nor is it supported by ``ghcup`` or ``stack`` yet. - - The WebAssembly backend is still under active development. It's - presented in this GHC version as a technology preview, bugs and - missing features are expected. - -- The JavaScript backend has been merged. GHC is now able to be built as a - cross-compiler targeting the JavaScript platform. The backend should be - considered a technology preview. As such it is not ready for use in - production, is not distributed in the GHC release bindists and requires the - user to manually build GHC as a cross-compiler. See the JavaScript backend - `wiki `_ page - on the GHC wiki for the current status, project roadmap, build instructions - and demos. - -- The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included - in :extension:`PolyKinds` and :extension:`DataKinds`. - -- The :ghc-flag:`-Woperator-whitespace` warning no longer ignores constructor symbols - (operators starting with ``:``). - -- The :ghc-flag:`-Wstar-is-type` warning is now enabled by default. - -GHCi -~~~~ - -- GHCi will now accept any file-header pragmas it finds, such as - ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, - instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, - you could instead write: - - .. code-block:: none - - ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} - -This can be convenient when pasting large multi-line blocks of code into GHCi. - -Runtime system -~~~~~~~~~~~~~~ - -- The `Delimited continuation primops `_ - proposal has been implemented, adding native support for first-class, - delimited continuations to the RTS. For the reasons given in the proposal, - no safe API to access this functionality is provided anywhere in ``base``. - Instead, the ``prompt#`` and ``control0#`` primops are intended to be consumed - by library authors directly, who may wrap them a safe API that maintains the - necessary invariants. See the documentation in ``GHC.Prim`` for more details. - -- The behaviour of the ``-M`` flag has been made more strict. It will now trigger - a heap overflow if the total amount of memory used by the Haskell heap exceeds the limit. - Previously only live blocks were taken into account. - This makes it more likely to trigger promptly when the heap is highly fragmented. - -- Fixed a bug that sometimes caused live sparks to be GC'ed too early either during - minor GC or major GC with workstealing disabled. See #22528. - - -``base`` library -~~~~~~~~~~~~~~~~ - -- Exceptions thrown by weak pointer finalizers can now be reported by setting - a global exception handler, using ``GHC.Weak.Finalize.setFinalizerExceptionHandler``. - The default behaviour is unchanged (exceptions are ignored and not reported). - -- GHC now provides a set of operations for introspecting on the threads of a - program, ``GHC.Conc.listThreads``, as well as operations for querying a thread's - label (:base-ref:`GHC.Conc.Sync.threadLabel`) and status - (:base-ref:`GHC.Conc.threadStatus`). - -- Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use - ``(<=)`` instead of ``compare`` per CLC proposal: - https://github.com/haskell/core-libraries-committee/issues/24 - -- Updated to `Unicode 15.0.0 `_. - -- Add standard Unicode case predicates :base-ref:`Data.Char.isUpperCase` and - :base-ref:`Data.Char.isLowerCase`. These predicates use the standard Unicode - case properties and are more intuitive than :base-ref:`Data.Char.isUpper` and - :base-ref:`Data.Char.isLower`. - -``ghc-prim`` library -~~~~~~~~~~~~~~~~~~~~ - -``ghc`` library -~~~~~~~~~~~~~~~ - -- Add `Foreign.C.Types.ConstPtr` was added to encode ``const``-qualified pointer return - types in foreign declarations when using ``CApiFFI`` extension. - -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ - - -Included libraries ------------------- - -The package database provided with this distribution also contains a number of -packages other than GHC itself. See the changelogs provided with these packages -for further change information. - -.. ghc-package-list:: - - libraries/array/array.cabal: Dependency of ``ghc`` library - libraries/base/base.cabal: Core library - libraries/binary/binary.cabal: Dependency of ``ghc`` library - libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library - libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility - libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility - libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library - libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library - libraries/directory/directory.cabal: Dependency of ``ghc`` library - libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library - libraries/filepath/filepath.cabal: Dependency of ``ghc`` library - compiler/ghc.cabal: The compiler itself - libraries/ghci/ghci.cabal: The REPL interface - libraries/ghc-boot/ghc-boot.cabal: Internal compiler library - libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library - libraries/ghc-compact/ghc-compact.cabal: Core library - libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library - libraries/ghc-prim/ghc-prim.cabal: Core library - libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable - libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable - libraries/integer-gmp/integer-gmp.cabal: Core library - libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library - libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library - libraries/pretty/pretty.cabal: Dependency of ``ghc`` library - libraries/process/process.cabal: Dependency of ``ghc`` library - libraries/stm/stm.cabal: Dependency of ``haskeline`` library - libraries/template-haskell/template-haskell.cabal: Core library - libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library - libraries/text/text.cabal: Dependency of ``Cabal`` library - libraries/time/time.cabal: Dependency of ``ghc`` library - libraries/transformers/transformers.cabal: Dependency of ``ghc`` library - libraries/unix/unix.cabal: Dependency of ``ghc`` library - libraries/Win32/Win32.cabal: Dependency of ``ghc`` library - libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -3,21 +3,16 @@ Version 9.8.1 ============= -Language -~~~~~~~~ - -- There is a new extension :extension:`ExtendedLiterals`, which enables - sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. - See the GHC proposal `#451 `_. +The significant changes to the various parts of the compiler are listed in the +following sections. See the `migration guide +`_ on the GHC Wiki +for specific guidance on migrating programs to this release. -- GHC Proposal `#425 - `_ - has been partially implemented. Namely, the ``@k``-binders in type declarations are now permitted:: - - type T :: forall k. k -> forall j. j -> Type - data T @k (a :: k) @(j :: Type) (b :: j) +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +11, 12, 13, 14 or 15. - This feature is guarded behind :extension:`TypeAbstractions`. +Breaking changes +~~~~~~~~~~~~~~~~ - In accordance with GHC proposal `#425 `_ @@ -35,6 +30,49 @@ Language type instance forall j . F1 Int = Any :: j -> j +- Data types with ``deriving`` clauses now reject inferred instance contexts + that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as + this one: :: + + newtype Foo = Foo Int + + class Bar a where + bar :: a + + instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined + + newtype Baz = Baz Foo + deriving Bar + + Here, the derived ``Bar`` instance for ``Baz`` would look like this: :: + + instance TypeError (Text "Boo") => Bar Baz + + While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``" + in the resulting error message. If you really want to derive this instance and + defer the error to sites where the instance is used, you must do so manually + with :extension:`StandaloneDeriving`, e.g. :: + + deriving instance TypeError (Text "Boo") => Bar Baz + + +Language +~~~~~~~~ + +- There is a new extension :extension:`ExtendedLiterals`, which enables + sized primitive numeric literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. + See the GHC proposal `#451 `_. + +- GHC Proposal `#425 + `_ + has been partially implemented. Namely, the ``@k``-binders in type declarations are now permitted:: + + type T :: forall k. k -> forall j. j -> Type + data T @k (a :: k) @(j :: Type) (b :: j) + + This feature is guarded behind :extension:`TypeAbstractions`. + Compiler ~~~~~~~~ @@ -58,9 +96,9 @@ Compiler - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking - the specification described in the documentation of the `INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. + the specification described in the documentation of the :pragma:`INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. -- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. +- Fix a bug in TemplateHaskell evaluation causing excessive calls to ``setNumCapabilities`` when :ghc-flag:`-j[⟨n⟩]` is greater than :rts-flag:`-N`. See :ghc-ticket:`23049`. - The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are @@ -86,45 +124,21 @@ Compiler blah x = x { foo = 5, bar = 6 } - The point is that only the type S has a constructor with both fields "foo" - and "bar", so this record update is unambiguous. - -- Data types with ``deriving`` clauses now reject inferred instance contexts - that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as - this one: :: - - newtype Foo = Foo Int - - class Bar a where - bar :: a - - instance (TypeError (Text "Boo")) => Bar Foo where - bar = undefined - - newtype Baz = Baz Foo - deriving Bar - - Here, the derived ``Bar`` instance for ``Baz`` would look like this: :: - - instance TypeError (Text "Boo") => Bar Baz + The point is that only the type S has a constructor with both fields ``foo`` + and ``bar``, so this record update is unambiguous. - While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``" - in the resulting error message. If you really want to derive this instance and - defer the error to sites where the instance is used, you must do so manually - with :extension:`StandaloneDeriving`, e.g. :: - - deriving instance TypeError (Text "Boo") => Bar Baz - -- GHC Proposal `#540 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0540-jsem.rst`_ has been implemented. - This adds the `-jsem`:ghc-flag: flag, which instructs GHC to act as a jobserver client. +- GHC Proposal `#540 `_ has been implemented. + This adds the :ghc-flag:`-jsem` flag, which instructs GHC to act as a jobserver client. This enables multiple GHC processes running at once to share system resources with each other, communicating via the system semaphore specified by the flag argument. + Complementary support for this feature in ``cabal-install`` will come soon. + - GHC Proposal `#433 `_ has been implemented. This adds the class ``Unsatisfiable :: ErrorMessage -> Constraint`` - to the ``GHC.TypeError`` module. Constraints of the form ``Unsatisfiable msg`` + to the :base-ref:`GHC.TypeError` module. Constraints of the form ``Unsatisfiable msg`` provide a mechanism for custom type errors that reports the errors in a more predictable behaviour than ``TypeError``, as these constraints are handled purely during constraint solving. @@ -137,27 +151,31 @@ Compiler This allows errors to be reported when users use the instance, even when type errors are being deferred. -- GHC is now deals "insoluble Givens" in a consistent way. For example: :: +- GHC now deals with "insoluble Givens" in a consistent way. For example: :: k :: (Int ~ Bool) => Int -> Bool k x = x - GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. + GHC used to accept the contradictory ``Int~Bool`` in the type signature, but + reject the ``Int~Bool`` constraint that arises from typechecking the + definition itself. Now it accepts both. More details in + :ghc-ticket:`23413`, which gives examples of the previous inconsistency. GHC + now implements the "PermissivePlan" described in that ticket. -- The `-ddump-spec` flag has been split into `-ddump-spec` and - `-ddump-spec-constr`, allowing only output from the typeclass specialiser or - `SpecConstr` to be seen if desired. +- The :ghc-flag:`-ddump-spec` flag has been split into :ghc-flag:`-ddump-spec` and + :ghc-flag:`-ddump-spec-constr`, allowing only output from the typeclass specialiser or + data-constructor specialiser to be dumped if desired. - The compiler may now be configured to compress the debugging information included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must build GHC from source (see - `here` for directions) + `here `_ for directions) and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` script. **Note**: This feature requires that the machine building GHC has `libzstd `_ version 1.4.0 or greater installed. The compression library `libzstd` may optionally be statically linked in the resulting compiler (on non-darwin machines) using the - `--enable-static-libzstd` configure flag. + ``--enable-static-libzstd`` configure flag. In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. @@ -169,11 +187,11 @@ Compiler For example :: - module X ( - {-# WARNING "do not use that constructor" D(D1), - D(D2) - ) - D = D1 | D2 + module X + ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-} + D(D1, D2) + ) where + data D = D1 | D2 This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface @@ -182,7 +200,10 @@ Compiler GHCi ~~~~ -- The deprecated `:ctags` and `:etags` GHCi commands have been removed. See this `wiki page `_ if you want to add a macro to recover similar functionality. +- The deprecated ``:ctags`` and ``:etags`` GHCi commands have been removed. See + this `wiki page + `_ if you + want to add a macro to recover similar functionality. Runtime system ~~~~~~~~~~~~~~ @@ -193,7 +214,7 @@ Runtime system ``base`` library ~~~~~~~~~~~~~~~~ -- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. +- :base-ref:`Data.Tuple` now exports ``getSolo :: Solo a -> a``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ @@ -211,7 +232,7 @@ Runtime system - New primops for fused multiply-add operations. These primops combine a multiplication and an addition, compiling to a single instruction when - the ``-mfma`` flag is enabled and the architecture supports it. + the :ghc-flag:`-mfma` flag is enabled and the architecture supports it. The new primops are ``fmaddFloat#, fmsubFloat#, fnmaddFloat#, fnmsubFloat# :: Float# -> Float# -> Float# -> Float#`` and ``fmaddDouble#, fmsubDouble#, fnmaddDouble#, fnmsubDouble# :: Double# -> Double# -> Double# -> Double#``. @@ -243,21 +264,18 @@ Runtime system - The extensions fields of constructors of ``IE`` now take ``Maybe (WarningTxt p)`` in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. This represents the warning assigned to a certain export item, - which is used for :ref:`deprecated-exports`. - -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ + which is used for :pragma:`deprecated exports `. ``template-haskell`` library ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Record fields now belong to separate ``NameSpace``s, keyed by the parent of +- Record fields now belong to separate ``NameSpace``\ s, keyed by the parent of the record field. This is the name of the first constructor of the parent type, even if this constructor does not have the field in question. - This change enables TemplateHaskell support for ``DuplicateRecordFields``. + This change enables :extension:`TemplateHaskell` support for :extension:`DuplicateRecordFields`. Included libraries ------------------- +~~~~~~~~~~~~~~~~~~ The package database provided with this distribution also contains a number of packages other than GHC itself. See the changelogs provided with these packages @@ -290,6 +308,7 @@ for further change information. libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library libraries/pretty/pretty.cabal: Dependency of ``ghc`` library libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/semaphore-compat/semaphore-compat.cabal: Dependency of ``ghc`` library libraries/stm/stm.cabal: Dependency of ``haskeline`` library libraries/template-haskell/template-haskell.cabal: Core library libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library ===================================== docs/users_guide/exts/implicit_parameters.rst ===================================== @@ -181,7 +181,7 @@ Adding a type signature dramatically changes the result! This is a rather counter-intuitive phenomenon, worth watching out for. Implicit parameters scoping guarantees -------------------------------------- +-------------------------------------- GHC always takes the most nested implicit parameter binding from the context to find the value. Consider the following code:: ===================================== docs/users_guide/ghc_config.py.in ===================================== @@ -1,6 +1,6 @@ extlinks = { - 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '%s'), - 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '#%s'), + 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#%s'), + 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '%s'), } libs_base_uri = '../libraries' ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 8663795322622ac77cc78566185bffbc84e299f2 +Subproject commit f61b0c9104a3c436361f56a0974c5eeef40c1b89 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/846ecee9b9663a51868ec0d232b77c6e3faf235c...8b95c0e822c39bec2153289d6e17ab24d024df0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/846ecee9b9663a51868ec0d232b77c6e3faf235c...8b95c0e822c39bec2153289d6e17ab24d024df0d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 01:26:02 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 21:26:02 -0400 Subject: [Git][ghc/ghc][wip/ghc-internals-2] 2 commits: ghc-internals: Initial commit of the skeleton Message-ID: <64b88d2acb077_3a4b0fb74085946ce@gitlab.mail> Ben Gamari pushed to branch wip/ghc-internals-2 at Glasgow Haskell Compiler / GHC Commits: 12b230b5 by Ben Gamari at 2023-07-19T21:25:52-04:00 ghc-internals: Initial commit of the skeleton - - - - - aa77de4c by Ben Gamari at 2023-07-19T21:25:53-04:00 ghc-experimental: Initial commit - - - - - 11 changed files: - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/base/base.cabal - + libraries/ghc-experimental/CHANGELOG.md - + libraries/ghc-experimental/LICENSE - + libraries/ghc-experimental/ghc-experimental.cabal - + libraries/ghc-experimental/src/Dummy.hs - + libraries/ghc-internals/CHANGELOG.md - + libraries/ghc-internals/LICENSE - + libraries/ghc-internals/ghc-internals.cabal - + libraries/ghc-internals/src/Dummy.hs Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -5,7 +5,8 @@ module Packages ( checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, + ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals, + ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, @@ -37,7 +38,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs + , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals + , ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml @@ -53,7 +55,8 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals, + ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -87,7 +90,9 @@ ghcBootTh = lib "ghc-boot-th" ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" +ghcExperimental = lib "ghc-experimental" ghcHeap = lib "ghc-heap" +ghcInternals = lib "ghc-internals" ghci = lib "ghci" ghciWrapper = prg "ghci-wrapper" `setPath` "driver/ghci" -- See Note [Hadrian's ghci-wrapper package] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -135,6 +135,8 @@ stage1Packages = do , ghc , ghcBignum , ghcCompact + , ghcExperimental + , ghcInternals , ghcPkg , ghcPrim , haskeline ===================================== libraries/base/base.cabal ===================================== @@ -87,6 +87,7 @@ Library build-depends: rts == 1.0.*, ghc-prim >= 0.5.1.0 && < 0.11, + ghc-internals >= 0.1 && < 0.2, ghc-bignum >= 1.0 && < 2.0 exposed-modules: ===================================== libraries/ghc-experimental/CHANGELOG.md ===================================== @@ -0,0 +1,5 @@ +# Revision history for ghc-experimental + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. ===================================== libraries/ghc-experimental/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, ghc-devs at haskell.org + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of ghc-devs at haskell.org nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-experimental/ghc-experimental.cabal ===================================== @@ -0,0 +1,31 @@ +cabal-version: 3.0 +name: ghc-experimental +version: 0.1.0.0 +synopsis: Experimental features of GHC's standard library +description: + This package is where experimental GHC standard library interfaces start + life as they mature. Eventually, stabilized interfaces will be + migrated into the @base@ library. + +homepage: https://www.haskell.org/ghc/ +license: BSD-3-Clause +license-file: LICENSE +author: The GHC Team +maintainer: ghc-devs at haskell.org +copyright: (c) 2023 The GHC Team +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: + other-modules: Dummy + other-extensions: + build-depends: base ^>=4.18, + ghc-internals >= 0.1 && < 0.2 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-experimental/src/Dummy.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This module merely serves as a placeholder since +-- Haskell packages must contain at least one module. +-- This can be dropped once a real module has been introduced to +-- @ghc-experimental at . +module Dummy () where + +-- for build system ordering +import GHC.Base () ===================================== libraries/ghc-internals/CHANGELOG.md ===================================== @@ -0,0 +1,5 @@ +# Revision history for ghc-internals + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. ===================================== libraries/ghc-internals/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Ben Gamari + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ben Gamari nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-internals/ghc-internals.cabal ===================================== @@ -0,0 +1,33 @@ +cabal-version: 3.0 +name: ghc-internals +version: 0.1.0.0 +synopsis: + Internal implementation of the Glasgow Haskell Compiler's standard library +description: + This is an internal package containing the implementation of the Glasgow + Haskell Compiler's standard library. End users should not depend upon this + package directly but rather use either @base@ or the @ghc-experimental@ + packages. +homepage: https://www.haskell.org/ghc/ +license: BSD-3-Clause +license-file: LICENSE +author: The GHC Team +maintainer: ghc-devs at haskell.org +copyright: (c) 2023 The GHC Team +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: + other-modules: Dummy + other-extensions: + build-depends: rts == 1.0.*, + ghc-prim >= 0.5.1.0 && < 0.11, + ghc-bignum >= 1.0 && < 2.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-internals/src/Dummy.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This module merely serves as a placeholder since +-- Haskell packages must contain at least one module. +-- This can be dropped once a real module has been introduced to +-- @ghc-internals at . +module Dummy () where + +-- for build system dependency ordering +import GHC.Types () +import GHC.Num.BigNat () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a7d7ff7f7ecd452dd7ef77193f480287e1d385d...aa77de4cde6943a8a234167b8d79973a5c8d2671 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a7d7ff7f7ecd452dd7ef77193f480287e1d385d...aa77de4cde6943a8a234167b8d79973a5c8d2671 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 01:51:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 21:51:24 -0400 Subject: [Git][ghc/ghc][wip/ghc-internals-2] 2 commits: ghc-internals: Initial commit of the skeleton Message-ID: <64b8931c4448d_3a4b0fb746c5988d4@gitlab.mail> Ben Gamari pushed to branch wip/ghc-internals-2 at Glasgow Haskell Compiler / GHC Commits: 0d51b728 by Ben Gamari at 2023-07-19T21:50:21-04:00 ghc-internals: Initial commit of the skeleton - - - - - 908036b3 by Ben Gamari at 2023-07-19T21:51:09-04:00 ghc-experimental: Initial commit - - - - - 13 changed files: - .gitlab-ci.yml - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/base/base.cabal - + libraries/ghc-experimental/CHANGELOG.md - + libraries/ghc-experimental/LICENSE - + libraries/ghc-experimental/ghc-experimental.cabal - + libraries/ghc-experimental/src/Dummy.hs - + libraries/ghc-internals/CHANGELOG.md - + libraries/ghc-internals/LICENSE - + libraries/ghc-internals/ghc-internals.cabal - + libraries/ghc-internals/src/Dummy.hs - testsuite/tests/interface-stability/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -339,6 +339,8 @@ lint-submods-branch: script: - .gitlab/ci.sh setup - .gitlab/ci.sh configure + - .gitlab/ci.sh run_hadrian lint:ghc-internals + - .gitlab/ci.sh run_hadrian lint:ghc-experimental - .gitlab/ci.sh run_hadrian lint:base - .gitlab/ci.sh run_hadrian lint:compiler ===================================== hadrian/src/Packages.hs ===================================== @@ -5,7 +5,8 @@ module Packages ( checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, + ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals, + ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, @@ -37,7 +38,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs + , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals + , ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml @@ -53,7 +55,8 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals, + ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -87,7 +90,9 @@ ghcBootTh = lib "ghc-boot-th" ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" +ghcExperimental = lib "ghc-experimental" ghcHeap = lib "ghc-heap" +ghcInternals = lib "ghc-internals" ghci = lib "ghci" ghciWrapper = prg "ghci-wrapper" `setPath` "driver/ghci" -- See Note [Hadrian's ghci-wrapper package] ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -135,6 +135,8 @@ stage1Packages = do , ghc , ghcBignum , ghcCompact + , ghcExperimental + , ghcInternals , ghcPkg , ghcPrim , haskeline ===================================== libraries/base/base.cabal ===================================== @@ -87,6 +87,7 @@ Library build-depends: rts == 1.0.*, ghc-prim >= 0.5.1.0 && < 0.11, + ghc-internals >= 0.1 && < 0.2, ghc-bignum >= 1.0 && < 2.0 exposed-modules: ===================================== libraries/ghc-experimental/CHANGELOG.md ===================================== @@ -0,0 +1,5 @@ +# Revision history for ghc-experimental + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. ===================================== libraries/ghc-experimental/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, ghc-devs at haskell.org + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of ghc-devs at haskell.org nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-experimental/ghc-experimental.cabal ===================================== @@ -0,0 +1,31 @@ +cabal-version: 3.0 +name: ghc-experimental +version: 0.1.0.0 +synopsis: Experimental features of GHC's standard library +description: + This package is where experimental GHC standard library interfaces start + life as they mature. Eventually, stabilized interfaces will be + migrated into the @base@ library. + +homepage: https://www.haskell.org/ghc/ +license: BSD-3-Clause +license-file: LICENSE +author: The GHC Team +maintainer: ghc-devs at haskell.org +copyright: (c) 2023 The GHC Team +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: + other-modules: Dummy + other-extensions: + build-depends: base ^>=4.18, + ghc-internals >= 0.1 && < 0.2 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-experimental/src/Dummy.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This module merely serves as a placeholder since +-- Haskell packages must contain at least one module. +-- This can be dropped once a real module has been introduced to +-- @ghc-experimental at . +module Dummy () where + +-- for build system ordering +import GHC.Base () ===================================== libraries/ghc-internals/CHANGELOG.md ===================================== @@ -0,0 +1,5 @@ +# Revision history for ghc-internals + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. ===================================== libraries/ghc-internals/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Ben Gamari + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ben Gamari nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-internals/ghc-internals.cabal ===================================== @@ -0,0 +1,33 @@ +cabal-version: 3.0 +name: ghc-internals +version: 0.1.0.0 +synopsis: + Internal implementation of the Glasgow Haskell Compiler's standard library +description: + This is an internal package containing the implementation of the Glasgow + Haskell Compiler's standard library. End users should not depend upon this + package directly but rather use either @base@ or the @ghc-experimental@ + packages. +homepage: https://www.haskell.org/ghc/ +license: BSD-3-Clause +license-file: LICENSE +author: The GHC Team +maintainer: ghc-devs at haskell.org +copyright: (c) 2023 The GHC Team +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: + other-modules: Dummy + other-extensions: + build-depends: rts == 1.0.*, + ghc-prim >= 0.5.1.0 && < 0.11, + ghc-bignum >= 1.0 && < 2.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-internals/src/Dummy.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This module merely serves as a placeholder since +-- Haskell packages must contain at least one module. +-- This can be dropped once a real module has been introduced to +-- @ghc-internals at . +module Dummy () where + +-- for build system dependency ordering +import GHC.Types () +import GHC.Num.BigNat () ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -5,3 +5,4 @@ def check_package(pkg_name): [f'exports_{pkg_name}']) check_package('base') +check_package('ghc-experimental') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa77de4cde6943a8a234167b8d79973a5c8d2671...908036b3f752bb46f9b54fcbc0f723b24489b611 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa77de4cde6943a8a234167b8d79973a5c8d2671...908036b3f752bb46f9b54fcbc0f723b24489b611 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 02:13:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 22:13:20 -0400 Subject: [Git][ghc/ghc][wip/ghc-internals-2] ghc-experimental: Initial commit Message-ID: <64b89840bce1c_3a4b0fb74805994c@gitlab.mail> Ben Gamari pushed to branch wip/ghc-internals-2 at Glasgow Haskell Compiler / GHC Commits: 71c11f05 by Ben Gamari at 2023-07-19T22:13:13-04:00 ghc-experimental: Initial commit - - - - - 9 changed files: - .gitlab-ci.yml - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - + libraries/ghc-experimental/CHANGELOG.md - + libraries/ghc-experimental/LICENSE - + libraries/ghc-experimental/ghc-experimental.cabal - + libraries/ghc-experimental/src/Dummy.hs - testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/ghc-experimental-exports.stdout Changes: ===================================== .gitlab-ci.yml ===================================== @@ -340,6 +340,7 @@ lint-submods-branch: - .gitlab/ci.sh setup - .gitlab/ci.sh configure - .gitlab/ci.sh run_hadrian lint:ghc-internals + - .gitlab/ci.sh run_hadrian lint:ghc-experimental - .gitlab/ci.sh run_hadrian lint:base - .gitlab/ci.sh run_hadrian lint:compiler ===================================== hadrian/src/Packages.hs ===================================== @@ -5,7 +5,8 @@ module Packages ( checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghcInternals, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, + ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals, + ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, @@ -37,7 +38,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform - , ghcCompact, ghcConfig, ghcHeap, ghcInternals, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs + , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals + , ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml @@ -53,7 +55,8 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, - ghcCompact, ghcConfig, ghcHeap, ghcInternals, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternals, + ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -87,6 +90,7 @@ ghcBootTh = lib "ghc-boot-th" ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" +ghcExperimental = lib "ghc-experimental" ghcHeap = lib "ghc-heap" ghcInternals = lib "ghc-internals" ghci = lib "ghci" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -135,6 +135,7 @@ stage1Packages = do , ghc , ghcBignum , ghcCompact + , ghcExperimental , ghcInternals , ghcPkg , ghcPrim ===================================== libraries/ghc-experimental/CHANGELOG.md ===================================== @@ -0,0 +1,5 @@ +# Revision history for ghc-experimental + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. ===================================== libraries/ghc-experimental/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, ghc-devs at haskell.org + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of ghc-devs at haskell.org nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-experimental/ghc-experimental.cabal ===================================== @@ -0,0 +1,31 @@ +cabal-version: 3.0 +name: ghc-experimental +version: 0.1.0.0 +synopsis: Experimental features of GHC's standard library +description: + This package is where experimental GHC standard library interfaces start + life as they mature. Eventually, stabilized interfaces will be + migrated into the @base@ library. + +homepage: https://www.haskell.org/ghc/ +license: BSD-3-Clause +license-file: LICENSE +author: The GHC Team +maintainer: ghc-devs at haskell.org +copyright: (c) 2023 The GHC Team +category: Development +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: + other-modules: Dummy + other-extensions: + build-depends: base ^>=4.18, + ghc-internals >= 0.1 && < 0.2 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-experimental/src/Dummy.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | This module merely serves as a placeholder since +-- Haskell packages must contain at least one module. +-- This can be dropped once a real module has been introduced to +-- @ghc-experimental at . +module Dummy () where + +-- for build system ordering +import GHC.Base () ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -5,3 +5,4 @@ def check_package(pkg_name): [f'exports_{pkg_name}']) check_package('base') +check_package('ghc-experimental') ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -0,0 +1,3 @@ + + +-- Instances: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71c11f058ae57701fea53bab921da748193aafd0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/71c11f058ae57701fea53bab921da748193aafd0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 02:29:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 22:29:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/unzip-deprecation Message-ID: <64b89c26be12_3a4b0f2ddcfd70602026@gitlab.mail> Ben Gamari pushed new branch wip/unzip-deprecation at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/unzip-deprecation You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 02:30:37 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 22:30:37 -0400 Subject: [Git][ghc/ghc][wip/unzip-deprecation] base: Push back deprecation of Data.List.NonEmpty.unzip Message-ID: <64b89c4d9cdca_3a4b0fb7480605686@gitlab.mail> Ben Gamari pushed to branch wip/unzip-deprecation at Glasgow Haskell Compiler / GHC Commits: 2ac39111 by Ben Gamari at 2023-07-19T22:30:33-04:00 base: Push back deprecation of Data.List.NonEmpty.unzip As noted in #23640, !10189 didn't quite make GHC 9.8 and therefore will need to be pushed back by a release. - - - - - 2 changed files: - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md Changes: ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,7 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) -{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.23, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.20.0.0 *TBA* + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) + ## 4.19.0.0 *TBA* * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`. Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. @@ -34,7 +37,6 @@ * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) * Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8)) - * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ac39111a5007932ea71fd4c66a6806c5721e1bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ac39111a5007932ea71fd4c66a6806c5721e1bd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 02:42:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 22:42:46 -0400 Subject: [Git][ghc/ghc][wip/T22011] 48 commits: Hadrian: enable GHCi support on riscv64 Message-ID: <64b89f26c1401_3a4b0fb74586151d8@gitlab.mail> Ben Gamari pushed to branch wip/T22011 at Glasgow Haskell Compiler / GHC Commits: dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - c28f3074 by Ben Gamari at 2023-07-19T22:42:24-04:00 rts: Add generator for RtsSymbols from libgcc - - - - - 28 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c695151212668d5ff3914f7575f23af05e4dcd32...c28f307436526ff8bb1d8440251a8491324919c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c695151212668d5ff3914f7575f23af05e4dcd32...c28f307436526ff8bb1d8440251a8491324919c9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 02:43:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 22:43:44 -0400 Subject: [Git][ghc/ghc][wip/T22012] rts/RtsSymbols: Add AArch64 outline atomic operations Message-ID: <64b89f60ca6f2_3a4b0fb73cc6157e8@gitlab.mail> Ben Gamari pushed to branch wip/T22012 at Glasgow Haskell Compiler / GHC Commits: 1ca2f799 by Ben Gamari at 2023-07-19T22:43:35-04:00 rts/RtsSymbols: Add AArch64 outline atomic operations Fixes #22012 by adding the symbols described in https://github.com/llvm/llvm-project/blob/main/llvm/docs/Atomics.rst#libcalls-atomic. Ultimately this would be better addressed by #22011, but this is a first step in the right direction and fixes the immediate symptom. Generated via: ```python def main() -> None: ops = set() ORDERINGS = [ 'relax', 'acq', 'rel', 'acq_rel', 'sync' ] for order in ORDERINGS: for n in [1,2,4,8]: for op in ['swp', 'ldadd', 'ldclr', 'ldeor', 'ldset']: ops.add(f'__aarch64_{op}{n}_{order}') for n in [1,2,4,8,16]: ops.add(f'__aarch64_cas{n}_{order}') lines = [ "#define RTS_AARCH64_SYMBOLS" ] lines += [ f' SymE_NeedsProto({op})' for op in sorted(ops) ] print(' \\\n'.join(lines)) main() ``` - - - - - 2 changed files: - + rts/AArch64Symbols.h - rts/RtsSymbols.c Changes: ===================================== rts/AArch64Symbols.h ===================================== @@ -0,0 +1,126 @@ +#define RTS_AARCH64_SYMBOLS \ + SymE_HasProto(__aarch64_cas16_acq) \ + SymE_HasProto(__aarch64_cas16_acq_rel) \ + SymE_HasProto(__aarch64_cas16_rel) \ + SymE_HasProto(__aarch64_cas16_relax) \ + SymE_HasProto(__aarch64_cas16_sync) \ + SymE_HasProto(__aarch64_cas1_acq) \ + SymE_HasProto(__aarch64_cas1_acq_rel) \ + SymE_HasProto(__aarch64_cas1_rel) \ + SymE_HasProto(__aarch64_cas1_relax) \ + SymE_HasProto(__aarch64_cas1_sync) \ + SymE_HasProto(__aarch64_cas2_acq) \ + SymE_HasProto(__aarch64_cas2_acq_rel) \ + SymE_HasProto(__aarch64_cas2_rel) \ + SymE_HasProto(__aarch64_cas2_relax) \ + SymE_HasProto(__aarch64_cas2_sync) \ + SymE_HasProto(__aarch64_cas4_acq) \ + SymE_HasProto(__aarch64_cas4_acq_rel) \ + SymE_HasProto(__aarch64_cas4_rel) \ + SymE_HasProto(__aarch64_cas4_relax) \ + SymE_HasProto(__aarch64_cas4_sync) \ + SymE_HasProto(__aarch64_cas8_acq) \ + SymE_HasProto(__aarch64_cas8_acq_rel) \ + SymE_HasProto(__aarch64_cas8_rel) \ + SymE_HasProto(__aarch64_cas8_relax) \ + SymE_HasProto(__aarch64_cas8_sync) \ + SymE_HasProto(__aarch64_ldadd1_acq) \ + SymE_HasProto(__aarch64_ldadd1_acq_rel) \ + SymE_HasProto(__aarch64_ldadd1_rel) \ + SymE_HasProto(__aarch64_ldadd1_relax) \ + SymE_HasProto(__aarch64_ldadd1_sync) \ + SymE_HasProto(__aarch64_ldadd2_acq) \ + SymE_HasProto(__aarch64_ldadd2_acq_rel) \ + SymE_HasProto(__aarch64_ldadd2_rel) \ + SymE_HasProto(__aarch64_ldadd2_relax) \ + SymE_HasProto(__aarch64_ldadd2_sync) \ + SymE_HasProto(__aarch64_ldadd4_acq) \ + SymE_HasProto(__aarch64_ldadd4_acq_rel) \ + SymE_HasProto(__aarch64_ldadd4_rel) \ + SymE_HasProto(__aarch64_ldadd4_relax) \ + SymE_HasProto(__aarch64_ldadd4_sync) \ + SymE_HasProto(__aarch64_ldadd8_acq) \ + SymE_HasProto(__aarch64_ldadd8_acq_rel) \ + SymE_HasProto(__aarch64_ldadd8_rel) \ + SymE_HasProto(__aarch64_ldadd8_relax) \ + SymE_HasProto(__aarch64_ldadd8_sync) \ + SymE_HasProto(__aarch64_ldclr1_acq) \ + SymE_HasProto(__aarch64_ldclr1_acq_rel) \ + SymE_HasProto(__aarch64_ldclr1_rel) \ + SymE_HasProto(__aarch64_ldclr1_relax) \ + SymE_HasProto(__aarch64_ldclr1_sync) \ + SymE_HasProto(__aarch64_ldclr2_acq) \ + SymE_HasProto(__aarch64_ldclr2_acq_rel) \ + SymE_HasProto(__aarch64_ldclr2_rel) \ + SymE_HasProto(__aarch64_ldclr2_relax) \ + SymE_HasProto(__aarch64_ldclr2_sync) \ + SymE_HasProto(__aarch64_ldclr4_acq) \ + SymE_HasProto(__aarch64_ldclr4_acq_rel) \ + SymE_HasProto(__aarch64_ldclr4_rel) \ + SymE_HasProto(__aarch64_ldclr4_relax) \ + SymE_HasProto(__aarch64_ldclr4_sync) \ + SymE_HasProto(__aarch64_ldclr8_acq) \ + SymE_HasProto(__aarch64_ldclr8_acq_rel) \ + SymE_HasProto(__aarch64_ldclr8_rel) \ + SymE_HasProto(__aarch64_ldclr8_relax) \ + SymE_HasProto(__aarch64_ldclr8_sync) \ + SymE_HasProto(__aarch64_ldeor1_acq) \ + SymE_HasProto(__aarch64_ldeor1_acq_rel) \ + SymE_HasProto(__aarch64_ldeor1_rel) \ + SymE_HasProto(__aarch64_ldeor1_relax) \ + SymE_HasProto(__aarch64_ldeor1_sync) \ + SymE_HasProto(__aarch64_ldeor2_acq) \ + SymE_HasProto(__aarch64_ldeor2_acq_rel) \ + SymE_HasProto(__aarch64_ldeor2_rel) \ + SymE_HasProto(__aarch64_ldeor2_relax) \ + SymE_HasProto(__aarch64_ldeor2_sync) \ + SymE_HasProto(__aarch64_ldeor4_acq) \ + SymE_HasProto(__aarch64_ldeor4_acq_rel) \ + SymE_HasProto(__aarch64_ldeor4_rel) \ + SymE_HasProto(__aarch64_ldeor4_relax) \ + SymE_HasProto(__aarch64_ldeor4_sync) \ + SymE_HasProto(__aarch64_ldeor8_acq) \ + SymE_HasProto(__aarch64_ldeor8_acq_rel) \ + SymE_HasProto(__aarch64_ldeor8_rel) \ + SymE_HasProto(__aarch64_ldeor8_relax) \ + SymE_HasProto(__aarch64_ldeor8_sync) \ + SymE_HasProto(__aarch64_ldset1_acq) \ + SymE_HasProto(__aarch64_ldset1_acq_rel) \ + SymE_HasProto(__aarch64_ldset1_rel) \ + SymE_HasProto(__aarch64_ldset1_relax) \ + SymE_HasProto(__aarch64_ldset1_sync) \ + SymE_HasProto(__aarch64_ldset2_acq) \ + SymE_HasProto(__aarch64_ldset2_acq_rel) \ + SymE_HasProto(__aarch64_ldset2_rel) \ + SymE_HasProto(__aarch64_ldset2_relax) \ + SymE_HasProto(__aarch64_ldset2_sync) \ + SymE_HasProto(__aarch64_ldset4_acq) \ + SymE_HasProto(__aarch64_ldset4_acq_rel) \ + SymE_HasProto(__aarch64_ldset4_rel) \ + SymE_HasProto(__aarch64_ldset4_relax) \ + SymE_HasProto(__aarch64_ldset4_sync) \ + SymE_HasProto(__aarch64_ldset8_acq) \ + SymE_HasProto(__aarch64_ldset8_acq_rel) \ + SymE_HasProto(__aarch64_ldset8_rel) \ + SymE_HasProto(__aarch64_ldset8_relax) \ + SymE_HasProto(__aarch64_ldset8_sync) \ + SymE_HasProto(__aarch64_swp1_acq) \ + SymE_HasProto(__aarch64_swp1_acq_rel) \ + SymE_HasProto(__aarch64_swp1_rel) \ + SymE_HasProto(__aarch64_swp1_relax) \ + SymE_HasProto(__aarch64_swp1_sync) \ + SymE_HasProto(__aarch64_swp2_acq) \ + SymE_HasProto(__aarch64_swp2_acq_rel) \ + SymE_HasProto(__aarch64_swp2_rel) \ + SymE_HasProto(__aarch64_swp2_relax) \ + SymE_HasProto(__aarch64_swp2_sync) \ + SymE_HasProto(__aarch64_swp4_acq) \ + SymE_HasProto(__aarch64_swp4_acq_rel) \ + SymE_HasProto(__aarch64_swp4_rel) \ + SymE_HasProto(__aarch64_swp4_relax) \ + SymE_HasProto(__aarch64_swp4_sync) \ + SymE_HasProto(__aarch64_swp8_acq) \ + SymE_HasProto(__aarch64_swp8_acq_rel) \ + SymE_HasProto(__aarch64_swp8_rel) \ + SymE_HasProto(__aarch64_swp8_relax) \ + SymE_HasProto(__aarch64_swp8_sync) ===================================== rts/RtsSymbols.c ===================================== @@ -967,6 +967,13 @@ extern char **environ; #define RTS_LIBGCC_SYMBOLS #endif +// Symbols defined by libgcc/compiler-rt for AArch64's outline atomics. +#if defined(linux_HOST_OS) && defined(aarch64_HOST_ARCH) +#include "AArch64Symbols.h" +#else +#define RTS_AARCH64_SYMBOLS +#endif + // Symbols defined by libc #define RTS_LIBC_SYMBOLS \ SymI_HasProto_redirect(atexit, atexit, STRENGTH_STRONG, CODE_TYPE_CODE) /* See Note [Strong symbols] */ \ @@ -1014,6 +1021,7 @@ RTS_LIBC_SYMBOLS RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS +RTS_AARCH64_SYMBOLS #undef SymI_NeedsProto #undef SymI_NeedsDataProto @@ -1055,6 +1063,7 @@ RtsSymbolVal rtsSyms[] = { RTS_LIBGCC_SYMBOLS RTS_FINI_ARRAY_SYMBOLS RTS_LIBFFI_SYMBOLS + RTS_AARCH64_SYMBOLS SymI_HasDataProto(nonmoving_write_barrier_enabled) #if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH) // dyld stub code contains references to this, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ca2f79977d082d8ce55474b8b6a4af06c39e11a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ca2f79977d082d8ce55474b8b6a4af06c39e11a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 02:48:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 19 Jul 2023 22:48:53 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 15 commits: Reg.Liveness: Strictness Message-ID: <64b8a094ed8c0_3a4b0fb755c6248bb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 13cfab8f by Alan Zimmerman at 2023-07-19T22:48:00-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 26 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - + docs/users_guide/9.10.1-notes.rst - docs/users_guide/release-notes.rst - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/printer/Test19784.hs - + testsuite/tests/rename/should_compile/T23664.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -278,6 +278,13 @@ lint-ci-config: - nix run .gitlab/generate-ci#generate-jobs # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code + # And run this to generate the .gitlab/jobs-metadata.json + - nix run .gitlab/generate-ci#generate-job-metadata + artifacts: + when: always + paths: + - .gitlab/jobs-metadata.json + - .gitlab/jobs.yaml dependencies: [] lint-submods: @@ -425,7 +432,7 @@ hadrian-multi: paths: - cabal-cache rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # stack-hadrian-build @@ -823,7 +830,7 @@ perf-nofib: - if: $CI_MERGE_REQUEST_ID - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' tags: - x86_64-linux before_script: @@ -890,7 +897,7 @@ perf: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # ABI testing @@ -930,7 +937,7 @@ abi-test: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ ===================================== .gitlab/gen-ci.cabal deleted ===================================== @@ -1,18 +0,0 @@ -cabal-version: 3.0 -name: gen-ci -version: 0.1.0.0 -build-type: Simple - -common warnings - ghc-options: -Wall - -executable gen_ci - import: warnings - main-is: gen_ci.hs - build-depends: - , aeson >=1.8.1 - , base - , bytestring - , containers - - default-language: Haskell2010 ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -556,7 +556,8 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set +data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present @@ -578,7 +579,7 @@ false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String ruleString On FastCI = true -ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" +ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" @@ -767,17 +768,25 @@ delVariable k j = j { jobVariables = MonoidalMap $ Map.delete k $ unMonoidalMap validate :: Arch -> Opsys -> BuildConfig -> NamedJob Job validate = job +-- Nightly and release apply the FastCI configuration to all jobs so that they all run in +-- the pipeline (not conditional on the full-ci label) +nightlyRule :: Job -> Job +nightlyRule = addJobRule FastCI . addJobRule Nightly + +releaseRule :: Job -> Job +releaseRule = addJobRule FastCI . addJobRule ReleaseOnly + -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job nightly arch opsys bc = let NamedJob n j = job arch opsys bc - in NamedJob { name = "nightly-" ++ n, jobInfo = addJobRule Nightly . keepArtifacts "8 weeks" . highCompression $ j} + in NamedJob { name = "nightly-" ++ n, jobInfo = nightlyRule . keepArtifacts "8 weeks" . highCompression $ j} -- | Make a normal release CI job release :: Arch -> Opsys -> BuildConfig -> NamedJob Job release arch opsys bc = let NamedJob n j = job arch opsys (bc { buildFlavour = Release }) - in NamedJob { name = "release-" ++ n, jobInfo = addJobRule ReleaseOnly . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} + in NamedJob { name = "release-" ++ n, jobInfo = releaseRule . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} -- Specific job modification functions @@ -806,6 +815,7 @@ useHashUnitIds :: Job -> Job useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode +-- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job fastCI = modifyValidateJobs (addJobRule FastCI) @@ -888,7 +898,7 @@ job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf , validateBuilds Amd64 (Linux Debian10) nativeInt - , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) + , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure @@ -907,7 +917,7 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla)) -- Fedora33 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - , standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig + , fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) @@ -915,8 +925,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) - , standardBuilds AArch64 Darwin - , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) + , fastCI (standardBuilds AArch64 Darwin) + , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. ===================================== .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml ===================================== ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1558,7 +1558,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1622,7 +1622,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1687,7 +1687,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1749,7 +1749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1811,7 +1811,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1873,7 +1873,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1937,7 +1937,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2002,7 +2002,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2066,7 +2066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2129,7 +2129,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2191,7 +2191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2249,7 +2249,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2311,7 +2311,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2377,7 +2377,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2444,7 +2444,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2508,7 +2508,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2572,7 +2572,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2774,7 +2774,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2840,7 +2840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2904,7 +2904,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2968,7 +2968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3032,7 +3032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3096,7 +3096,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3160,7 +3160,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3224,7 +3224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3290,7 +3290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3356,7 +3356,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3486,7 +3486,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3550,7 +3550,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3610,7 +3610,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3673,7 +3673,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3740,7 +3740,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3808,7 +3808,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3871,7 +3871,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3935,7 +3935,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3999,7 +3999,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4063,7 +4063,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4126,7 +4126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4188,7 +4188,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4311,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4372,7 +4372,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4433,7 +4433,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4494,7 +4494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4556,7 +4556,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4619,7 +4619,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4682,7 +4682,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4746,7 +4746,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4807,7 +4807,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -56,6 +56,25 @@ Note that there are variety of places in the native code generator where we assume that the code produced for a MachOp does not introduce new blocks. -} +-- Note [MO_S_MulMayOflo significant width] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- There are two interpretations in the code about what a multiplication +-- overflow exactly means: +-- +-- 1. The result does not fit into the specified width (of type Width.) +-- 2. The result does not fit into a register. +-- +-- (2) has some flaws: A following MO_Mul has a width, too. So MO_S_MulMayOflo +-- may signal no overflow, while MO_Mul truncates the result. There are +-- architectures with several register widths and it might be hard to decide +-- what's an overflow and what not. Both attributes can easily lead to subtle +-- bugs. +-- +-- (1) has the benefit that its interpretation is completely independent of the +-- architecture. So, the mid-term plan is to migrate to this +-- interpretation/sematics. + data MachOp -- Integer operations (insensitive to signed/unsigned) = MO_Add Width @@ -65,7 +84,8 @@ data MachOp | MO_Mul Width -- low word of multiply -- Signed multiply/divide - | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows + | MO_S_MulMayOflo Width -- nonzero if signed multiply overflows. See + -- Note [MO_S_MulMayOflo significant width] | MO_S_Quot Width -- signed / (same semantics as IntQuotOp) | MO_S_Rem Width -- signed % (same semantics as IntRemOp) | MO_S_Neg Width -- unary - ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -1001,7 +1001,7 @@ livenessBack livenessBack _ liveregs _ done [] = (liveregs, done) livenessBack platform liveregs blockmap acc (instr : instrs) - = let (liveregs', instr') = liveness1 platform liveregs blockmap instr + = let !(!liveregs', instr') = liveness1 platform liveregs blockmap instr in livenessBack platform liveregs' blockmap (instr' : acc) instrs @@ -1024,15 +1024,15 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) = (liveregs1, LiveInstr instr (Just $ Liveness { liveBorn = emptyUniqSet - , liveDieRead = mkUniqSet r_dying - , liveDieWrite = mkUniqSet w_dying })) + , liveDieRead = r_dying + , liveDieWrite = w_dying })) | otherwise = (liveregs_br, LiveInstr instr (Just $ Liveness { liveBorn = emptyUniqSet , liveDieRead = mkUniqSet r_dying_br - , liveDieWrite = mkUniqSet w_dying })) + , liveDieWrite = w_dying })) where !(RU read written) = regUsageOfInstr platform instr @@ -1044,10 +1044,12 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) -- registers that are not live beyond this point, are recorded -- as dying here. - r_dying = [ reg | reg <- read, reg `notElem` written, + r_dying = mkUniqSet + [ reg | reg <- read, reg `notElem` written, not (elementOfUniqSet reg liveregs) ] - w_dying = [ reg | reg <- written, + w_dying = mkUniqSet + [ reg | reg <- written, not (elementOfUniqSet reg liveregs) ] -- union in the live regs from all the jump destinations of this @@ -1067,6 +1069,6 @@ liveness1 platform liveregs blockmap (LiveInstr instr _) -- registers that are live only in the branch targets should -- be listed as dying here. live_branch_only = live_from_branch `minusUniqSet` liveregs - r_dying_br = nonDetEltsUniqSet (mkUniqSet r_dying `unionUniqSets` + r_dying_br = nonDetEltsUniqSet (r_dying `unionUniqSets` live_branch_only) -- See Note [Unique Determinism and code generation] ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -966,16 +966,38 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps return (Fixed format eax code) - imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + imulMayOflo W8 a b = do + -- The general case (W16, W32, W64) doesn't work for W8 as its + -- multiplication doesn't use two registers. + -- + -- The plan is: + -- 1. truncate and sign-extend a and b to 8bit width + -- 2. multiply a' = a * b in 32bit width + -- 3. copy and sign-extend 8bit from a' to c + -- 4. compare a' and c: they are equal if there was no overflow + (a_reg, a_code) <- getNonClobberedReg a + (b_reg, b_code) <- getNonClobberedReg b + let + code = a_code `appOL` b_code `appOL` + toOL [ + MOVSxL II8 (OpReg a_reg) (OpReg a_reg), + MOVSxL II8 (OpReg b_reg) (OpReg b_reg), + IMUL II32 (OpReg b_reg) (OpReg a_reg), + MOVSxL II8 (OpReg a_reg) (OpReg eax), + CMP II16 (OpReg a_reg) (OpReg eax), + SETCC NE (OpReg eax) + ] + return (Fixed II8 eax code) imulMayOflo rep a b = do (a_reg, a_code) <- getNonClobberedReg a b_code <- getAnyReg b let shift_amt = case rep of + W16 -> 15 W32 -> 31 W64 -> 63 - _ -> panic "shift_amt" + w -> panic ("shift_amt: " ++ show w) format = intFormat rep code = a_code `appOL` b_code eax `appOL` ===================================== compiler/GHC/Parser.y ===================================== @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 $1 $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1073,11 +1073,11 @@ qcnames1 :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list -- Variable, data constructor or wildcard -- or tagged type constructor qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } - : qcname_ext { sL1A $1 ([],$1) } - | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } + : qcname_ext { sL1 $1 ([],$1) } + | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } qcname_ext :: { LocatedA ImpExpQcSpec } - : qcname { reLocA $ sL1N $1 (ImpExpQcName $1) } + : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} @@ -1231,7 +1231,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } - | op { sL1N $1 (unitOL $1) } + | op { sL1 $1 (unitOL $1) } ----------------------------------------------------------------------------- -- Top-Level Declarations @@ -1265,12 +1265,12 @@ topdecl_cs : topdecl {% commentsPA $1 } ----------------------------------------------------------------------------- topdecl :: { LHsDecl GhcPs } - : cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | standalone_kind_sig { sL1 $1 (KindSigD noExtField (unLoc $1)) } - | inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) } - | stand_alone_deriving { sL1 $1 (DerivD noExtField (unLoc $1)) } - | role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) } + : cl_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | ty_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | standalone_kind_sig { sL1a $1 (KindSigD noExtField (unLoc $1)) } + | inst_decl { sL1a $1 (InstD noExtField (unLoc $1)) } + | stand_alone_deriving { sL1a $1 (DerivD noExtField (unLoc $1)) } + | role_annot { sL1a $1 (RoleAnnotD noExtField (unLoc $1)) } | 'default' '(' comma_types0 ')' {% acsA (\cs -> sLL $1 $> (DefD noExtField (DefaultDecl (EpAnn (glR $1) [mj AnnDefault $1,mop $2,mcp $4] cs) $3))) } | 'foreign' fdecl {% acsA (\cs -> sLL $1 $> ((snd $ unLoc $2) (EpAnn (glR $1) (mj AnnForeign $1:(fst $ unLoc $2)) cs))) } @@ -1358,7 +1358,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | oqtycon { sL1N $1 [$1] } + | oqtycon { sL1 $1 [$1] } inst_decl :: { LInstDecl GhcPs } : 'instance' overlap_pragma inst_type where_inst @@ -1438,7 +1438,7 @@ injectivity_cond :: { LInjectivityAnn GhcPs } inj_varids :: { Located [LocatedN RdrName] } : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } - | tyvarid { sL1N $1 [$1] } + | tyvarid { sL1 $1 [$1] } -- Closed type families @@ -1588,7 +1588,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] - , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } + , (sL1a $> (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] @@ -1603,7 +1603,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } - | type { sL1A $1 (Nothing, $1) } + | type { sL1 $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 @@ -1620,7 +1620,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } - | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } + | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) } capi_ctype :: { Maybe (LocatedP CType) } @@ -1755,7 +1755,7 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl_cls { sL1A $1 ([], unitOL $1) } + | decl_cls { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist_cls @@ -1781,8 +1781,8 @@ where_cls :: { Located ([AddEpAnn] -- Declarations in instance bodies -- decl_inst :: { Located (OrdList (LHsDecl GhcPs)) } -decl_inst : at_decl_inst { sL1A $1 (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) } - | decl { sL1A $1 (unitOL $1) } +decl_inst : at_decl_inst { sL1 $1 (unitOL (sL1a $1 (InstD noExtField (unLoc $1)))) } + | decl { sL1 $1 (unitOL $1) } decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_inst ';' decl_inst {% if isNilOL (snd $ unLoc $1) @@ -1842,7 +1842,7 @@ decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl { sL1A $1 ([], unitOL $1) } + | decl { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } @@ -1957,7 +1957,7 @@ rule_vars :: { [LRuleTyTmVar] } | {- empty -} { [] } rule_var :: { LRuleTyTmVar } - : varid { sL1l $1 (RuleTyTmVar noAnn $1 Nothing) } + : varid { sL1a $1 (RuleTyTmVar noAnn $1 Nothing) } | '(' varid '::' ctype ')' {% acsA (\cs -> sLL $1 $> (RuleTyTmVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3,mcp $5] cs) $2 (Just $4))) } {- Note [Parsing explicit foralls in Rules] @@ -2143,7 +2143,7 @@ sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | var { sL1N $1 [$1] } + | var { sL1 $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } : sigtype { unitOL $1 } @@ -2266,11 +2266,11 @@ tyop :: { (LocatedN RdrName, PromotionFlag) } ; return (op, IsPromoted) } } atype :: { LHsType GhcPs } - : ntgtycon {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples + : ntgtycon {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples -- See Note [%shift: atype -> tyvar] - | tyvar %shift {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) + | tyvar %shift {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) - ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } + ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } @@ -2354,7 +2354,7 @@ tv_bndr :: { LHsTyVarBndr Specificity GhcPs } | '{' tyvar '::' kind '}' {% acsA (\cs -> sLL $1 $> (KindedTyVar (EpAnn (glR $1) [moc $1,mu AnnDcolon $3 ,mcc $5] cs) InferredSpec $2 $4)) } tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } - : tyvar {% acsA (\cs -> (sL1 (reLocN $1) (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } + : tyvar {% acsA (\cs -> (sL1 $1 (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } | '(' tyvar '::' kind ')' {% acsA (\cs -> (sLL $1 $> (KindedTyVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3 ,mcp $5] cs) SpecifiedSpec $2 $4))) } fds :: { Located ([AddEpAnn],[LHsFunDep GhcPs]) } @@ -2367,7 +2367,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | fd { sL1A $1 [$1] } + | fd { sL1 $1 [$1] } fd :: { LHsFunDep GhcPs } : varids0 '->' varids0 {% acsA (\cs -> L (comb3 $1 $2 $3) @@ -2465,7 +2465,7 @@ constrs1 :: { Located [LConDecl GhcPs] } {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | constr { sL1A $1 [$1] } + | constr { sL1 $1 [$1] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff @@ -2519,7 +2519,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? - | deriving { sL1 (reLoc $>) [$1] } + | deriving { sL1 $> [$1] } -- The outer Located is just to allow the caller to -- know the rightmost extremity of the 'deriving' clause @@ -2537,9 +2537,9 @@ deriving :: { LHsDerivingClause GhcPs } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $3) $2) } deriv_clause_types :: { LDerivClauseTys GhcPs } - : qtycon { let { tc = sL1 (reLocL $1) $ mkHsImplicitSigType $ - sL1 (reLocL $1) $ HsTyVar noAnn NotPromoted $1 } in - sL1 (reLocC $1) (DctSingle noExtField tc) } + : qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $ + sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in + sL1a $1 (DctSingle noExtField tc) } | '(' ')' {% amsrc (sLL $1 $> (DctMulti noExtField [])) (AnnContext Nothing [glAA $1] [glAA $2]) } | '(' deriv_types ')' {% amsrc (sLL $1 $> (DctMulti noExtField $2)) @@ -2604,7 +2604,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } - | gdrh { sL1 (reLoc $1) [$1] } + | gdrh { sL1 $1 [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 -> @@ -2639,7 +2639,7 @@ sigdecl :: { LHsDecl GhcPs } (Fixity fixText fixPrec (unLoc $1))))) }} - | pattern_synonym_sig { sL1 $1 . SigD noExtField . unLoc $ $1 } + | pattern_synonym_sig { sL1a $1 . SigD noExtField . unLoc $ $1 } | '{-# COMPLETE' qcon_list opt_tyconsig '#-}' {% let (dcolon, tc) = $3 @@ -3236,7 +3236,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } -- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) } -- | '{|' pquals '|}' { sL1 $1 [$2] } @@ -3283,7 +3283,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } h' <- addTrailingCommaA h (gl $2) return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } ----------------------------------------------------------------------------- -- Case alternatives @@ -3321,7 +3321,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (fst $ unLoc $1, h' : t)) } - | alt(PATS) { $1 >>= \ $1 -> return $ sL1 (reLoc $1) ([],[$1]) } + | alt(PATS) { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) } alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) } : PATS alt_rhs { $2 >>= \ $2 -> @@ -3346,7 +3346,7 @@ gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } - | gdpat { $1 >>= \gdpat -> return $ sL1A gdpat [gdpat] } + | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to -- generate the open brace in addition to the vertical bar in the lexer, and @@ -3418,7 +3418,7 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( { h' <- addTrailingSemiA h (gl $2) ; return $ sL1 $1 (fst $ unLoc $1,h':t) }} | stmt { $1 >>= \ $1 -> - return $ sL1A $1 (nilOL,[$1]) } + return $ sL1 $1 (nilOL,[$1]) } | {- empty -} { return $ noLoc (nilOL,[]) } @@ -3444,7 +3444,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> - return $ sL1 $1 $ mkBodyStmt $1 } + return $ sL1a $1 $ mkBodyStmt $1 } | 'let' binds { acsA (\cs -> (sLL $1 $> $ mkLetStmt (EpAnn (glR $1) [mj AnnLet $1] cs) (unLoc $2))) } @@ -3467,13 +3467,13 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1a $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... | qvar { placeHolderPunRhs >>= \rhs -> - fmap Left $ acsa (\cs -> sL1a (reLocN $1) $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1l $1 $ mkFieldOcc $1) rhs True) } + fmap Left $ acsa (\cs -> sL1a $1 $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1a $1 $ mkFieldOcc $1) rhs True) } -- In the punning case, use a place-holder -- The renamer fills in the final value @@ -3481,7 +3481,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3497,7 +3497,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3514,7 +3514,7 @@ fieldToUpdate : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> - return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } + return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } ----------------------------------------------------------------------------- -- Implicit Parameter Bindings @@ -3530,7 +3530,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | dbind { let this = $1 in this `seq` (sL1 (reLoc $1) [this]) } + | dbind { let this = $1 in this `seq` (sL1 $1 [this]) } -- | {- empty -} { [] } dbind :: { LIPBind GhcPs } @@ -3572,10 +3572,10 @@ name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } : '(' name_boolformula ')' {% amsrl (sLL $1 $> (Parens $2)) (AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) } - | name_var { reLocA $ sL1N $1 (Var $1) } + | name_var { sL1a $1 (Var $1) } namelist :: { Located [LocatedN RdrName] } -namelist : name_var { sL1N $1 [$1] } +namelist : name_var { sL1 $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -3608,11 +3608,11 @@ con :: { LocatedN RdrName } | sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) } con_list :: { Located (NonEmpty (LocatedN RdrName)) } -con_list : con { sL1N $1 (pure $1) } +con_list : con { sL1 $1 (pure $1) } | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } -qcon_list : qcon { sL1N $1 [$1] } +qcon_list : qcon { sL1 $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -4117,28 +4117,16 @@ sL0 :: a -> Located a sL0 = L noSrcSpan -- #define L0 L noSrcSpan {-# INLINE sL1 #-} -sL1 :: GenLocated l a -> b -> GenLocated l b -sL1 x = sL (getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1A #-} -sL1A :: LocatedAn t a -> b -> Located b -sL1A x = sL (getLocA x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1N #-} -sL1N :: LocatedN a -> b -> Located b -sL1N x = sL (getLocA x) -- #define sL1 sL (getLoc $1) +sL1 :: HasLoc a => a -> b -> Located b +sL1 x = sL (getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1a #-} -sL1a :: Located a -> b -> LocatedAn t b -sL1a x = sL (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1l #-} -sL1l :: LocatedAn t a -> b -> LocatedAn u b -sL1l x = sL (l2l $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1a :: HasLoc a => a -> b -> LocatedAn t b +sL1a x = sL (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1n #-} -sL1n :: Located a -> b -> LocatedN b -sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1n :: HasLoc a => a -> b -> LocatedN b +sL1n x = L (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -82,7 +82,8 @@ module GHC.Parser.Annotation ( -- ** Working with comments in annotations noComments, comment, addCommentsToSrcAnn, setCommentsSrcAnn, addCommentsToEpAnn, setCommentsEpAnn, - transferAnnsA, commentsOnlyA, removeCommentsA, + transferAnnsA, transferAnnsOnlyA, transferCommentsOnlyA, commentsOnlyA, + removeCommentsA, placeholderRealSpan, ) where @@ -1154,6 +1155,26 @@ transferAnnsA (SrcSpanAnn (EpAnn a an cs) l) to (SrcSpanAnn (EpAnn a an' cs') loc) -> SrcSpanAnn (EpAnn a (an' <> an) (cs' <> cs)) loc +-- | Transfer trailing items from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferAnnsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferAnnsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2 + = (SrcSpanAnn EpAnnNotUsed l, ss2) +transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l') + = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn (spanAsAnchor l') an emptyComments) l') +transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l') + = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn a' (an' <> an) cs') l') + +-- | Transfer comments from the annotations in the +-- first 'SrcSpanAnnA' argument to those in the second. +transferCommentsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA) +transferCommentsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2 + = (SrcSpanAnn EpAnnNotUsed l, ss2) +transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l') + = (SrcSpanAnn (EpAnn a an emptyComments ) l, SrcSpanAnn (EpAnn (spanAsAnchor l') mempty cs) l') +transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l') + = (SrcSpanAnn (EpAnn a an emptyComments) l, SrcSpanAnn (EpAnn a' an' (cs <> cs')) l') + -- | Remove the exact print annotations payload, leaving only the -- anchor and comments. commentsOnlyA :: Monoid ann => SrcAnn ann -> SrcAnn ann ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -587,11 +587,14 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) MG { mg_alts = (L _ m1@[L _ mtchs1]) } })) binds | has_args m1 - = go [L (removeCommentsA loc1) mtchs1] (commentsOnlyA loc1) binds [] + = go [L loc1 mtchs1] (noAnnSrcSpan $ locA loc1) binds [] where - go :: [LMatch GhcPs (LHsExpr GhcPs)] -> SrcSpanAnnA - -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] - -> (LHsBind GhcPs,[LHsDecl GhcPs]) -- AZ + -- See Note [Exact Print Annotations for FunBind] + go :: [LMatch GhcPs (LHsExpr GhcPs)] -- accumulates matches for current fun + -> SrcSpanAnnA -- current top level loc + -> [LHsDecl GhcPs] -- Any docbinds seen + -> [LHsDecl GhcPs] -- rest of decls to be processed + -> (LHsBind GhcPs, [LHsDecl GhcPs]) -- FunBind, rest of decls go mtchs loc ((L loc2 (ValD _ (FunBind { fun_id = (L _ f2) , fun_matches = @@ -605,13 +608,61 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1) = let doc_decls' = doc_decl : doc_decls in go mtchs (combineSrcSpansA loc loc2) binds doc_decls' go mtchs loc binds doc_decls - = ( L loc (makeFunBind fun_id1 (mkLocatedList $ reverse mtchs)) - , (reverse doc_decls) ++ binds) + = let + L llm last_m = head mtchs -- Guaranteed at least one + (llm',loc') = transferAnnsOnlyA llm loc -- Keep comments, transfer trailing + + matches' = reverse (L llm' last_m:tail mtchs) + L lfm first_m = head matches' + (lfm', loc'') = transferCommentsOnlyA lfm loc' + in + ( L loc'' (makeFunBind fun_id1 (mkLocatedList $ (L lfm' first_m:tail matches'))) + , (reverse doc_decls) ++ binds) -- Reverse the final matches, to get it back in the right order -- Do the same thing with the trailing doc comments getMonoBind bind binds = (bind, binds) +{- Note [Exact Print Annotations for FunBind] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +An individual Match that ends up in a FunBind MatchGroup is initially +parsed as a LHsDecl. This takes the form + + L loc (ValD NoExtField (FunBind ... [L lm (Match ..)])) + +The loc contains the annotations, in particular comments, which are to +precede the declaration when printed, and [TrailingAnn] which are to +follow it. The [TrailingAnn] captures semicolons that may appear after +it when using the braces and semis style of coding. + +The match location (lm) has only a location in it at this point, no +annotations. Its location is the same as the top level location in +loc. + +What getMonoBind does it to take a sequence of FunBind LHsDecls that +belong to the same function and group them into a single function with +the component declarations all combined into the single MatchGroup as +[LMatch GhcPs]. + +Given that when exact printing a FunBind the exact printer simply +iterates over all the matches and prints each in turn, the simplest +behaviour would be to simply take the top level annotations (loc) for +each declaration, and use them for the individual component matches +(lm). + +The problem is the exact printer first has to deal with the top level +LHsDecl, which means annotations for the loc. This needs to be able to +be exact printed in the context of surrounding declarations, and if +some refactor decides to move the declaration elsewhere, the leading +comments and trailing semicolons need to be handled at that level. + +So the solution is to combine all the matches into one, pushing the +annotations into the LMatch's, and then at the end extract the +comments from the first match and [TrailingAnn] from the last to go in +the top level LHsDecl. +-} + -- Group together adjacent FunBinds for every function. getMonoBindAll :: [LHsDecl GhcPs] -> [LHsDecl GhcPs] getMonoBindAll [] = [] ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -845,8 +845,10 @@ lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = -- See [Mismatched class methods and associated type families] -- in TcInstDecls. where - what_lkup = LookupChild { wantedParent = the_parent - , lookupDataConFirst = False } + what_lkup = LookupChild { wantedParent = the_parent + , lookupDataConFirst = False + , prioritiseParent = True -- See T23664. + } {- Note [Family instance binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -690,8 +690,12 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items let bareName = (ieWrappedName . unLoc) n what_lkup :: LookupChild - what_lkup = LookupChild { wantedParent = spec_parent - , lookupDataConFirst = True } + what_lkup = + LookupChild + { wantedParent = spec_parent + , lookupDataConFirst = True + , prioritiseParent = False -- See T11970. + } -- Do not report export list declaration deprecations name <- lookupSubBndrOcc_helper False ExportDeprecationWarnings ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -1190,6 +1190,13 @@ data LookupChild , lookupDataConFirst :: Bool -- ^ for type constructors, should we look in the data constructor -- namespace first? + , prioritiseParent :: Bool + -- ^ should we prioritise getting the right 'Parent'? + -- + -- - @True@: prioritise getting the right 'Parent' + -- - @False@: prioritise getting the right 'NameSpace' + -- + -- See Note [childGREPriority]. } -- | After looking up something with the given 'NameSpace', is the resulting @@ -1225,14 +1232,52 @@ greIsRelevant which_gres ns gre where other_ns = greNameSpace gre +{- Note [childGREPriority] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are currently two places in the compiler where we look up GlobalRdrElts +which have a given Parent. These are the two calls to lookupSubBndrOcc_helper: + + A. Looking up children in an export item, e.g. + + module M ( T(MkT, D) ) where { data T = MkT; data D = D } + + B. Looking up binders in a class or instance declaration, e.g. + the operator +++ in the fixity declaration: + + class C a where { type (+++) :: a -> a ->; infixl 6 +++ } + (+++) :: Int -> Int -> Int; (+++) = (+) + +In these two situations, there are two competing metrics for finding the "best" +'GlobalRdrElt' that a particular 'OccName' resolves to: + + - does the resolved 'GlobalRdrElt' have the correct parent? + - does the resolved 'GlobalRdrElt' have the same 'NameSpace' as the 'OccName'? + +(A) and (B) have competing requirements. + +For the example of (A) above, we know that the child 'D' of 'T' must live +in the data namespace, so we look up the OccName 'OccName DataName "D"' and +prioritise the lookup results based on the 'NameSpace'. +This means we get an error message of the form: + + The type constructor 'T' is not the parent of the data constructor 'D'. + +as opposed to the rather unhelpful and confusing: + + The type constructor 'T' is not the parent of the type constructor 'D'. + +See test case T11970. + +For the example of (B) above, the fixity declaration for +++ lies inside the +class, so we should prioritise looking up 'GlobalRdrElt's whose parent is 'C'. +Not doing so led to #23664. +-} + -- | Scoring priority function for looking up children 'GlobalRdrElt'. -- --- First we score by 'NameSpace', with higher-priority 'NameSpace's having a --- lower number. Then we break ties by checking if the 'Parent' is correct. --- --- This complicated scoring function is determined by the behaviour required by --- 'lookupChildrenExport', which requires us to look in the data constructor --- 'NameSpace' first, for things in the type constructor 'NameSpace'. +-- We score by 'Parent' and 'NameSpace', with higher priorities having lower +-- numbers. Which lexicographic order we use ('Parent' or 'NameSpace' first) +-- is determined by the first argument; see Note [childGREPriority]. childGREPriority :: LookupChild -- ^ what kind of child do we want, -- e.g. what should its parent be? -> NameSpace -- ^ what 'NameSpace' are we originally looking in? @@ -1241,13 +1286,18 @@ childGREPriority :: LookupChild -- ^ what kind of child do we want, -- 'NameSpace', which is used to determine the score -- (in the first component) -> Maybe (Int, Int) -childGREPriority (LookupChild { wantedParent = wanted_parent, lookupDataConFirst = try_dc_first }) +childGREPriority (LookupChild { wantedParent = wanted_parent + , lookupDataConFirst = try_dc_first + , prioritiseParent = par_first }) ns gre = - case child_ns_prio $ greNameSpace gre of - Nothing -> Nothing - Just np -> Just (np, parent_prio $ greParent gre) - -- Prioritise GREs first on NameSpace, and then on Parent. - -- See T11970. + case child_ns_prio $ greNameSpace gre of + Nothing -> Nothing + Just ns_prio -> + let par_prio = parent_prio $ greParent gre + in Just $ if par_first + then (par_prio, ns_prio) + else (ns_prio, par_prio) + -- See Note [childGREPriority]. where -- Pick out the possible 'NameSpace's in order of priority. @@ -1302,11 +1352,9 @@ lookupGRE env = \case lkup | all_ns = concat $ lookupOccEnv_AllNameSpaces env occ | otherwise = fromMaybe [] $ lookupOccEnv env occ LookupChildren occ which_child -> - highestPriorityGREs (childGREPriority which_child ns) $ - concat $ lookupOccEnv_AllNameSpaces env occ - where - ns :: NameSpace - ns = occNameSpace occ + let ns = occNameSpace occ + all_gres = concat $ lookupOccEnv_AllNameSpaces env occ + in highestPriorityGREs (childGREPriority which_child ns) all_gres -- | Collect the 'GlobalRdrElt's with the highest priority according -- to the given function (lower value <=> higher priority). ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -212,13 +212,16 @@ addToUDFM_C f m k v = addToUDFM_C_Directly f m (getUnique k) v addListToUDFM :: Uniquable key => UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) +{-# INLINEABLE addListToUDFM #-} addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) +{-# INLINEABLE addListToUDFM_Directly #-} addListToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) +{-# INLINEABLE addListToUDFM_Directly_C #-} delFromUDFM :: Uniquable key => UniqDFM key elt -> key -> UniqDFM key elt delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -139,9 +139,11 @@ zipToUFM ks vs = assert (length ks == length vs ) innerZip emptyUFM ks vs listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM +{-# INLINEABLE listToUFM #-} listToUFM_Directly :: [(Unique, elt)] -> UniqFM key elt listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM +{-# INLINEABLE listToUFM_Directly #-} listToIdentityUFM :: Uniquable key => [key] -> UniqFM key key listToIdentityUFM = foldl' (\m x -> addToUFM m x x) emptyUFM @@ -152,6 +154,7 @@ listToUFM_C -> [(key, elt)] -> UniqFM key elt listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM +{-# INLINEABLE listToUFM_C #-} addToUFM :: Uniquable key => UniqFM key elt -> key -> elt -> UniqFM key elt addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m) ===================================== compiler/GHC/Types/Unique/Set.hs ===================================== @@ -74,12 +74,14 @@ unitUniqSet x = UniqSet $ unitUFM x x mkUniqSet :: Uniquable a => [a] -> UniqSet a mkUniqSet = foldl' addOneToUniqSet emptyUniqSet +{-# INLINEABLE mkUniqSet #-} addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x) addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a addListToUniqSet = foldl' addOneToUniqSet +{-# INLINEABLE addListToUniqSet #-} delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a) @@ -89,10 +91,12 @@ delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u) delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l) +{-# INLINEABLE delListFromUniqSet #-} delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a delListFromUniqSet_Directly (UniqSet s) l = UniqSet (delListFromUFM_Directly s l) +{-# INLINEABLE delListFromUniqSet_Directly #-} unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t) ===================================== docs/users_guide/9.10.1-notes.rst ===================================== @@ -0,0 +1,75 @@ +.. _release-9-10-1: + +Version 9.10.1 +============== + +Language +~~~~~~~~ + +Compiler +~~~~~~~~ + +GHCi +~~~~ + +Runtime system +~~~~~~~~~~~~~~ + +``base`` library +~~~~~~~~~~~~~~~~ + +``ghc-prim`` library +~~~~~~~~~~~~~~~~~~~~ + +``ghc`` library +~~~~~~~~~~~~~~~ + +``ghc-heap`` library +~~~~~~~~~~~~~~~~~~~~ + +``template-haskell`` library +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Included libraries +~~~~~~~~~~~~~~~~~~ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/release-notes.rst ===================================== @@ -4,4 +4,4 @@ Release notes .. toctree:: :maxdepth: 1 - 9.8.1-notes + 9.10.1-notes ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +{- + N.B. the contract of '%mulmayoflo' is a bit weak: "Return non-zero if there is + any possibility that the signed multiply of a and b might overflow. Return zero + only if you are absolutely sure that it won't overflow. If in doubt, return + non-zero." (Stg.h) + +This test verifies the a stronger contract: It's expected that there are no +false positives. This requirement is e.g. met by code generation backends which +execute the multiplication to check for overflow. +-} + +module Main where + +import GHC.Exts + +-- The argument and return types are unimportant: They're only used to force +-- evaluation, but carry no information. +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm ===================================== @@ -0,0 +1,98 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" +#include "MachDeps.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + + // --- I8 + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16385::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, -16385::I16) > 0::I16); + + + // -- I32 + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); +#endif + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + +#if WORD_SIZE_IN_BITS >= 64 + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); +#endif + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -226,3 +226,14 @@ test('T22296',[only_ways(llvm_ways) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) + +# TODO: Enable more architectures here. N.B. some code generation backends are +# not implemeted correctly (according to +# Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. +test('MulMayOflo_full', + [ extra_files(['MulMayOflo.hs']), + when(unregisterised(), skip), + unless(arch('x86_64') or arch('i386'), skip), + ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_full.cmm', '')], '']) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -1349,7 +1349,12 @@ { DumpSemis.hs:32:1-7 } (UnchangedAnchor)) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:33:1 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:6 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:34:7 }))]) (EpaComments [])) { DumpSemis.hs:32:1-7 }) (ValD @@ -1370,12 +1375,7 @@ { DumpSemis.hs:32:1-7 } (UnchangedAnchor)) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:33:1 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:6 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:34:7 }))]) + []) (EpaComments [])) { DumpSemis.hs:32:1-7 }) (Match @@ -1707,7 +1707,8 @@ { DumpSemis.hs:(36,1)-(44,4) } (UnchangedAnchor)) (AnnListItem - []) + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:45:1 }))]) (EpaComments [])) { DumpSemis.hs:(36,1)-(44,4) }) (ValD @@ -1728,8 +1729,7 @@ { DumpSemis.hs:(36,1)-(44,4) } (UnchangedAnchor)) (AnnListItem - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:45:1 }))]) + []) (EpaComments [])) { DumpSemis.hs:(36,1)-(44,4) }) (Match @@ -2100,5 +2100,3 @@ (NoExtField)))))]))))))] (EmptyLocalBinds (NoExtField)))))])))))])) - - ===================================== testsuite/tests/printer/Test19784.hs ===================================== @@ -2,4 +2,9 @@ module Test19784 where { a 0 = 1; a _ = 2; + +-- c0 +b 0 = 1; -- c1 +b 1 = 2; -- c2 +b 2 = 3; -- c3 } ===================================== testsuite/tests/rename/should_compile/T23664.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies, TypeOperators #-} + +module T23664 where + +class POrd a where + type a >= b + infix 4 >= ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -214,6 +214,7 @@ test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) test('T23512b', normal, compile, ['']) +test('T23664', normal, compile, ['']) test('ExportWarnings1', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings1', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings2', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs', 'ExportWarnings_aux2.hs']), multimod_compile, ['ExportWarnings2', '-v0 -Wno-duplicate-exports -Wx-custom']) test('ExportWarnings3', extra_files(['ExportWarnings_base.hs', 'ExportWarnings_aux.hs']), multimod_compile, ['ExportWarnings3', '-v0 -Wno-duplicate-exports -Wx-custom']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ecd4722b61410ef5e02cabedda25bed5e4c9939...13cfab8f8b1991b6b0ab14d469f0a77b2d132659 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ecd4722b61410ef5e02cabedda25bed5e4c9939...13cfab8f8b1991b6b0ab14d469f0a77b2d132659 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 03:12:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 19 Jul 2023 23:12:30 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 72 commits: compiler: Rework ShowSome Message-ID: <64b8a61e4bfc0_3a4b0fb7458630259@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - c5fb582e by Ben Gamari at 2023-07-19T23:12:16-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - ed7e92a7 by Ben Gamari at 2023-07-19T23:12:16-04:00 base: Introduce Data.Enum - - - - - 2a957fac by Ben Gamari at 2023-07-19T23:12:16-04:00 base: Add export list to GHC.Num.Integer - - - - - 009d5fef by Ben Gamari at 2023-07-19T23:12:16-04:00 base: Add export list to GHC.Num - - - - - 5428d61a by Ben Gamari at 2023-07-19T23:12:17-04:00 base: Add export list to GHC.Num.Natural - - - - - b9041905 by Ben Gamari at 2023-07-19T23:12:17-04:00 base: Add export list to GHC.Float - - - - - 215a0c19 by Ben Gamari at 2023-07-19T23:12:17-04:00 base: Add export list to GHC.Real - - - - - 09ac0e6b by Ben Gamari at 2023-07-19T23:12:17-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T13386 - - - - - 29 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/FVs.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3b267c3ea760c5cde2676e915adb20807a9f2a8...09ac0e6b30ae1bb6662fccd386dba14b7cfe995c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3b267c3ea760c5cde2676e915adb20807a9f2a8...09ac0e6b30ae1bb6662fccd386dba14b7cfe995c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 09:28:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 20 Jul 2023 05:28:48 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Remove unused files in .gitlab Message-ID: <64b8fe504c3ff_78d13b78685602f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 5 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -432,7 +432,7 @@ hadrian-multi: paths: - cabal-cache rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # stack-hadrian-build @@ -830,7 +830,7 @@ perf-nofib: - if: $CI_MERGE_REQUEST_ID - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' tags: - x86_64-linux before_script: @@ -897,7 +897,7 @@ perf: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # ABI testing @@ -937,7 +937,7 @@ abi-test: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ ===================================== .gitlab/gen-ci.cabal deleted ===================================== @@ -1,18 +0,0 @@ -cabal-version: 3.0 -name: gen-ci -version: 0.1.0.0 -build-type: Simple - -common warnings - ghc-options: -Wall - -executable gen_ci - import: warnings - main-is: gen_ci.hs - build-depends: - , aeson >=1.8.1 - , base - , bytestring - , containers - - default-language: Haskell2010 ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -556,7 +556,8 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set +data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present @@ -578,7 +579,7 @@ false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String ruleString On FastCI = true -ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" +ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" @@ -767,17 +768,25 @@ delVariable k j = j { jobVariables = MonoidalMap $ Map.delete k $ unMonoidalMap validate :: Arch -> Opsys -> BuildConfig -> NamedJob Job validate = job +-- Nightly and release apply the FastCI configuration to all jobs so that they all run in +-- the pipeline (not conditional on the full-ci label) +nightlyRule :: Job -> Job +nightlyRule = addJobRule FastCI . addJobRule Nightly + +releaseRule :: Job -> Job +releaseRule = addJobRule FastCI . addJobRule ReleaseOnly + -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job nightly arch opsys bc = let NamedJob n j = job arch opsys bc - in NamedJob { name = "nightly-" ++ n, jobInfo = addJobRule Nightly . keepArtifacts "8 weeks" . highCompression $ j} + in NamedJob { name = "nightly-" ++ n, jobInfo = nightlyRule . keepArtifacts "8 weeks" . highCompression $ j} -- | Make a normal release CI job release :: Arch -> Opsys -> BuildConfig -> NamedJob Job release arch opsys bc = let NamedJob n j = job arch opsys (bc { buildFlavour = Release }) - in NamedJob { name = "release-" ++ n, jobInfo = addJobRule ReleaseOnly . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} + in NamedJob { name = "release-" ++ n, jobInfo = releaseRule . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} -- Specific job modification functions @@ -806,6 +815,7 @@ useHashUnitIds :: Job -> Job useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode +-- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job fastCI = modifyValidateJobs (addJobRule FastCI) @@ -888,7 +898,7 @@ job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf , validateBuilds Amd64 (Linux Debian10) nativeInt - , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) + , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure @@ -907,7 +917,7 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla)) -- Fedora33 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - , standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig + , fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) @@ -915,8 +925,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) - , standardBuilds AArch64 Darwin - , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) + , fastCI (standardBuilds AArch64 Darwin) + , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. ===================================== .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml ===================================== ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1558,7 +1558,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1622,7 +1622,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1687,7 +1687,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1749,7 +1749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1811,7 +1811,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1873,7 +1873,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1937,7 +1937,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2002,7 +2002,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2066,7 +2066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2129,7 +2129,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2191,7 +2191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2249,7 +2249,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2311,7 +2311,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2377,7 +2377,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2444,7 +2444,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2508,7 +2508,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2572,7 +2572,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2774,7 +2774,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2840,7 +2840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2904,7 +2904,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2968,7 +2968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3032,7 +3032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3096,7 +3096,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3160,7 +3160,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3224,7 +3224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3290,7 +3290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3356,7 +3356,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3486,7 +3486,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3550,7 +3550,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3610,7 +3610,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3673,7 +3673,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3740,7 +3740,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3808,7 +3808,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3871,7 +3871,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3935,7 +3935,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3999,7 +3999,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4063,7 +4063,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4126,7 +4126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4188,7 +4188,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4311,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4372,7 +4372,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4433,7 +4433,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4494,7 +4494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4556,7 +4556,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4619,7 +4619,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4682,7 +4682,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4746,7 +4746,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4807,7 +4807,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c8fdda3458a72be9ea90d45ab379444ab0cfb30...808b55cf44660796894401624207a789aa7e49f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c8fdda3458a72be9ea90d45ab379444ab0cfb30...808b55cf44660796894401624207a789aa7e49f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 09:29:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 20 Jul 2023 05:29:18 -0400 Subject: [Git][ghc/ghc][master] EPA: Simplify GHC/Parser.y sL1 Message-ID: <64b8fe6e21b71_78d13b787c5979a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 $1 $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1073,11 +1073,11 @@ qcnames1 :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list -- Variable, data constructor or wildcard -- or tagged type constructor qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } - : qcname_ext { sL1A $1 ([],$1) } - | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } + : qcname_ext { sL1 $1 ([],$1) } + | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } qcname_ext :: { LocatedA ImpExpQcSpec } - : qcname { reLocA $ sL1N $1 (ImpExpQcName $1) } + : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} @@ -1231,7 +1231,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } - | op { sL1N $1 (unitOL $1) } + | op { sL1 $1 (unitOL $1) } ----------------------------------------------------------------------------- -- Top-Level Declarations @@ -1265,12 +1265,12 @@ topdecl_cs : topdecl {% commentsPA $1 } ----------------------------------------------------------------------------- topdecl :: { LHsDecl GhcPs } - : cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | standalone_kind_sig { sL1 $1 (KindSigD noExtField (unLoc $1)) } - | inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) } - | stand_alone_deriving { sL1 $1 (DerivD noExtField (unLoc $1)) } - | role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) } + : cl_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | ty_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | standalone_kind_sig { sL1a $1 (KindSigD noExtField (unLoc $1)) } + | inst_decl { sL1a $1 (InstD noExtField (unLoc $1)) } + | stand_alone_deriving { sL1a $1 (DerivD noExtField (unLoc $1)) } + | role_annot { sL1a $1 (RoleAnnotD noExtField (unLoc $1)) } | 'default' '(' comma_types0 ')' {% acsA (\cs -> sLL $1 $> (DefD noExtField (DefaultDecl (EpAnn (glR $1) [mj AnnDefault $1,mop $2,mcp $4] cs) $3))) } | 'foreign' fdecl {% acsA (\cs -> sLL $1 $> ((snd $ unLoc $2) (EpAnn (glR $1) (mj AnnForeign $1:(fst $ unLoc $2)) cs))) } @@ -1358,7 +1358,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | oqtycon { sL1N $1 [$1] } + | oqtycon { sL1 $1 [$1] } inst_decl :: { LInstDecl GhcPs } : 'instance' overlap_pragma inst_type where_inst @@ -1438,7 +1438,7 @@ injectivity_cond :: { LInjectivityAnn GhcPs } inj_varids :: { Located [LocatedN RdrName] } : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } - | tyvarid { sL1N $1 [$1] } + | tyvarid { sL1 $1 [$1] } -- Closed type families @@ -1588,7 +1588,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] - , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } + , (sL1a $> (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] @@ -1603,7 +1603,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } - | type { sL1A $1 (Nothing, $1) } + | type { sL1 $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 @@ -1620,7 +1620,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } - | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } + | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) } capi_ctype :: { Maybe (LocatedP CType) } @@ -1755,7 +1755,7 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl_cls { sL1A $1 ([], unitOL $1) } + | decl_cls { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist_cls @@ -1781,8 +1781,8 @@ where_cls :: { Located ([AddEpAnn] -- Declarations in instance bodies -- decl_inst :: { Located (OrdList (LHsDecl GhcPs)) } -decl_inst : at_decl_inst { sL1A $1 (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) } - | decl { sL1A $1 (unitOL $1) } +decl_inst : at_decl_inst { sL1 $1 (unitOL (sL1a $1 (InstD noExtField (unLoc $1)))) } + | decl { sL1 $1 (unitOL $1) } decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_inst ';' decl_inst {% if isNilOL (snd $ unLoc $1) @@ -1842,7 +1842,7 @@ decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl { sL1A $1 ([], unitOL $1) } + | decl { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } @@ -1957,7 +1957,7 @@ rule_vars :: { [LRuleTyTmVar] } | {- empty -} { [] } rule_var :: { LRuleTyTmVar } - : varid { sL1l $1 (RuleTyTmVar noAnn $1 Nothing) } + : varid { sL1a $1 (RuleTyTmVar noAnn $1 Nothing) } | '(' varid '::' ctype ')' {% acsA (\cs -> sLL $1 $> (RuleTyTmVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3,mcp $5] cs) $2 (Just $4))) } {- Note [Parsing explicit foralls in Rules] @@ -2143,7 +2143,7 @@ sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | var { sL1N $1 [$1] } + | var { sL1 $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } : sigtype { unitOL $1 } @@ -2266,11 +2266,11 @@ tyop :: { (LocatedN RdrName, PromotionFlag) } ; return (op, IsPromoted) } } atype :: { LHsType GhcPs } - : ntgtycon {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples + : ntgtycon {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples -- See Note [%shift: atype -> tyvar] - | tyvar %shift {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) + | tyvar %shift {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) - ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } + ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } @@ -2354,7 +2354,7 @@ tv_bndr :: { LHsTyVarBndr Specificity GhcPs } | '{' tyvar '::' kind '}' {% acsA (\cs -> sLL $1 $> (KindedTyVar (EpAnn (glR $1) [moc $1,mu AnnDcolon $3 ,mcc $5] cs) InferredSpec $2 $4)) } tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } - : tyvar {% acsA (\cs -> (sL1 (reLocN $1) (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } + : tyvar {% acsA (\cs -> (sL1 $1 (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } | '(' tyvar '::' kind ')' {% acsA (\cs -> (sLL $1 $> (KindedTyVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3 ,mcp $5] cs) SpecifiedSpec $2 $4))) } fds :: { Located ([AddEpAnn],[LHsFunDep GhcPs]) } @@ -2367,7 +2367,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | fd { sL1A $1 [$1] } + | fd { sL1 $1 [$1] } fd :: { LHsFunDep GhcPs } : varids0 '->' varids0 {% acsA (\cs -> L (comb3 $1 $2 $3) @@ -2465,7 +2465,7 @@ constrs1 :: { Located [LConDecl GhcPs] } {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | constr { sL1A $1 [$1] } + | constr { sL1 $1 [$1] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff @@ -2519,7 +2519,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? - | deriving { sL1 (reLoc $>) [$1] } + | deriving { sL1 $> [$1] } -- The outer Located is just to allow the caller to -- know the rightmost extremity of the 'deriving' clause @@ -2537,9 +2537,9 @@ deriving :: { LHsDerivingClause GhcPs } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $3) $2) } deriv_clause_types :: { LDerivClauseTys GhcPs } - : qtycon { let { tc = sL1 (reLocL $1) $ mkHsImplicitSigType $ - sL1 (reLocL $1) $ HsTyVar noAnn NotPromoted $1 } in - sL1 (reLocC $1) (DctSingle noExtField tc) } + : qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $ + sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in + sL1a $1 (DctSingle noExtField tc) } | '(' ')' {% amsrc (sLL $1 $> (DctMulti noExtField [])) (AnnContext Nothing [glAA $1] [glAA $2]) } | '(' deriv_types ')' {% amsrc (sLL $1 $> (DctMulti noExtField $2)) @@ -2604,7 +2604,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } - | gdrh { sL1 (reLoc $1) [$1] } + | gdrh { sL1 $1 [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 -> @@ -2639,7 +2639,7 @@ sigdecl :: { LHsDecl GhcPs } (Fixity fixText fixPrec (unLoc $1))))) }} - | pattern_synonym_sig { sL1 $1 . SigD noExtField . unLoc $ $1 } + | pattern_synonym_sig { sL1a $1 . SigD noExtField . unLoc $ $1 } | '{-# COMPLETE' qcon_list opt_tyconsig '#-}' {% let (dcolon, tc) = $3 @@ -3236,7 +3236,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } -- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) } -- | '{|' pquals '|}' { sL1 $1 [$2] } @@ -3283,7 +3283,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } h' <- addTrailingCommaA h (gl $2) return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } ----------------------------------------------------------------------------- -- Case alternatives @@ -3321,7 +3321,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (fst $ unLoc $1, h' : t)) } - | alt(PATS) { $1 >>= \ $1 -> return $ sL1 (reLoc $1) ([],[$1]) } + | alt(PATS) { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) } alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) } : PATS alt_rhs { $2 >>= \ $2 -> @@ -3346,7 +3346,7 @@ gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } - | gdpat { $1 >>= \gdpat -> return $ sL1A gdpat [gdpat] } + | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to -- generate the open brace in addition to the vertical bar in the lexer, and @@ -3418,7 +3418,7 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( { h' <- addTrailingSemiA h (gl $2) ; return $ sL1 $1 (fst $ unLoc $1,h':t) }} | stmt { $1 >>= \ $1 -> - return $ sL1A $1 (nilOL,[$1]) } + return $ sL1 $1 (nilOL,[$1]) } | {- empty -} { return $ noLoc (nilOL,[]) } @@ -3444,7 +3444,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> - return $ sL1 $1 $ mkBodyStmt $1 } + return $ sL1a $1 $ mkBodyStmt $1 } | 'let' binds { acsA (\cs -> (sLL $1 $> $ mkLetStmt (EpAnn (glR $1) [mj AnnLet $1] cs) (unLoc $2))) } @@ -3467,13 +3467,13 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1a $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... | qvar { placeHolderPunRhs >>= \rhs -> - fmap Left $ acsa (\cs -> sL1a (reLocN $1) $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1l $1 $ mkFieldOcc $1) rhs True) } + fmap Left $ acsa (\cs -> sL1a $1 $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1a $1 $ mkFieldOcc $1) rhs True) } -- In the punning case, use a place-holder -- The renamer fills in the final value @@ -3481,7 +3481,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3497,7 +3497,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3514,7 +3514,7 @@ fieldToUpdate : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> - return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } + return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } ----------------------------------------------------------------------------- -- Implicit Parameter Bindings @@ -3530,7 +3530,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | dbind { let this = $1 in this `seq` (sL1 (reLoc $1) [this]) } + | dbind { let this = $1 in this `seq` (sL1 $1 [this]) } -- | {- empty -} { [] } dbind :: { LIPBind GhcPs } @@ -3572,10 +3572,10 @@ name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } : '(' name_boolformula ')' {% amsrl (sLL $1 $> (Parens $2)) (AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) } - | name_var { reLocA $ sL1N $1 (Var $1) } + | name_var { sL1a $1 (Var $1) } namelist :: { Located [LocatedN RdrName] } -namelist : name_var { sL1N $1 [$1] } +namelist : name_var { sL1 $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -3608,11 +3608,11 @@ con :: { LocatedN RdrName } | sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) } con_list :: { Located (NonEmpty (LocatedN RdrName)) } -con_list : con { sL1N $1 (pure $1) } +con_list : con { sL1 $1 (pure $1) } | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } -qcon_list : qcon { sL1N $1 [$1] } +qcon_list : qcon { sL1 $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -4117,28 +4117,16 @@ sL0 :: a -> Located a sL0 = L noSrcSpan -- #define L0 L noSrcSpan {-# INLINE sL1 #-} -sL1 :: GenLocated l a -> b -> GenLocated l b -sL1 x = sL (getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1A #-} -sL1A :: LocatedAn t a -> b -> Located b -sL1A x = sL (getLocA x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1N #-} -sL1N :: LocatedN a -> b -> Located b -sL1N x = sL (getLocA x) -- #define sL1 sL (getLoc $1) +sL1 :: HasLoc a => a -> b -> Located b +sL1 x = sL (getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1a #-} -sL1a :: Located a -> b -> LocatedAn t b -sL1a x = sL (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1l #-} -sL1l :: LocatedAn t a -> b -> LocatedAn u b -sL1l x = sL (l2l $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1a :: HasLoc a => a -> b -> LocatedAn t b +sL1a x = sL (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1n #-} -sL1n :: Located a -> b -> LocatedN b -sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1n :: HasLoc a => a -> b -> LocatedN b +sL1n x = L (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b23db0314139a4ad453c590a184efb54bc842dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b23db0314139a4ad453c590a184efb54bc842dd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 09:35:39 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 05:35:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/enable-more-jobs Message-ID: <64b8ffeb72638_78d13b77f0600a5@gitlab.mail> Matthew Pickering pushed new branch wip/enable-more-jobs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/enable-more-jobs You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 09:44:05 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 05:44:05 -0400 Subject: [Git][ghc/ghc][wip/test-primops] 8 commits: Remove unused files in .gitlab Message-ID: <64b901e5da8c6_78d13b782c63982@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 20572e71 by Matthew Pickering at 2023-07-20T10:43:09+01:00 Add zstd suffix to jobs which rely on zstd This was causing some confusion as the job was named simply "x86_64-linux-deb10-validate", which implies a standard configuration rather than any dependency on libzstd. - - - - - e7b64f7f by Matthew Pickering at 2023-07-20T10:43:10+01:00 ci: Always run project-version job This is needed for the downstream test-primops pipeline to workout what the version of a bindist produced by a pipeline is. - - - - - 8c3c7d16 by Matthew Pickering at 2023-07-20T10:43:10+01:00 gen_ci: Rework how jobs-metadata.json is generated * We now represent a job group a triple of Maybes, which makes it easier to work out when jobs are enabled/disabled on certain pipelines. ``` data JobGroup a = StandardTriple { v :: Maybe (NamedJob a) , n :: Maybe (NamedJob a) , r :: Maybe (NamedJob a) } ``` * `jobs-metadata.json` generation is reworked using the following algorithm. - For each pipeline type, find all the platforms we are doing builds for. - Select one build per platform - Zip together the results This way we can choose different pipelines for validate/nightly/release which makes the metadata also useful for validate pipelines. This feature is used by the test-primops downstream CI in order to select the right bindist for testing validate pipelines. This makes it easier to inspect which jobs are going to be enabled on a particular pipeline. - - - - - b1d743ed by Matthew Pickering at 2023-07-20T10:43:10+01:00 ci: Add support for triggering test-primops pipelines This commit adds 4 ways to trigger testing with test-primops. 1. Applying the ~test-primops label to a validate pipeline. 2. A manually triggered job on a validate pipeline 3. A nightly pipeline job 4. A release pipeline job Fixes #23695 - - - - - 6 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Parser.y Changes: ===================================== .gitlab-ci.yml ===================================== @@ -432,7 +432,7 @@ hadrian-multi: paths: - cabal-cache rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # stack-hadrian-build @@ -806,6 +806,63 @@ release-hackage-lint: # No slow-validate bindist on release pipeline EXTRA_HC_OPTS: "-dlint" +############################################################ +# Testing via test-primops +############################################################ + +# Triggering jobs in the ghc/test-primops project + +.test-primops: + stage: testing + variables: + UPSTREAM_PROJECT_PATH: "$CI_PROJECT_PATH" + UPSTREAM_PROJECT_ID: "$CI_PROJECT_ID" + UPSTREAM_PIPELINE_ID: "$CI_PIPELINE_ID" + trigger: + project: "ghc/test-primops" + branch: "upstream-testing" + strategy: "depend" + +.test-primops-validate-template: + needs: + - job: x86_64-linux-deb10-validate+debug_info + artifacts: false + - job: aarch64-linux-deb10-validate + artifacts: false + - job: aarch64-darwin-validate + artifacts: false + - job: x86_64-darwin-validate + artifacts: false + extends: .test-primops + +test-primops-validate: + extends: .test-primops-validate-template + when: manual + +test-primops-label: + extends: .test-primops-validate-template + rules: + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*test-primops.*/' + +test-primops-nightly: + extends: .test-primops + needs: + - job: nightly-x86_64-linux-deb10-validate + artifacts: false + - job: nightly-aarch64-linux-deb10-validate + artifacts: false + - job: nightly-aarch64-darwin-validate + artifacts: false + - job: nightly-x86_64-darwin-validate + artifacts: false + rules: + - if: $NIGHTLY + +test-primops-release: + extends: .test-primops + rules: + - if: '$RELEASE_JOB == "yes"' + ############################################################ # Nofib testing # (Disabled: See #21859) @@ -830,7 +887,7 @@ perf-nofib: - if: $CI_MERGE_REQUEST_ID - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' tags: - x86_64-linux before_script: @@ -897,7 +954,7 @@ perf: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # ABI testing @@ -937,7 +994,7 @@ abi-test: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ @@ -1000,9 +1057,6 @@ project-version: artifacts: paths: - version.sh - rules: - - if: '$NIGHTLY' - - if: '$RELEASE_JOB == "yes"' .ghcup-metadata: stage: deploy ===================================== .gitlab/gen-ci.cabal deleted ===================================== @@ -1,18 +0,0 @@ -cabal-version: 3.0 -name: gen-ci -version: 0.1.0.0 -build-type: Simple - -common warnings - ghc-options: -Wall - -executable gen_ci - import: warnings - main-is: gen_ci.hs - build-depends: - , aeson >=1.8.1 - , base - , bytestring - , containers - - default-language: Haskell2010 ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ViewPatterns #-} import Data.Aeson as A import qualified Data.Map as Map @@ -10,10 +11,10 @@ import Data.Map (Map) import Data.Maybe import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as B -import Data.List (intercalate) import Data.Set (Set) import qualified Data.Set as S import System.Environment +import Data.List {- Note [Generating the CI pipeline] @@ -314,6 +315,7 @@ testEnv arch opsys bc = intercalate "-" $ ++ ["int_" ++ bignumString (bignumBackend bc) | bignumBackend bc /= Gmp] ++ ["unreg" | unregisterised bc ] ++ ["numa" | withNuma bc ] + ++ ["zstd" | withZstd bc ] ++ ["no_tntc" | not (tablesNextToCode bc) ] ++ ["cross_"++triple | Just triple <- pure $ crossTarget bc ] ++ [flavourString (mkJobFlavour bc)] @@ -556,7 +558,8 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set +data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present @@ -578,7 +581,7 @@ false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String ruleString On FastCI = true -ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" +ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" @@ -741,11 +744,11 @@ modifyJobs = fmap -- | Modify just the validate jobs in a 'JobGroup' modifyValidateJobs :: (a -> a) -> JobGroup a -> JobGroup a -modifyValidateJobs f jg = jg { v = f <$> v jg } +modifyValidateJobs f jg = jg { v = fmap f <$> v jg } -- | Modify just the nightly jobs in a 'JobGroup' modifyNightlyJobs :: (a -> a) -> JobGroup a -> JobGroup a -modifyNightlyJobs f jg = jg { n = f <$> n jg } +modifyNightlyJobs f jg = jg { n = fmap f <$> n jg } -- Generic helpers @@ -767,17 +770,25 @@ delVariable k j = j { jobVariables = MonoidalMap $ Map.delete k $ unMonoidalMap validate :: Arch -> Opsys -> BuildConfig -> NamedJob Job validate = job +-- Nightly and release apply the FastCI configuration to all jobs so that they all run in +-- the pipeline (not conditional on the full-ci label) +nightlyRule :: Job -> Job +nightlyRule = addJobRule FastCI . addJobRule Nightly + +releaseRule :: Job -> Job +releaseRule = addJobRule FastCI . addJobRule ReleaseOnly + -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job nightly arch opsys bc = let NamedJob n j = job arch opsys bc - in NamedJob { name = "nightly-" ++ n, jobInfo = addJobRule Nightly . keepArtifacts "8 weeks" . highCompression $ j} + in NamedJob { name = "nightly-" ++ n, jobInfo = nightlyRule . keepArtifacts "8 weeks" . highCompression $ j} -- | Make a normal release CI job release :: Arch -> Opsys -> BuildConfig -> NamedJob Job release arch opsys bc = let NamedJob n j = job arch opsys (bc { buildFlavour = Release }) - in NamedJob { name = "release-" ++ n, jobInfo = addJobRule ReleaseOnly . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} + in NamedJob { name = "release-" ++ n, jobInfo = releaseRule . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} -- Specific job modification functions @@ -806,6 +817,7 @@ useHashUnitIds :: Job -> Job useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode +-- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job fastCI = modifyValidateJobs (addJobRule FastCI) @@ -821,9 +833,9 @@ addValidateRule t = modifyValidateJobs (addJobRule t) -- | Don't run the validate job, normally used to alleviate CI load by marking -- jobs which are unlikely to fail (ie different linux distros) disableValidate :: JobGroup Job -> JobGroup Job -disableValidate = addValidateRule Disable +disableValidate st = st { v = Nothing } -data NamedJob a = NamedJob { name :: String, jobInfo :: a } deriving Functor +data NamedJob a = NamedJob { name :: String, jobInfo :: a } deriving (Show, Functor) renameJob :: (String -> String) -> NamedJob a -> NamedJob a renameJob f (NamedJob n i) = NamedJob (f n) i @@ -833,31 +845,32 @@ instance ToJSON a => ToJSON (NamedJob a) where [ "name" A..= name nj , "jobInfo" A..= jobInfo nj ] + +--data NamedJobGroup a = NamedJobGroup { platform :: String, jg :: JobGroup a } + -- Jobs are grouped into either triples or pairs depending on whether the -- job is just validate and nightly, or also release. -data JobGroup a = StandardTriple { v :: NamedJob a - , n :: NamedJob a - , r :: NamedJob a } - | ValidateOnly { v :: NamedJob a - , n :: NamedJob a } deriving Functor +data JobGroup a = StandardTriple { v :: Maybe (NamedJob a) + , n :: Maybe (NamedJob a) + , r :: Maybe (NamedJob a) } deriving (Functor, Show) instance ToJSON a => ToJSON (JobGroup a) where - toJSON jg = object - [ "n" A..= n jg - , "r" A..= r jg + toJSON StandardTriple{..} = object + [ "v" A..= v + , "n" A..= n + , "r" A..= r ] rename :: (String -> String) -> JobGroup a -> JobGroup a -rename f (StandardTriple nv nn nr) = StandardTriple (renameJob f nv) (renameJob f nn) (renameJob f nr) -rename f (ValidateOnly nv nn) = ValidateOnly (renameJob f nv) (renameJob f nn) +rename f (StandardTriple nv nn nr) = StandardTriple (renameJob f <$> nv) (renameJob f <$> nn) (renameJob f <$> nr) -- | Construct a 'JobGroup' which consists of a validate, nightly and release build with -- a specific config. standardBuildsWithConfig :: Arch -> Opsys -> BuildConfig -> JobGroup Job standardBuildsWithConfig a op bc = - StandardTriple (validate a op bc) - (nightly a op bc) - (release a op bc) + StandardTriple (Just (validate a op bc)) + (Just (nightly a op bc)) + (Just (release a op bc)) -- | Construct a 'JobGroup' which consists of a validate, nightly and release builds with -- the 'vanilla' config. @@ -867,11 +880,12 @@ standardBuilds a op = standardBuildsWithConfig a op vanilla -- | Construct a 'JobGroup' which just consists of a validate and nightly build. We don't -- produce releases for these jobs. validateBuilds :: Arch -> Opsys -> BuildConfig -> JobGroup Job -validateBuilds a op bc = ValidateOnly (validate a op bc) (nightly a op bc) +validateBuilds a op bc = StandardTriple { v = Just (validate a op bc) + , n = Just (nightly a op bc) + , r = Nothing } flattenJobGroup :: JobGroup a -> [(String, a)] -flattenJobGroup (StandardTriple a b c) = map flattenNamedJob [a,b,c] -flattenJobGroup (ValidateOnly a b) = map flattenNamedJob [a, b] +flattenJobGroup (StandardTriple a b c) = map flattenNamedJob (catMaybes [a,b,c]) flattenNamedJob :: NamedJob a -> (String, a) flattenNamedJob (NamedJob n i) = (n, i) @@ -888,7 +902,7 @@ job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf , validateBuilds Amd64 (Linux Debian10) nativeInt - , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) + , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure @@ -907,7 +921,7 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla)) -- Fedora33 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - , standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig + , fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) @@ -915,8 +929,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) - , standardBuilds AArch64 Darwin - , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) + , fastCI (standardBuilds AArch64 Darwin) + , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. @@ -983,27 +997,51 @@ mkPlatform arch opsys = archName arch <> "-" <> opsysName opsys -- * Prefer jobs which have a corresponding release pipeline -- * Explicitly require tie-breaking for other cases. platform_mapping :: Map String (JobGroup BindistInfo) -platform_mapping = Map.map go $ - Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ v j)), j) | j <- filter hasReleaseBuild job_groups ] +platform_mapping = Map.map go combined_result where whitelist = [ "x86_64-linux-alpine3_12-validate" - , "x86_64-linux-deb10-validate" , "x86_64-linux-deb11-validate" + , "x86_64-linux-deb10-validate+debug_info" , "x86_64-linux-fedora33-release" + , "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" , "x86_64-windows-validate" + , "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" + , "nightly-x86_64-linux-deb11-validate" + , "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" + , "nightly-aarch64-linux-deb10-validate" + , "nightly-x86_64-linux-alpine3_12-validate" + , "nightly-x86_64-linux-deb10-validate" + , "nightly-x86_64-linux-fedora33-release" + , "nightly-x86_64-windows-validate" + , "release-x86_64-linux-alpine3_12-release+no_split_sections" + , "release-x86_64-linux-deb10-release" + , "release-x86_64-linux-deb11-release" + , "release-x86_64-linux-fedora33-release" + , "release-x86_64-windows-release+no_split_sections" ] + process sel = Map.fromListWith combine [ (uncurry mkPlatform (jobPlatform (jobInfo $ j)), j) | (sel -> Just j) <- job_groups ] + + vs = process v + ns = process n + rs = process r + + all_platforms = Map.keysSet vs <> Map.keysSet ns <> Map.keysSet rs + + combined_result = Map.fromList [ (p, StandardTriple { v = Map.lookup p vs + , n = Map.lookup p ns + , r = Map.lookup p rs }) + | p <- S.toList all_platforms ] + combine a b - | name (v a) `elem` whitelist = a -- Explicitly selected - | name (v b) `elem` whitelist = b - | otherwise = error (show (name (v a)) ++ show (name (v b))) + | name a `elem` whitelist = a -- Explicitly selected + | name b `elem` whitelist = b + | otherwise = error (show (name a) ++ show (name b)) go = fmap (BindistInfo . unwords . fromJust . mmlookup "BIN_DIST_NAME" . jobVariables) - hasReleaseBuild (StandardTriple{}) = True - hasReleaseBuild (ValidateOnly{}) = False -data BindistInfo = BindistInfo { bindistName :: String } +data BindistInfo = BindistInfo { bindistName :: String } deriving Show instance ToJSON BindistInfo where toJSON (BindistInfo n) = object [ "bindistName" A..= n ] ===================================== .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml ===================================== ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1558,7 +1558,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1622,7 +1622,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1687,7 +1687,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1749,7 +1749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1811,7 +1811,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1873,7 +1873,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1937,7 +1937,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2002,7 +2002,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2066,7 +2066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2129,7 +2129,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2191,7 +2191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2249,7 +2249,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2311,7 +2311,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2377,7 +2377,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2444,7 +2444,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2508,7 +2508,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2572,7 +2572,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2774,7 +2774,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2840,7 +2840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2904,7 +2904,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2968,7 +2968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3032,7 +3032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3096,7 +3096,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3160,7 +3160,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3224,7 +3224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3290,7 +3290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3356,7 +3356,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3486,7 +3486,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3550,7 +3550,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3610,7 +3610,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3673,7 +3673,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3740,7 +3740,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3808,7 +3808,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3871,7 +3871,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3935,7 +3935,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3999,7 +3999,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4063,7 +4063,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4126,7 +4126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4188,7 +4188,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4311,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4335,7 +4335,7 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, - "x86_64-linux-deb10-validate": { + "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4346,7 +4346,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate.tar.xz", + "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4372,7 +4372,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4389,14 +4389,14 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", + "BUILD_FLAVOUR": "validate+debug_info", + "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate" + "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, - "x86_64-linux-deb10-validate+debug_info": { + "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4407,7 +4407,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", + "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4433,7 +4433,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4450,14 +4450,14 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", - "BUILD_FLAVOUR": "validate+debug_info", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", + "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" + "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, - "x86_64-linux-deb10-validate+llvm": { + "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4468,7 +4468,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", + "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4494,8 +4494,9 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" + "allow_failure": true, + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "when": "manual" } ], "script": [ @@ -4511,14 +4512,16 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", - "BUILD_FLAVOUR": "validate+llvm", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", + "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", + "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+llvm" + "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", + "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } }, - "x86_64-linux-deb10-validate+thread_sanitizer": { + "x86_64-linux-deb10-zstd-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -4529,7 +4532,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -4555,9 +4558,8 @@ ], "rules": [ { - "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "manual" + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "when": "on_success" } ], "script": [ @@ -4573,13 +4575,11 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", - "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", - "HADRIAN_ARGS": "--docs=none", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", - "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" + "TEST_ENV": "x86_64-linux-deb10-zstd-validate" } }, "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { @@ -4619,7 +4619,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4682,7 +4682,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4746,7 +4746,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4807,7 +4807,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Parser.y ===================================== @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 $1 $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1073,11 +1073,11 @@ qcnames1 :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list -- Variable, data constructor or wildcard -- or tagged type constructor qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } - : qcname_ext { sL1A $1 ([],$1) } - | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } + : qcname_ext { sL1 $1 ([],$1) } + | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } qcname_ext :: { LocatedA ImpExpQcSpec } - : qcname { reLocA $ sL1N $1 (ImpExpQcName $1) } + : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} @@ -1231,7 +1231,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } - | op { sL1N $1 (unitOL $1) } + | op { sL1 $1 (unitOL $1) } ----------------------------------------------------------------------------- -- Top-Level Declarations @@ -1265,12 +1265,12 @@ topdecl_cs : topdecl {% commentsPA $1 } ----------------------------------------------------------------------------- topdecl :: { LHsDecl GhcPs } - : cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | standalone_kind_sig { sL1 $1 (KindSigD noExtField (unLoc $1)) } - | inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) } - | stand_alone_deriving { sL1 $1 (DerivD noExtField (unLoc $1)) } - | role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) } + : cl_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | ty_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | standalone_kind_sig { sL1a $1 (KindSigD noExtField (unLoc $1)) } + | inst_decl { sL1a $1 (InstD noExtField (unLoc $1)) } + | stand_alone_deriving { sL1a $1 (DerivD noExtField (unLoc $1)) } + | role_annot { sL1a $1 (RoleAnnotD noExtField (unLoc $1)) } | 'default' '(' comma_types0 ')' {% acsA (\cs -> sLL $1 $> (DefD noExtField (DefaultDecl (EpAnn (glR $1) [mj AnnDefault $1,mop $2,mcp $4] cs) $3))) } | 'foreign' fdecl {% acsA (\cs -> sLL $1 $> ((snd $ unLoc $2) (EpAnn (glR $1) (mj AnnForeign $1:(fst $ unLoc $2)) cs))) } @@ -1358,7 +1358,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | oqtycon { sL1N $1 [$1] } + | oqtycon { sL1 $1 [$1] } inst_decl :: { LInstDecl GhcPs } : 'instance' overlap_pragma inst_type where_inst @@ -1438,7 +1438,7 @@ injectivity_cond :: { LInjectivityAnn GhcPs } inj_varids :: { Located [LocatedN RdrName] } : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } - | tyvarid { sL1N $1 [$1] } + | tyvarid { sL1 $1 [$1] } -- Closed type families @@ -1588,7 +1588,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] - , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } + , (sL1a $> (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] @@ -1603,7 +1603,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } - | type { sL1A $1 (Nothing, $1) } + | type { sL1 $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 @@ -1620,7 +1620,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } - | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } + | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) } capi_ctype :: { Maybe (LocatedP CType) } @@ -1755,7 +1755,7 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl_cls { sL1A $1 ([], unitOL $1) } + | decl_cls { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist_cls @@ -1781,8 +1781,8 @@ where_cls :: { Located ([AddEpAnn] -- Declarations in instance bodies -- decl_inst :: { Located (OrdList (LHsDecl GhcPs)) } -decl_inst : at_decl_inst { sL1A $1 (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) } - | decl { sL1A $1 (unitOL $1) } +decl_inst : at_decl_inst { sL1 $1 (unitOL (sL1a $1 (InstD noExtField (unLoc $1)))) } + | decl { sL1 $1 (unitOL $1) } decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_inst ';' decl_inst {% if isNilOL (snd $ unLoc $1) @@ -1842,7 +1842,7 @@ decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl { sL1A $1 ([], unitOL $1) } + | decl { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } @@ -1957,7 +1957,7 @@ rule_vars :: { [LRuleTyTmVar] } | {- empty -} { [] } rule_var :: { LRuleTyTmVar } - : varid { sL1l $1 (RuleTyTmVar noAnn $1 Nothing) } + : varid { sL1a $1 (RuleTyTmVar noAnn $1 Nothing) } | '(' varid '::' ctype ')' {% acsA (\cs -> sLL $1 $> (RuleTyTmVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3,mcp $5] cs) $2 (Just $4))) } {- Note [Parsing explicit foralls in Rules] @@ -2143,7 +2143,7 @@ sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | var { sL1N $1 [$1] } + | var { sL1 $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } : sigtype { unitOL $1 } @@ -2266,11 +2266,11 @@ tyop :: { (LocatedN RdrName, PromotionFlag) } ; return (op, IsPromoted) } } atype :: { LHsType GhcPs } - : ntgtycon {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples + : ntgtycon {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples -- See Note [%shift: atype -> tyvar] - | tyvar %shift {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) + | tyvar %shift {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) - ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } + ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } @@ -2354,7 +2354,7 @@ tv_bndr :: { LHsTyVarBndr Specificity GhcPs } | '{' tyvar '::' kind '}' {% acsA (\cs -> sLL $1 $> (KindedTyVar (EpAnn (glR $1) [moc $1,mu AnnDcolon $3 ,mcc $5] cs) InferredSpec $2 $4)) } tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } - : tyvar {% acsA (\cs -> (sL1 (reLocN $1) (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } + : tyvar {% acsA (\cs -> (sL1 $1 (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } | '(' tyvar '::' kind ')' {% acsA (\cs -> (sLL $1 $> (KindedTyVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3 ,mcp $5] cs) SpecifiedSpec $2 $4))) } fds :: { Located ([AddEpAnn],[LHsFunDep GhcPs]) } @@ -2367,7 +2367,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | fd { sL1A $1 [$1] } + | fd { sL1 $1 [$1] } fd :: { LHsFunDep GhcPs } : varids0 '->' varids0 {% acsA (\cs -> L (comb3 $1 $2 $3) @@ -2465,7 +2465,7 @@ constrs1 :: { Located [LConDecl GhcPs] } {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | constr { sL1A $1 [$1] } + | constr { sL1 $1 [$1] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff @@ -2519,7 +2519,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? - | deriving { sL1 (reLoc $>) [$1] } + | deriving { sL1 $> [$1] } -- The outer Located is just to allow the caller to -- know the rightmost extremity of the 'deriving' clause @@ -2537,9 +2537,9 @@ deriving :: { LHsDerivingClause GhcPs } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $3) $2) } deriv_clause_types :: { LDerivClauseTys GhcPs } - : qtycon { let { tc = sL1 (reLocL $1) $ mkHsImplicitSigType $ - sL1 (reLocL $1) $ HsTyVar noAnn NotPromoted $1 } in - sL1 (reLocC $1) (DctSingle noExtField tc) } + : qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $ + sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in + sL1a $1 (DctSingle noExtField tc) } | '(' ')' {% amsrc (sLL $1 $> (DctMulti noExtField [])) (AnnContext Nothing [glAA $1] [glAA $2]) } | '(' deriv_types ')' {% amsrc (sLL $1 $> (DctMulti noExtField $2)) @@ -2604,7 +2604,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } - | gdrh { sL1 (reLoc $1) [$1] } + | gdrh { sL1 $1 [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 -> @@ -2639,7 +2639,7 @@ sigdecl :: { LHsDecl GhcPs } (Fixity fixText fixPrec (unLoc $1))))) }} - | pattern_synonym_sig { sL1 $1 . SigD noExtField . unLoc $ $1 } + | pattern_synonym_sig { sL1a $1 . SigD noExtField . unLoc $ $1 } | '{-# COMPLETE' qcon_list opt_tyconsig '#-}' {% let (dcolon, tc) = $3 @@ -3236,7 +3236,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } -- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) } -- | '{|' pquals '|}' { sL1 $1 [$2] } @@ -3283,7 +3283,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } h' <- addTrailingCommaA h (gl $2) return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } ----------------------------------------------------------------------------- -- Case alternatives @@ -3321,7 +3321,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (fst $ unLoc $1, h' : t)) } - | alt(PATS) { $1 >>= \ $1 -> return $ sL1 (reLoc $1) ([],[$1]) } + | alt(PATS) { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) } alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) } : PATS alt_rhs { $2 >>= \ $2 -> @@ -3346,7 +3346,7 @@ gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } - | gdpat { $1 >>= \gdpat -> return $ sL1A gdpat [gdpat] } + | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to -- generate the open brace in addition to the vertical bar in the lexer, and @@ -3418,7 +3418,7 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( { h' <- addTrailingSemiA h (gl $2) ; return $ sL1 $1 (fst $ unLoc $1,h':t) }} | stmt { $1 >>= \ $1 -> - return $ sL1A $1 (nilOL,[$1]) } + return $ sL1 $1 (nilOL,[$1]) } | {- empty -} { return $ noLoc (nilOL,[]) } @@ -3444,7 +3444,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> - return $ sL1 $1 $ mkBodyStmt $1 } + return $ sL1a $1 $ mkBodyStmt $1 } | 'let' binds { acsA (\cs -> (sLL $1 $> $ mkLetStmt (EpAnn (glR $1) [mj AnnLet $1] cs) (unLoc $2))) } @@ -3467,13 +3467,13 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1a $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... | qvar { placeHolderPunRhs >>= \rhs -> - fmap Left $ acsa (\cs -> sL1a (reLocN $1) $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1l $1 $ mkFieldOcc $1) rhs True) } + fmap Left $ acsa (\cs -> sL1a $1 $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1a $1 $ mkFieldOcc $1) rhs True) } -- In the punning case, use a place-holder -- The renamer fills in the final value @@ -3481,7 +3481,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3497,7 +3497,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3514,7 +3514,7 @@ fieldToUpdate : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> - return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } + return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } ----------------------------------------------------------------------------- -- Implicit Parameter Bindings @@ -3530,7 +3530,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | dbind { let this = $1 in this `seq` (sL1 (reLoc $1) [this]) } + | dbind { let this = $1 in this `seq` (sL1 $1 [this]) } -- | {- empty -} { [] } dbind :: { LIPBind GhcPs } @@ -3572,10 +3572,10 @@ name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } : '(' name_boolformula ')' {% amsrl (sLL $1 $> (Parens $2)) (AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) } - | name_var { reLocA $ sL1N $1 (Var $1) } + | name_var { sL1a $1 (Var $1) } namelist :: { Located [LocatedN RdrName] } -namelist : name_var { sL1N $1 [$1] } +namelist : name_var { sL1 $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -3608,11 +3608,11 @@ con :: { LocatedN RdrName } | sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) } con_list :: { Located (NonEmpty (LocatedN RdrName)) } -con_list : con { sL1N $1 (pure $1) } +con_list : con { sL1 $1 (pure $1) } | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } -qcon_list : qcon { sL1N $1 [$1] } +qcon_list : qcon { sL1 $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -4117,28 +4117,16 @@ sL0 :: a -> Located a sL0 = L noSrcSpan -- #define L0 L noSrcSpan {-# INLINE sL1 #-} -sL1 :: GenLocated l a -> b -> GenLocated l b -sL1 x = sL (getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1A #-} -sL1A :: LocatedAn t a -> b -> Located b -sL1A x = sL (getLocA x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1N #-} -sL1N :: LocatedN a -> b -> Located b -sL1N x = sL (getLocA x) -- #define sL1 sL (getLoc $1) +sL1 :: HasLoc a => a -> b -> Located b +sL1 x = sL (getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1a #-} -sL1a :: Located a -> b -> LocatedAn t b -sL1a x = sL (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1l #-} -sL1l :: LocatedAn t a -> b -> LocatedAn u b -sL1l x = sL (l2l $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1a :: HasLoc a => a -> b -> LocatedAn t b +sL1a x = sL (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1n #-} -sL1n :: Located a -> b -> LocatedN b -sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1n :: HasLoc a => a -> b -> LocatedN b +sL1n x = L (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3f0fb8cb8df995f277666871edbab5bc4fc02bb...b1d743ed25348d2790b8d6866c051de4d279b3ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3f0fb8cb8df995f277666871edbab5bc4fc02bb...b1d743ed25348d2790b8d6866c051de4d279b3ac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 10:28:49 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 20 Jul 2023 06:28:49 -0400 Subject: [Git][ghc/ghc][wip/T22404] Try to get benefits of fast path with less duplication Message-ID: <64b90c619c3e3_78d13b781881772@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: e2326410 by Simon Peyton Jones at 2023-07-20T11:28:05+01:00 Try to get benefits of fast path with less duplication - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -955,10 +955,10 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine in WUD body_uds (combine [NonRec bndr rhs] res) -- /Existing/ non-recursive join points - -- Analyse the RHS and /then/ the body - | NotTopLevel <- lvl - , mb_join@(Just {}) <- isJoinId_maybe bndr - = let -- Analyse the rhs first, generating rhs_uds + -- See Note [Occurrence analysis for join points] + | mb_join@(Just {}) <- isJoinId_maybe bndr + = -- Analyse the RHS and /then/ the body + let -- Analyse the rhs first, generating rhs_uds !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs rhs_uds = foldr1 orUDs rhs_uds_s -- Note orUDs @@ -1007,10 +1007,13 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body else let - -- Get the join info from the *new* decision + -- Get the join info from the *new* decision; NB: bndr is not already a JoinId -- See Note [Join points and unfoldings/rules] -- => join arity O of Note [Join arity prediction based on joinRhsArity] - mb_join = willBeJoinId_maybe tagged_bndr + mb_join = case tailCallInfo (idOccInfo tagged_bndr) of + AlwaysTailCalled arity -> Just arity + _ -> Nothing + !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs` (combine [NonRec final_bndr rhs'] body) @@ -1050,8 +1053,9 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs -- hence adjust the UDs from the RHS WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ occAnalLamTail rhs_env rhs - final_bndr = bndr `setIdSpecialisation` mkRuleInfo rules' - `setIdUnfolding` unf2 + final_bndr | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdSpecialisation` mkRuleInfo rules' + `setIdUnfolding` unf2 --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] @@ -1076,9 +1080,10 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs -- that g is (since the RULE might turn g into h), so -- we make g mention h. - adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds - add_rule_uds (_, l, r) uds_s - = (l `andUDs` adjustTailArity mb_join r) : uds_s + adj_rule_uds :: [UsageDetails] + adj_rule_uds = imp_rule_uds ++ + [ l `andUDs` adjustTailArity mb_join r + | (_,l,r) <- rules_w_uds ] ---------- @@ -1703,8 +1708,9 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) , nd_weak_fvs = weak_fvs , nd_active_rule_fvs = active_rule_fvs } - bndr' = bndr `setIdUnfolding` unf' - `setIdSpecialisation` mkRuleInfo rules' + bndr' | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' -- NB: Both adj_unf_uds and adj_rule_uds have been adjusted to match the -- JoinArity rhs_ja of unadj_rhs_uds. @@ -2249,9 +2255,7 @@ occAnalUnfolding !env unf | isStableSource src -> let WTUD (TUD rhs_ja uds) rhs' = occAnalLamTail env rhs - - unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] - | otherwise = unf { uf_tmpl = rhs' } + unf' = unf { uf_tmpl = rhs' } in WTUD (TUD rhs_ja (markAllMany uds)) unf' -- markAllMany: see Note [Occurrences in stable unfoldings] @@ -2283,8 +2287,7 @@ occAnalRules !env bndr occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) = (rule', lhs_uds', TUD rhs_ja rhs_uds') where - rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] - | otherwise = rule { ru_args = args', ru_rhs = rhs' } + rule' = rule { ru_args = args', ru_rhs = rhs' } WUD lhs_uds args' = addInScope env bndrs $ \env -> occAnalList env args @@ -2803,6 +2806,7 @@ data OccEnv -- Vars (TyVars and Ids) free in the range of occ_bs_env -- Usage details of the RHS of in-scope non-recursive join points + -- See Note [Occurrence analysis for join points] , occ_join_points :: !(IdEnv OccInfoEnv) -- Invariant: no Id maps to emptyDetails } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e23264102f48d6e5b4efe85eb8c7087d8fb0d07a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e23264102f48d6e5b4efe85eb8c7087d8fb0d07a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 10:39:28 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 20 Jul 2023 06:39:28 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 65 commits: Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) Message-ID: <64b90ee0adefa_78d13b7804824ea@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 065bc7ed by Simon Peyton Jones at 2023-07-20T11:16:36+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - bbf2bf4a by Simon Peyton Jones at 2023-07-20T11:16:36+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The net result is good: a 2% improvement in compile time. The table below shows changes over 1%. The main changes are: * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * When making join points, don't do so if the join point is so small it will immediately be inlined. See Note [Duplicating alternatives] * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * Many new or rewritten Notes. E.g. Note [Avoiding simplifying repeatedly] I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I added an INLINE pragma to it. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -4.3% GOOD LargeRecord(normal) -23.3% GOOD PmSeriesS(normal) -2.4% T11195(normal) -1.7% T12227(normal) -20.0% GOOD T12545(normal) -5.4% T13253-spj(normal) -50.7% GOOD T13386(normal) -5.1% GOOD T14766(normal) -2.4% GOOD T15164(normal) -1.7% T15304(normal) +1.0% T15630(normal) -7.7% T15630a(normal) NEW T15703(normal) -7.5% GOOD T16577(normal) -5.1% GOOD T17516(normal) -3.6% T18223(normal) -16.8% GOOD T18282(normal) -1.5% T18304(normal) +1.9% T21839c(normal) -3.5% GOOD T3064(normal) -1.5% T5030(normal) -16.2% GOOD T5321Fun(normal) -1.6% T6048(optasm) -2.1% GOOD T8095(normal) -6.1% GOOD T9630(normal) -5.1% GOOD WWRec(normal) -1.6% geo. mean -2.1% minimum -50.7% maximum +1.9% Metric Decrease: CoOpt_Singletons LargeRecord T12227 T13253-spj T13386 T14766 T15703 T16577 T18223 T21839c T5030 T6048 T8095 T9630 - - - - - 8e6aa720 by Simon Peyton Jones at 2023-07-20T11:16:36+01:00 No postInlineUnconditionally for strict bindings Does not save allocation! - - - - - 7c57f6e9 by Simon Peyton Jones at 2023-07-20T11:16:37+01:00 No preInlineConditionally for join points Does not save allocation! - - - - - 5b6eee2d by Simon Peyton Jones at 2023-07-20T11:16:37+01:00 Don't use Plan A for a case continuation See carryPropagate in digits-of-e2 Really I'm moving more towards Plan B. - - - - - c73292b2 by Simon Peyton Jones at 2023-07-20T11:38:48+01:00 Fix merge bugs - - - - - 19 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90d96f337e1bb24e98775a3febd806f6eb7e0888...c73292b26c9d17e22f9ba368555c632a85d36bd1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90d96f337e1bb24e98775a3febd806f6eb7e0888...c73292b26c9d17e22f9ba368555c632a85d36bd1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 11:27:23 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 20 Jul 2023 07:27:23 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Further wibbles Message-ID: <64b91a1b830cf_78d13b7840891bf@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 6f86cc3b by Simon Peyton Jones at 2023-07-20T12:26:19+01:00 Further wibbles In particular simplifying SelCo in Coercion.Opt - - - - - 4 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Rep.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Core.Coercion ( mkAxInstLHS, mkUnbranchedAxInstLHS, mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, - mkSelCo, mkSelCoResRole, getNthFun, getNthFromType, mkLRCo, + mkSelCo, mkSelCoResRole, getNthFun, selectFromType, mkLRCo, mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo, mkNakedFunCo, @@ -1127,8 +1127,8 @@ mkSymCo :: Coercion -> Coercion mkSymCo co | isReflCo co = co mkSymCo (SymCo co) = co mkSymCo (SubCo (SymCo co)) = SubCo co -mkSymCo (ForAllCo { fco_kind = kco, fco_body = co }) - | isReflCo kco = co { fco_body = mkSymCo co } +mkSymCo co@(ForAllCo { fco_kind = kco, fco_body = body_co }) + | isReflCo kco = co { fco_body = mkSymCo body_co } mkSymCo co = SymCo co -- | Create a new 'Coercion' by composing the two given 'Coercion's transitively. @@ -1160,7 +1160,7 @@ mkSelCo_maybe cs co go cs co | Just (ty, r) <- isReflCo_maybe co - = Just (mkReflCo (mkSelCoResRole cs r) (getNthFromType cs ty)) + = Just (mkReflCo (mkSelCoResRole cs r) (selectFromType cs ty)) go SelForAll (ForAllCo { fco_kind = kind_co }) = Just kind_co @@ -1229,22 +1229,22 @@ getNthFun SelMult mult _ _ = mult getNthFun SelArg _ arg _ = arg getNthFun SelRes _ _ res = res -getNthFromType :: HasDebugCallStack => CoSel -> Type -> Type -getNthFromType (SelFun fs) ty +selectFromType :: HasDebugCallStack => CoSel -> Type -> Type +selectFromType (SelFun fs) ty | Just (_af, mult, arg, res) <- splitFunTy_maybe ty = getNthFun fs mult arg res -getNthFromType (SelTyCon n _) ty +selectFromType (SelTyCon n _) ty | Just args <- tyConAppArgs_maybe ty = assertPpr (args `lengthExceeds` n) (ppr n $$ ppr ty) $ args `getNth` n -getNthFromType SelForAll ty -- Works for both tyvar and covar +selectFromType SelForAll ty -- Works for both tyvar and covar | Just (tv,_) <- splitForAllTyCoVar_maybe ty = tyVarKind tv -getNthFromType cs ty - = pprPanic "getNthFromType" (ppr cs $$ ppr ty) +selectFromType cs ty + = pprPanic "selectFromType" (ppr cs $$ ppr ty) -------------------- mkLRCo :: LeftOrRight -> Coercion -> Coercion @@ -2443,7 +2443,7 @@ coercionLKind co go (InstCo aco arg) = go_app aco [go arg] go (KindCo co) = typeKind (go co) go (SubCo co) = go co - go (SelCo d co) = getNthFromType d (go co) + go (SelCo d co) = selectFromType d (go co) go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos) go (AxiomRuleCo ax cos) = pFst $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos @@ -2487,7 +2487,7 @@ coercionRKind co go (InstCo aco arg) = go_app aco [go arg] go (KindCo co) = typeKind (go co) go (SubCo co) = go co - go (SelCo d co) = getNthFromType d (go co) + go (SelCo d co) = selectFromType d (go co) go (AxiomInstCo ax ind cos) = go_ax_inst ax ind (map go cos) go (AxiomRuleCo ax cos) = pSnd $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -24,10 +24,8 @@ import GHC.Core.Unify import GHC.Types.Var import GHC.Types.Var.Set import GHC.Types.Var.Env --- import GHC.Types.Unique.Set import GHC.Data.Pair -import GHC.Data.List.SetOps ( getNth ) import GHC.Utils.Outputable import GHC.Utils.Constants (debugIsOn) @@ -162,8 +160,6 @@ optCoercion' env co , text "out_ty2:" <+> ppr out_ty2 , text "in_role:" <+> ppr in_role , text "out_role:" <+> ppr out_role --- , vcat $ map ppr_one $ nonDetEltsUniqSet $ coVarsOfCo co --- , text "subst:" <+> ppr env ] in warnPprTrace (not (isReflCo out_co) && isReflexiveCo out_co) @@ -209,10 +205,11 @@ opt_co2 :: LiftingContext -> Role -- ^ The role of the input coercion -> Coercion -> NormalCo opt_co2 env sym Phantom co = opt_phantom env sym co -opt_co2 env sym r co = opt_co3 env sym Nothing r co +opt_co2 env sym r co = opt_co4_wrap env sym False r co -- See Note [Optimising coercion optimisation] --- | Optimize a coercion, knowing the coercion's non-Phantom role. +-- | Optimize a coercion, knowing the coercion's non-Phantom role, +-- and with an optional downgrade opt_co3 :: LiftingContext -> SymFlag -> Maybe Role -> Role -> Coercion -> NormalCo opt_co3 env sym (Just Phantom) _ co = opt_phantom env sym co opt_co3 env sym (Just Representational) r co = opt_co4_wrap env sym True r co @@ -225,6 +222,7 @@ opt_co4, opt_co4_wrap :: LiftingContext -> SymFlag -> ReprFlag -> Role -> Coercion -> NormalCo -- Precondition: In every call (opt_co4 lc sym rep role co) -- we should have role = coercionRole co +-- Precondition: role is not Phantom -- Postcondition: The resulting coercion is equivalant to -- wrapsub (wrapsym (mksub co) -- where wrapsym is SymCo if sym=True @@ -385,45 +383,15 @@ opt_co4 env sym rep r (TransCo co1 co2) co2' = opt_co4_wrap env sym rep r co2 in_scope = lcInScopeSet env -opt_co4 env _sym rep r (SelCo n co) - | Just (ty, _co_role) <- isReflCo_maybe co - = liftCoSubst (chooseRole rep r) env (getNthFromType n ty) - -- NB: it is /not/ true that r = _co_role - -- Rather, r = coercionRole (SelCo n co) - -opt_co4 env sym rep r (SelCo (SelTyCon n r1) (TyConAppCo _ _ cos)) - = assert (r == r1 ) - opt_co4_wrap env sym rep r (cos `getNth` n) - --- see the definition of GHC.Builtin.Types.Prim.funTyCon -opt_co4 env sym rep r (SelCo (SelFun fs) (FunCo _r2 _afl _afr w co1 co2)) - = opt_co4_wrap env sym rep r (getNthFun fs w co1 co2) - -opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo { fco_kind = eta })) - -- works for both tyvar and covar - = opt_co4_wrap env sym rep Nominal eta - --- So the /input/ coercion isn't ForAllCo or Refl; --- instead look at the /output/ coercion opt_co4 env sym rep r (SelCo cs co) - | Just (ty, co_role) <- isReflCo_maybe co' - = mkReflCo (chooseRole rep (mkSelCoResRole cs co_role)) - (getNthFromType cs ty) - - | Just nth_co <- case (co', cs) of - (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n) - (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) - (ForAllCo { fco_kind = eta }, SelForAll) -> Just eta - _ -> Nothing - = if rep && (r == Nominal) - -- keep propagating the SubCo - then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co - else nth_co - - | otherwise - = wrapRole rep r $ SelCo cs co' - where - co' = opt_co1 env sym co + -- Historical note 1: we used to check `co` for Refl, TyConAppCo etc + -- before optimising `co`; but actually the SelCo will have been built + -- with mkSelCo, so these tests always fail. + + -- Historical note 2: if rep=True and r=Nominal, we used to recursively + -- call opt_co4 to re-optimse the result. But (a) that is inefficient + -- and (b) wrapRole uses mkSubCo which does much the same job + = wrapRole rep r $ mkSelCo cs $ opt_co1 env sym co opt_co4 env sym rep r (LRCo lr co) | Just pr_co <- splitAppCo_maybe co ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -417,10 +417,10 @@ simplAuxBind _str env bndr new_rhs = return (emptyFloats env, env) -- Here c is dead, and we avoid -- creating the binding c = (a,b) - -- The cases would be inlined unconditionally by completeBind: - -- but it seems not uncommon, and it turns to be a little more + -- Next we have a fast-path for cases that would be inlined unconditionally by + -- completeBind: but it seems not uncommon, and it turns to be a little more -- efficient (in compile time allocations) to do it here. - -- Effectively this is just a poor man's postInlineUnconditionally + -- Effectively this is just a vastly-simplified postInlineUnconditionally -- See Note [Post-inline for single-use things] in GHC.Core.Opt.Simplify.Utils -- Note: auxiliary bindings have no NOLINE pragmas, RULEs, or stable unfoldings | exprIsTrivial new_rhs -- Short-cut for let x = y in ... @@ -1338,10 +1338,10 @@ simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co = do { let opt_co | reSimplifying env = substCo env co | otherwise = optCoercion opts subst co - -- If (reSimplifying env) is True we have already - -- simplified this coercion once, and we don't - -- want do so again; doing so repeatedly risks - -- non-linear behaviour + -- If (reSimplifying env) is True we have already simplified + -- this coercion once, and we don't want do so again; doing + -- so repeatedly risks non-linear behaviour + -- See Note [Inline depth] in GHC.Core.Opt.Simplify.Env ; seqCo opt_co `seq` return opt_co } where subst = getSubst env @@ -4022,8 +4022,8 @@ Note [Duplicating alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When should we duplicate an alternative, and when should we make a join point? We don't want to make a join point if it will /definitely/ be inlined; that -takes extra work to build, and an extra Simplifier iteration to do the inlining. -So consider +just takes extra work to build, and an extra Simplifier iteration to do the +inlining. So consider case (case x of True -> e2; False -> e2) of K1 a b -> f b a @@ -4035,10 +4035,13 @@ The (f b a) would turn into a join point like which would immediately inline again because the call is not smaller than the RHS. On the other hand, the (g x v) turns into $j2 x = g x v -which won't imediately inline. Finally the (Just v) would turn into +which won't imediately inline, because the call $j2 x is smaller than the RHS +(g x v). Finally the (Just v) would turn into $j3 v = Just v and you might think that would immediately inline. +TODO -- more here + Note [Fusing case continuations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important to fuse two successive case continuations when the ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -1100,7 +1100,7 @@ SelTyCon, SelForAll, and SelFun. * SelForAll: co : forall (a:k1).t1 ~r0 forall (a:k2).t2 ---------------------------------- - SelCo SelForAll : k1 ~N k2 + SelCo SelForAll co : k1 ~N k2 NB: SelForAll always gives a Nominal coercion. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f86cc3bddfd6ca88d437cf86fef2d221c114001 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f86cc3bddfd6ca88d437cf86fef2d221c114001 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 11:34:35 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 07:34:35 -0400 Subject: [Git][ghc/ghc][wip/test-primops] 2 commits: Rules rework Message-ID: <64b91bcb3edce_78d13b7868918b7@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: f5d03b06 by Matthew Pickering at 2023-07-20T12:34:03+01:00 Rules rework - - - - - 0a076272 by Matthew Pickering at 2023-07-20T12:34:03+01:00 Add test-primops label support - - - - - 2 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -11,7 +11,6 @@ import Data.Map (Map) import Data.Maybe import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as B -import Data.Set (Set) import qualified Data.Set as S import System.Environment import Data.List @@ -505,21 +504,33 @@ instance ToJSON ArtifactsWhen where ----------------------------------------------------------------------------- -- Data structure which records the condition when a job is run. -data OnOffRules = OnOffRules { rule_set :: Set Rule -- ^ The set of enabled rules +data OnOffRules = OnOffRules { _rule_set :: Rule -- ^ The set of enabled rules , when :: ManualFlag -- ^ The additional condition about when to run this job. } -- The initial set of rules where all rules are disabled and the job is always run. emptyRules :: OnOffRules -emptyRules = OnOffRules S.empty OnSuccess +emptyRules = OnOffRules (ValidateOnly (S.singleton FullCI)) OnSuccess -- When to run the job data ManualFlag = Manual -- ^ Only run the job when explicitly triggered by a user | OnSuccess -- ^ Always run it, if the rules pass (the default) deriving Eq -enableRule :: Rule -> OnOffRules -> OnOffRules -enableRule r (OnOffRules o m) = OnOffRules (S.insert r o) m +setRule :: Rule -> OnOffRules -> OnOffRules +setRule r (OnOffRules _ m) = OnOffRules r m + +enableValidateRule :: ValidateRule -> OnOffRules -> OnOffRules +enableValidateRule r (OnOffRules (ValidateOnly rs) m) = OnOffRules (ValidateOnly (S.insert r rs)) m +enableValidateRule r _ = error $ "Applying validate rule to nightly/release job:" ++ show r + +onlyValidateRule :: ValidateRule -> OnOffRules -> OnOffRules +onlyValidateRule r (OnOffRules (ValidateOnly {}) m) = OnOffRules (ValidateOnly (S.singleton r)) m +onlyValidateRule r _ = error $ "Applying validate rule to nightly/release job:" ++ show r + +removeValidateRule :: ValidateRule -> OnOffRules -> OnOffRules +removeValidateRule r (OnOffRules (ValidateOnly rs) m) = OnOffRules (ValidateOnly (S.delete r rs)) m +removeValidateRule r _ = error $ "Applying validate rule to nightly/release job:" ++ show r manualRule :: OnOffRules -> OnOffRules manualRule rules = rules { when = Manual } @@ -528,10 +539,19 @@ manualRule rules = rules { when = Manual } -- For example, even if you don't explicitly disable a rule it will end up in the -- rule list with the OFF state. enumRules :: OnOffRules -> [OnOffRule] -enumRules o = map lkup rulesList +enumRules (OnOffRules r _) = rulesList where - enabled_rules = rule_set o - lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r + rulesList = case r of + ValidateOnly rs -> [OnOffRule On (ValidateOnly rs) + , OnOffRule Off ReleaseOnly + , OnOffRule Off Nightly ] + Nightly -> [ OnOffRule Off (ValidateOnly S.empty) + , OnOffRule Off ReleaseOnly + , OnOffRule On Nightly ] + ReleaseOnly -> [ OnOffRule Off (ValidateOnly S.empty) + , OnOffRule On ReleaseOnly + , OnOffRule Off Nightly ] + data OnOffRule = OnOffRule OnOff Rule @@ -553,21 +573,31 @@ instance ToJSON OnOffRules where where one_rule (OnOffRule onoff r) = ruleString onoff r - parens s = "(" ++ s ++ ")" - and_all rs = intercalate " && " (map parens rs) + + +parens :: [Char] -> [Char] +parens s = "(" ++ s ++ ")" +and_all :: [[Char]] -> [Char] +and_all rs = intercalate " && " (map parens rs) +or_all :: [[Char]] -> [Char] +or_all rs = intercalate " || " (map parens rs) -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled - -- by the "full-ci" label. - | ReleaseOnly -- ^ Only run this job in a release pipeline +data Rule = ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline + | ValidateOnly (S.Set ValidateRule) + deriving (Ord, Eq) + +data ValidateRule = + FullCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. | NonmovingGc -- ^ Only run this job when the "non-moving GC" label is set. | IpeData -- ^ Only run this job when the "IPE" label is set - | Disable -- ^ Don't run this job. - deriving (Bounded, Enum, Ord, Eq) + | TestPrimops -- ^ Run this job when "test-primops" label is set + deriving (Show, Enum, Bounded, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the -- expression language. @@ -575,31 +605,29 @@ true :: String true = "\"true\" == \"true\"" -- A constant evaluating to False because gitlab doesn't support "true" in the -- expression language. -false :: String -false = "\"disabled\" != \"disabled\"" +_false :: String +_false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String -ruleString On FastCI = true -ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" -ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" -ruleString Off LLVMBackend = true -ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDLabel = true -ruleString On NonmovingGc = "$CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/" -ruleString Off NonmovingGc = true +ruleString On (ValidateOnly vs) = + case S.toList vs of + [] -> true + conds -> or_all (map validateRuleString conds) +ruleString Off (ValidateOnly {}) = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" ruleString Off Nightly = "$NIGHTLY == null" -ruleString On IpeData = "$CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/" -ruleString Off IpeData = true -ruleString On Disable = false -ruleString Off Disable = true --- Enumeration of all the rules -rulesList :: [Rule] -rulesList = [minBound .. maxBound] + +validateRuleString :: ValidateRule -> String +validateRuleString FullCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" +validateRuleString LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" +validateRuleString FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" +validateRuleString NonmovingGc = "$CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/" +validateRuleString IpeData = "$CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/" +validateRuleString TestPrimops = "$CI_MERGE_REQUEST_LABELS =~ /.*test-primops.*/" -- | A 'Job' is the description of a single job in a gitlab pipeline. The -- job contains all the information about how to do the build but can be further @@ -752,8 +780,17 @@ modifyNightlyJobs f jg = jg { n = fmap f <$> n jg } -- Generic helpers -addJobRule :: Rule -> Job -> Job -addJobRule r j = j { jobRules = enableRule r (jobRules j) } +setJobRule :: Rule -> Job -> Job +setJobRule r j = j { jobRules = setRule r (jobRules j) } + +addValidateJobRule :: ValidateRule -> Job -> Job +addValidateJobRule r j = j { jobRules = enableValidateRule r (jobRules j) } + +onlyValidateJobRule :: ValidateRule -> Job -> Job +onlyValidateJobRule r j = j { jobRules = onlyValidateRule r (jobRules j) } + +removeValidateJobRule :: ValidateRule -> Job -> Job +removeValidateJobRule r j = j { jobRules = removeValidateRule r (jobRules j)} addVariable :: String -> String -> Job -> Job addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } @@ -773,10 +810,10 @@ validate = job -- Nightly and release apply the FastCI configuration to all jobs so that they all run in -- the pipeline (not conditional on the full-ci label) nightlyRule :: Job -> Job -nightlyRule = addJobRule FastCI . addJobRule Nightly +nightlyRule = setJobRule Nightly releaseRule :: Job -> Job -releaseRule = addJobRule FastCI . addJobRule ReleaseOnly +releaseRule = setJobRule ReleaseOnly -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job @@ -819,7 +856,7 @@ useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode -- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job -fastCI = modifyValidateJobs (addJobRule FastCI) +fastCI = modifyValidateJobs (removeValidateJobRule FullCI) -- | Mark a group of jobs as allowed to fail. allowFailureGroup :: JobGroup Job -> JobGroup Job @@ -827,8 +864,12 @@ allowFailureGroup = modifyJobs allowFailure -- | Add a 'Rule' to just the validate job, for example, only run a job if a certain -- label is set. -addValidateRule :: Rule -> JobGroup Job -> JobGroup Job -addValidateRule t = modifyValidateJobs (addJobRule t) +addValidateRule :: ValidateRule -> JobGroup Job -> JobGroup Job +addValidateRule t = modifyValidateJobs (addValidateJobRule t) + +-- | Only run a validate job if a certain rule is enabled +onlyRule :: ValidateRule -> JobGroup Job -> JobGroup Job +onlyRule t = modifyValidateJobs (onlyValidateJobRule t) -- | Don't run the validate job, normally used to alleviate CI load by marking -- jobs which are unlikely to fail (ie different linux distros) @@ -893,14 +934,12 @@ flattenNamedJob (NamedJob n i) = (n, i) -- | Specification for all the jobs we want to build. jobs :: Map String Job -jobs = Map.fromList $ concatMap (filter is_enabled_job . flattenJobGroup) job_groups - where - is_enabled_job (_, Job {jobRules = OnOffRules {..}}) = not $ Disable `S.member` rule_set +jobs = Map.fromList $ concatMap (flattenJobGroup) job_groups job_groups :: [JobGroup Job] job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) - , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf + , addValidateRule TestPrimops (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , validateBuilds Amd64 (Linux Debian10) nativeInt , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) @@ -910,7 +949,7 @@ job_groups = , -- Nightly allowed to fail: #22343 modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) - , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) + , onlyRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) , disableValidate (standardBuilds Amd64 (Linux Debian11)) -- We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19 -- not being at EOL until April 2023 and they still need tinfo5. @@ -927,8 +966,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) - , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) + , addValidateRule TestPrimops (standardBuilds Amd64 Darwin) + , allowFailureGroup (onlyRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , fastCI (standardBuilds AArch64 Darwin) , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) @@ -948,9 +987,8 @@ job_groups = make_wasm_jobs wasm_build_config {bignumBackend = Native} , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} - , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) - , modifyNightlyJobs (addJobRule Disable) $ - addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) + , onlyRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , onlyRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where @@ -1056,6 +1094,7 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" +write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1521,6 +1521,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb10-zstd-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", + "junit.xml", + "unexpected-test-output.tar.gz" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", + "TEST_ENV": "x86_64-linux-deb10-zstd-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1558,7 +1620,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1622,7 +1684,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1687,7 +1749,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1749,7 +1811,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1811,7 +1873,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1873,7 +1935,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1937,7 +1999,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2002,7 +2064,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2066,7 +2128,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2129,7 +2191,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2191,7 +2253,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2249,7 +2311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2311,7 +2373,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2377,7 +2439,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2444,7 +2506,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2508,7 +2570,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2572,7 +2634,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2642,7 +2704,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2708,7 +2770,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2774,7 +2836,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2840,7 +2902,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2904,7 +2966,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2968,7 +3030,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3032,7 +3094,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3096,7 +3158,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3160,7 +3222,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3224,7 +3286,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3290,7 +3352,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3356,7 +3418,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3422,7 +3484,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3486,7 +3548,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3550,7 +3612,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3610,7 +3672,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3673,7 +3735,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3740,7 +3802,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*test-primops.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3808,7 +3870,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3871,7 +3933,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3935,7 +3997,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3999,7 +4061,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4063,7 +4125,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4126,7 +4188,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4188,7 +4250,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4249,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4311,7 +4373,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4372,7 +4434,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*test-primops.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4433,7 +4495,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4495,7 +4557,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4558,7 +4620,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4619,7 +4681,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4682,7 +4744,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4746,7 +4808,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4807,7 +4869,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4866,7 +4928,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1d743ed25348d2790b8d6866c051de4d279b3ac...0a07627259cd9e7a067b75f34cac271446281d73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1d743ed25348d2790b8d6866c051de4d279b3ac...0a07627259cd9e7a067b75f34cac271446281d73 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 12:13:49 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 08:13:49 -0400 Subject: [Git][ghc/ghc][wip/test-primops] 2 commits: gen_ci: Rules rework Message-ID: <64b924fdea31f_78d13b782c98566@gitlab.mail> Matthew Pickering pushed to branch wip/test-primops at Glasgow Haskell Compiler / GHC Commits: 036f2d50 by Matthew Pickering at 2023-07-20T12:58:27+01:00 gen_ci: Rules rework In particular we now distinguish between whether we are dealing with a Nightly/Release pipeline (which labels don't matter for) and a validate pipeline where labels do matter. The overall goal here is to allow a disjunction of labels for validate pipelines, for example, > Run a job if we have the full-ci label or test-primops label Therefore the "ValidateOnly" rules are treated as a set of disjunctions rather than conjunctions like before. What this means in particular is that if we want to ONLY run a job if a label is set, for example, "FreeBSD" label then we have to override the whole label set. - - - - - b716b448 by Matthew Pickering at 2023-07-20T13:03:36+01:00 Add test-primops label support The test-primops CI job requires some additional builds in the validation pipeline, so we make sure to enable these jobs when test-primops label is set. - - - - - 2 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -11,7 +11,6 @@ import Data.Map (Map) import Data.Maybe import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as B -import Data.Set (Set) import qualified Data.Set as S import System.Environment import Data.List @@ -505,21 +504,34 @@ instance ToJSON ArtifactsWhen where ----------------------------------------------------------------------------- -- Data structure which records the condition when a job is run. -data OnOffRules = OnOffRules { rule_set :: Set Rule -- ^ The set of enabled rules +data OnOffRules = OnOffRules { rule_set :: Rule -- ^ The enabled rules , when :: ManualFlag -- ^ The additional condition about when to run this job. } --- The initial set of rules where all rules are disabled and the job is always run. +-- The initial set of rules, which assumes a Validate pipeline which is run with FullCI. emptyRules :: OnOffRules -emptyRules = OnOffRules S.empty OnSuccess +emptyRules = OnOffRules (ValidateOnly (S.singleton FullCI)) OnSuccess -- When to run the job data ManualFlag = Manual -- ^ Only run the job when explicitly triggered by a user | OnSuccess -- ^ Always run it, if the rules pass (the default) deriving Eq -enableRule :: Rule -> OnOffRules -> OnOffRules -enableRule r (OnOffRules o m) = OnOffRules (S.insert r o) m +setRule :: Rule -> OnOffRules -> OnOffRules +setRule r (OnOffRules _ m) = OnOffRules r m + +enableValidateRule :: ValidateRule -> OnOffRules -> OnOffRules +enableValidateRule r = modifyValidateRules (S.insert r) + +onlyValidateRule :: ValidateRule -> OnOffRules -> OnOffRules +onlyValidateRule r = modifyValidateRules (const (S.singleton r)) + +removeValidateRule :: ValidateRule -> OnOffRules -> OnOffRules +removeValidateRule r = modifyValidateRules (S.delete r) + +modifyValidateRules :: (S.Set ValidateRule -> S.Set ValidateRule) -> OnOffRules -> OnOffRules +modifyValidateRules f (OnOffRules (ValidateOnly rs) m) = OnOffRules (ValidateOnly (f rs)) m +modifyValidateRules _ r = error $ "Applying validate rule to nightly/release job:" ++ show (rule_set r) manualRule :: OnOffRules -> OnOffRules manualRule rules = rules { when = Manual } @@ -528,10 +540,19 @@ manualRule rules = rules { when = Manual } -- For example, even if you don't explicitly disable a rule it will end up in the -- rule list with the OFF state. enumRules :: OnOffRules -> [OnOffRule] -enumRules o = map lkup rulesList +enumRules (OnOffRules r _) = rulesList where - enabled_rules = rule_set o - lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r + rulesList = case r of + ValidateOnly rs -> [OnOffRule On (ValidateOnly rs) + , OnOffRule Off ReleaseOnly + , OnOffRule Off Nightly ] + Nightly -> [ OnOffRule Off (ValidateOnly S.empty) + , OnOffRule Off ReleaseOnly + , OnOffRule On Nightly ] + ReleaseOnly -> [ OnOffRule Off (ValidateOnly S.empty) + , OnOffRule On ReleaseOnly + , OnOffRule Off Nightly ] + data OnOffRule = OnOffRule OnOff Rule @@ -553,21 +574,30 @@ instance ToJSON OnOffRules where where one_rule (OnOffRule onoff r) = ruleString onoff r - parens s = "(" ++ s ++ ")" - and_all rs = intercalate " && " (map parens rs) + + +parens :: [Char] -> [Char] +parens s = "(" ++ s ++ ")" +and_all :: [[Char]] -> [Char] +and_all rs = intercalate " && " (map parens rs) +or_all :: [[Char]] -> [Char] +or_all rs = intercalate " || " (map parens rs) -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled - -- by the "full-ci" label. - | ReleaseOnly -- ^ Only run this job in a release pipeline +data Rule = ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline - | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present - | FreeBSDLabel -- ^ Only run this job when the "FreeBSD" label is set. - | NonmovingGc -- ^ Only run this job when the "non-moving GC" label is set. - | IpeData -- ^ Only run this job when the "IPE" label is set - | Disable -- ^ Don't run this job. - deriving (Bounded, Enum, Ord, Eq) + | ValidateOnly (S.Set ValidateRule) -- ^ Only run this job in a validate pipeline, when any of these rules are enabled. + deriving (Show, Ord, Eq) + +data ValidateRule = + FullCI -- ^ Run this job when the "full-ci" label is present. + | LLVMBackend -- ^ Run this job when the "LLVM backend" label is present + | FreeBSDLabel -- ^ Run this job when the "FreeBSD" label is set. + | NonmovingGc -- ^ Run this job when the "non-moving GC" label is set. + | IpeData -- ^ Run this job when the "IPE" label is set + | TestPrimops -- ^ Run this job when "test-primops" label is set + deriving (Show, Enum, Bounded, Ord, Eq) -- A constant evaluating to True because gitlab doesn't support "true" in the -- expression language. @@ -575,31 +605,31 @@ true :: String true = "\"true\" == \"true\"" -- A constant evaluating to False because gitlab doesn't support "true" in the -- expression language. -false :: String -false = "\"disabled\" != \"disabled\"" +_false :: String +_false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String -ruleString On FastCI = true -ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" -ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" -ruleString Off LLVMBackend = true -ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" -ruleString Off FreeBSDLabel = true -ruleString On NonmovingGc = "$CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/" -ruleString Off NonmovingGc = true +ruleString On (ValidateOnly vs) = + case S.toList vs of + [] -> true + conds -> or_all (map validateRuleString conds) +ruleString Off (ValidateOnly {}) = true ruleString On ReleaseOnly = "$RELEASE_JOB == \"yes\"" ruleString Off ReleaseOnly = "$RELEASE_JOB != \"yes\"" ruleString On Nightly = "$NIGHTLY" ruleString Off Nightly = "$NIGHTLY == null" -ruleString On IpeData = "$CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/" -ruleString Off IpeData = true -ruleString On Disable = false -ruleString Off Disable = true --- Enumeration of all the rules -rulesList :: [Rule] -rulesList = [minBound .. maxBound] +labelString :: String -> String +labelString s = "$CI_MERGE_REQUEST_LABELS =~ /.*" ++ s ++ ".*/" + +validateRuleString :: ValidateRule -> String +validateRuleString FullCI = or_all ([labelString "full-ci", labelString "marge_bot_batch_merge_job"]) +validateRuleString LLVMBackend = labelString "LLVM backend" +validateRuleString FreeBSDLabel = labelString "FreeBSD" +validateRuleString NonmovingGc = labelString "non-moving GC" +validateRuleString IpeData = labelString "IPE" +validateRuleString TestPrimops = labelString "test-primops" -- | A 'Job' is the description of a single job in a gitlab pipeline. The -- job contains all the information about how to do the build but can be further @@ -752,8 +782,20 @@ modifyNightlyJobs f jg = jg { n = fmap f <$> n jg } -- Generic helpers -addJobRule :: Rule -> Job -> Job -addJobRule r j = j { jobRules = enableRule r (jobRules j) } +setJobRule :: Rule -> Job -> Job +setJobRule r j = j { jobRules = setRule r (jobRules j) } + +addValidateJobRule :: ValidateRule -> Job -> Job +addValidateJobRule r = modifyValidateJobRule (enableValidateRule r) + +onlyValidateJobRule :: ValidateRule -> Job -> Job +onlyValidateJobRule r = modifyValidateJobRule (onlyValidateRule r) + +removeValidateJobRule :: ValidateRule -> Job -> Job +removeValidateJobRule r = modifyValidateJobRule (removeValidateRule r) + +modifyValidateJobRule :: (OnOffRules -> OnOffRules) -> Job -> Job +modifyValidateJobRule f j = j { jobRules = f (jobRules j) } addVariable :: String -> String -> Job -> Job addVariable k v j = j { jobVariables = mminsertWith (++) k [v] (jobVariables j) } @@ -773,10 +815,10 @@ validate = job -- Nightly and release apply the FastCI configuration to all jobs so that they all run in -- the pipeline (not conditional on the full-ci label) nightlyRule :: Job -> Job -nightlyRule = addJobRule FastCI . addJobRule Nightly +nightlyRule = setJobRule Nightly releaseRule :: Job -> Job -releaseRule = addJobRule FastCI . addJobRule ReleaseOnly +releaseRule = setJobRule ReleaseOnly -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job @@ -819,7 +861,7 @@ useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode -- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job -fastCI = modifyValidateJobs (addJobRule FastCI) +fastCI = modifyValidateJobs (removeValidateJobRule FullCI) -- | Mark a group of jobs as allowed to fail. allowFailureGroup :: JobGroup Job -> JobGroup Job @@ -827,8 +869,12 @@ allowFailureGroup = modifyJobs allowFailure -- | Add a 'Rule' to just the validate job, for example, only run a job if a certain -- label is set. -addValidateRule :: Rule -> JobGroup Job -> JobGroup Job -addValidateRule t = modifyValidateJobs (addJobRule t) +addValidateRule :: ValidateRule -> JobGroup Job -> JobGroup Job +addValidateRule t = modifyValidateJobs (addValidateJobRule t) + +-- | Only run a validate job if a certain rule is enabled +onlyRule :: ValidateRule -> JobGroup Job -> JobGroup Job +onlyRule t = modifyValidateJobs (onlyValidateJobRule t) -- | Don't run the validate job, normally used to alleviate CI load by marking -- jobs which are unlikely to fail (ie different linux distros) @@ -893,14 +939,12 @@ flattenNamedJob (NamedJob n i) = (n, i) -- | Specification for all the jobs we want to build. jobs :: Map String Job -jobs = Map.fromList $ concatMap (filter is_enabled_job . flattenJobGroup) job_groups - where - is_enabled_job (_, Job {jobRules = OnOffRules {..}}) = not $ Disable `S.member` rule_set +jobs = Map.fromList $ concatMap (flattenJobGroup) job_groups job_groups :: [JobGroup Job] job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) - , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf + , addValidateRule TestPrimops (standardBuildsWithConfig Amd64 (Linux Debian10) dwarf) , validateBuilds Amd64 (Linux Debian10) nativeInt , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) @@ -910,7 +954,7 @@ job_groups = , -- Nightly allowed to fail: #22343 modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) - , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) + , onlyRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) , disableValidate (standardBuilds Amd64 (Linux Debian11)) -- We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19 -- not being at EOL until April 2023 and they still need tinfo5. @@ -927,8 +971,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) - , standardBuilds Amd64 Darwin - , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) + , addValidateRule TestPrimops (standardBuilds Amd64 Darwin) + , allowFailureGroup (onlyRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , fastCI (standardBuilds AArch64 Darwin) , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) @@ -948,9 +992,8 @@ job_groups = make_wasm_jobs wasm_build_config {bignumBackend = Native} , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} - , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) - , modifyNightlyJobs (addJobRule Disable) $ - addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) + , onlyRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , onlyRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where @@ -1056,6 +1099,7 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" +write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1521,6 +1521,68 @@ "XZ_OPT": "-9" } }, + "nightly-x86_64-linux-deb10-zstd-validate": { + "after_script": [ + ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", + ".gitlab/ci.sh clean", + "cat ci_timings" + ], + "allow_failure": false, + "artifacts": { + "expire_in": "8 weeks", + "paths": [ + "ghc-x86_64-linux-deb10-zstd-validate.tar.xz", + "junit.xml", + "unexpected-test-output.tar.gz" + ], + "reports": { + "junit": "junit.xml" + }, + "when": "always" + }, + "cache": { + "key": "x86_64-linux-deb10-$CACHE_REV", + "paths": [ + "cabal-cache", + "toolchain" + ] + }, + "dependencies": [], + "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", + "needs": [ + { + "artifacts": false, + "job": "hadrian-ghc-in-ghci" + } + ], + "rules": [ + { + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", + "when": "on_success" + } + ], + "script": [ + "sudo chown ghc:ghc -R .", + ".gitlab/ci.sh setup", + ".gitlab/ci.sh configure", + ".gitlab/ci.sh build_hadrian", + ".gitlab/ci.sh test_hadrian" + ], + "stage": "full-build", + "tags": [ + "x86_64-linux" + ], + "variables": { + "BIGNUM_BACKEND": "gmp", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-zstd-validate", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", + "TEST_ENV": "x86_64-linux-deb10-zstd-validate", + "XZ_OPT": "-9" + } + }, "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -1558,7 +1620,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1622,7 +1684,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1687,7 +1749,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1749,7 +1811,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1811,7 +1873,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1873,7 +1935,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -1937,7 +1999,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2002,7 +2064,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2066,7 +2128,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2129,7 +2191,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2191,7 +2253,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2249,7 +2311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2311,7 +2373,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)", "when": "on_success" } ], @@ -2377,7 +2439,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2444,7 +2506,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2508,7 +2570,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2572,7 +2634,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2642,7 +2704,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2708,7 +2770,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2774,7 +2836,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2840,7 +2902,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2904,7 +2966,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -2968,7 +3030,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3032,7 +3094,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3096,7 +3158,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3160,7 +3222,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3224,7 +3286,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3290,7 +3352,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3356,7 +3418,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3422,7 +3484,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3486,7 +3548,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3550,7 +3612,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3610,7 +3672,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3673,7 +3735,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3740,7 +3802,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*test-primops.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3808,7 +3870,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3871,7 +3933,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3935,7 +3997,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -3999,7 +4061,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4063,7 +4125,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4126,7 +4188,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4188,7 +4250,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4249,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4311,7 +4373,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4372,7 +4434,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*test-primops.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4433,7 +4495,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4495,7 +4557,7 @@ "rules": [ { "allow_failure": true, - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "manual" } ], @@ -4558,7 +4620,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4619,7 +4681,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4682,7 +4744,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4746,7 +4808,7 @@ ], "rules": [ { - "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4807,7 +4869,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -4866,7 +4928,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a07627259cd9e7a067b75f34cac271446281d73...b716b44823917382f9450b229cc9b6a0a83c4393 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a07627259cd9e7a067b75f34cac271446281d73...b716b44823917382f9450b229cc9b6a0a83c4393 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 12:21:26 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 08:21:26 -0400 Subject: [Git][ghc/ghc][wip/t23630] 39 commits: base: fix haddock syntax in GHC.Profiling Message-ID: <64b926c616d78_78d13b782c989af@gitlab.mail> Matthew Pickering pushed to branch wip/t23630 at Glasgow Haskell Compiler / GHC Commits: e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - a4ee857b by Matthew Pickering at 2023-07-20T13:21:02+01:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 18 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bd6463e5f48a96d6a06453099cdb79a25483242...a4ee857b8cb175d40de219e01340aa40fe80c672 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7bd6463e5f48a96d6a06453099cdb79a25483242...a4ee857b8cb175d40de219e01340aa40fe80c672 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 12:22:26 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 08:22:26 -0400 Subject: [Git][ghc/ghc][wip/ci-image-bump] 44 commits: Fix deprecation of record fields Message-ID: <64b9270273e8f_78d13b7854993df@gitlab.mail> Matthew Pickering pushed to branch wip/ci-image-bump at Glasgow Haskell Compiler / GHC Commits: 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 336b795d by Matthew Pickering at 2023-07-20T12:22:22+00:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - e3246727 by Matthew Pickering at 2023-07-20T12:22:22+00:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 18 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/FVs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/564c9b8e365e03263273f7d99de8c41e44f92356...e3246727f9cef83bd8b0405976e70db2958c3b0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/564c9b8e365e03263273f7d99de8c41e44f92356...e3246727f9cef83bd8b0405976e70db2958c3b0f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 12:37:44 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 08:37:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-werror-ci Message-ID: <64b92a98535a0_78d13b77f010761f@gitlab.mail> Matthew Pickering pushed new branch wip/hadrian-werror-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-werror-ci You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 12:40:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 08:40:40 -0400 Subject: [Git][ghc/ghc][wip/hadrian-werror-ci] ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Message-ID: <64b92b4861de_78d13b7854110050@gitlab.mail> Matthew Pickering pushed to branch wip/hadrian-werror-ci at Glasgow Haskell Compiler / GHC Commits: ba837d4a by Matthew Pickering at 2023-07-20T13:40:27+01:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 6 changed files: - .gitlab-ci.yml - hadrian/ghci-cabal.in - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -371,6 +371,8 @@ hadrian-ghc-in-ghci: - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - .gitlab/ci.sh configure + # Enable -Werror when building hadrian + - echo $'package hadrian\n ghc-options: -Werror' > hadrian/cabal.project.local # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: ===================================== hadrian/ghci-cabal.in ===================================== @@ -5,6 +5,6 @@ set -e export TOOL_OUTPUT=.hadrian_ghci/ghci_args # Replace newlines with spaces, as these otherwise break the ghci invocation on windows. -CABFLAGS=-v0 "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS +CABFLAGS="-v0 $CABFLAGS" "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')" @WithGhc@ --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m ===================================== hadrian/src/Context.hs ===================================== @@ -95,7 +95,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile context at Context {..} = do +pkgHaddockFile Context {..} = do root <- buildRoot version <- pkgUnitId stage package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" @@ -136,7 +136,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile context at Context {..} = do +pkgConfFile Context {..} = do pid <- pkgUnitId stage package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Flavour.hs ===================================== @@ -37,7 +37,6 @@ import Text.Parsec.Combinator as P import Text.Parsec.Char as P import Control.Monad.Except import UserSettings -import Oracles.Flag flavourTransformers :: Map String (Flavour -> Flavour) ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -31,7 +31,6 @@ import Way import Packages import Development.Shake.Classes import Control.Monad -import Utilities import Base import Context import System.Directory.Extra (listFilesRecursive) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -57,7 +57,6 @@ commonReinstallCabalArgs :: Args commonReinstallCabalArgs = do top <- expr topDirectory root <- getBuildRoot - threads <- shakeThreads <$> expr getShakeOptions _pkg <- getPackage compiler <- expr $ programPath =<< programContext Stage1 ghc mconcat [ arg "--project-file" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba837d4a064bd946692a1abe4bc9b4025a5f9064 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba837d4a064bd946692a1abe4bc9b4025a5f9064 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 12:48:35 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 08:48:35 -0400 Subject: [Git][ghc/ghc][wip/hadrian-werror-ci] ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Message-ID: <64b92d23c0a61_78d13b77dc12060@gitlab.mail> Matthew Pickering pushed to branch wip/hadrian-werror-ci at Glasgow Haskell Compiler / GHC Commits: 92951ab0 by Matthew Pickering at 2023-07-20T13:48:25+01:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 6 changed files: - .gitlab-ci.yml - hadrian/ghci-cabal.in - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -371,6 +371,9 @@ hadrian-ghc-in-ghci: - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - .gitlab/ci.sh configure + # Enable -Werror when building hadrian + - echo "package hadrian" > hadrian/cabal.project.local + - echo " ghc-options: -Werror" >> hadrian/cabal.project.local # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: ===================================== hadrian/ghci-cabal.in ===================================== @@ -5,6 +5,6 @@ set -e export TOOL_OUTPUT=.hadrian_ghci/ghci_args # Replace newlines with spaces, as these otherwise break the ghci invocation on windows. -CABFLAGS=-v0 "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS +CABFLAGS="-v0 $CABFLAGS" "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')" @WithGhc@ --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m ===================================== hadrian/src/Context.hs ===================================== @@ -95,7 +95,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile context at Context {..} = do +pkgHaddockFile Context {..} = do root <- buildRoot version <- pkgUnitId stage package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" @@ -136,7 +136,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile context at Context {..} = do +pkgConfFile Context {..} = do pid <- pkgUnitId stage package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Flavour.hs ===================================== @@ -37,7 +37,6 @@ import Text.Parsec.Combinator as P import Text.Parsec.Char as P import Control.Monad.Except import UserSettings -import Oracles.Flag flavourTransformers :: Map String (Flavour -> Flavour) ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -31,7 +31,6 @@ import Way import Packages import Development.Shake.Classes import Control.Monad -import Utilities import Base import Context import System.Directory.Extra (listFilesRecursive) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -57,7 +57,6 @@ commonReinstallCabalArgs :: Args commonReinstallCabalArgs = do top <- expr topDirectory root <- getBuildRoot - threads <- shakeThreads <$> expr getShakeOptions _pkg <- getPackage compiler <- expr $ programPath =<< programContext Stage1 ghc mconcat [ arg "--project-file" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92951ab032a856c6d49d61b87a5ae592f773d408 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92951ab032a856c6d49d61b87a5ae592f773d408 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 12:52:49 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 08:52:49 -0400 Subject: [Git][ghc/ghc][wip/hadrian-werror-ci] 2 commits: ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Message-ID: <64b92e217efd7_78d138f536941227bb@gitlab.mail> Matthew Pickering pushed to branch wip/hadrian-werror-ci at Glasgow Haskell Compiler / GHC Commits: d1bebfa5 by Matthew Pickering at 2023-07-20T13:52:30+01:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - b4301905 by Matthew Pickering at 2023-07-20T13:52:36+01:00 test - - - - - 7 changed files: - .gitlab-ci.yml - hadrian/ghci-cabal.in - hadrian/src/Context.hs - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Settings/Builders/Cabal.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -371,6 +371,9 @@ hadrian-ghc-in-ghci: - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - .gitlab/ci.sh configure + # Enable -Werror when building hadrian + - "echo 'package hadrian' > hadrian/cabal.project.local" + - "echo ' ghc-options: -Werror' >> hadrian/cabal.project.local" # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: ===================================== hadrian/ghci-cabal.in ===================================== @@ -5,6 +5,6 @@ set -e export TOOL_OUTPUT=.hadrian_ghci/ghci_args # Replace newlines with spaces, as these otherwise break the ghci invocation on windows. -CABFLAGS=-v0 "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS +CABFLAGS="-v0 $CABFLAGS" "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')" @WithGhc@ --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m ===================================== hadrian/src/Context.hs ===================================== @@ -95,7 +95,7 @@ pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config") -- | Path to the haddock file of a given 'Context', e.g.: -- @_build/stage1/libraries/array/doc/html/array/array.haddock at . pkgHaddockFile :: Context -> Action FilePath -pkgHaddockFile context at Context {..} = do +pkgHaddockFile Context {..} = do root <- buildRoot version <- pkgUnitId stage package return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock" @@ -136,7 +136,7 @@ pkgGhciLibraryFile context at Context {..} = do -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile context at Context {..} = do +pkgConfFile Context {..} = do pid <- pkgUnitId stage package dbPath <- packageDbPath (PackageDbLoc stage iplace) return $ dbPath -/- pid <.> "conf" ===================================== hadrian/src/Expression.hs ===================================== @@ -35,6 +35,8 @@ import Hadrian.Expression hiding (Expr, Predicate, Args) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal +foo = () + -- | Get values from a configured cabal stage. getContextData :: (ContextData -> a) -> Expr a getContextData key = do ===================================== hadrian/src/Flavour.hs ===================================== @@ -37,7 +37,6 @@ import Text.Parsec.Combinator as P import Text.Parsec.Char as P import Control.Monad.Except import UserSettings -import Oracles.Flag flavourTransformers :: Map String (Flavour -> Flavour) ===================================== hadrian/src/Hadrian/Haskell/Hash.hs ===================================== @@ -31,7 +31,6 @@ import Way import Packages import Development.Shake.Classes import Control.Monad -import Utilities import Base import Context import System.Directory.Extra (listFilesRecursive) ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -57,7 +57,6 @@ commonReinstallCabalArgs :: Args commonReinstallCabalArgs = do top <- expr topDirectory root <- getBuildRoot - threads <- shakeThreads <$> expr getShakeOptions _pkg <- getPackage compiler <- expr $ programPath =<< programContext Stage1 ghc mconcat [ arg "--project-file" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92951ab032a856c6d49d61b87a5ae592f773d408...b4301905c394d2cb77e804909c149722f2679616 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92951ab032a856c6d49d61b87a5ae592f773d408...b4301905c394d2cb77e804909c149722f2679616 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 13:27:22 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 09:27:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ipe-stats Message-ID: <64b9363a86f2a_78d13b77f01399e0@gitlab.mail> Matthew Pickering pushed new branch wip/ipe-stats at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ipe-stats You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 13:32:53 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 09:32:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ipe-stats-9.6 Message-ID: <64b93785b1c24_78d138f750dc147210@gitlab.mail> Matthew Pickering pushed new branch wip/ipe-stats-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ipe-stats-9.6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 14:08:28 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 20 Jul 2023 10:08:28 -0400 Subject: [Git][ghc/ghc][wip/t23315] 378 commits: Use setSrcSpan rather than setLclEnv in solveForAll Message-ID: <64b93fdc46495_78d13b77f0153728@gitlab.mail> Finley McIlwaine pushed to branch wip/t23315 at Glasgow Haskell Compiler / GHC Commits: 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - b08a7e4a by Finley McIlwaine at 2023-07-20T14:08:18+00:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 27 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - − .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57ba64dba592f5efaea5e9b61f2e7e2e7267179e...b08a7e4add4b12625370995ff843bb3433262f81 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57ba64dba592f5efaea5e9b61f2e7e2e7267179e...b08a7e4add4b12625370995ff843bb3433262f81 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 14:12:36 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 20 Jul 2023 10:12:36 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] Aarch64 NCG: Don't emit overflowed literals Message-ID: <64b940d4eae48_78d13b77c8153910@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: b5b21723 by Andreas Klebinger at 2023-07-20T16:03:06+02:00 Aarch64 NCG: Don't emit overflowed literals Rather than emitting overflowed literals we truncate them now. - - - - - 2 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -397,9 +397,9 @@ For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, -- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. -- Used with MOVZ,MOVN, MOVK -- See Note [Aarch64 immediates] -getMovWideImm :: Integer -> Maybe Operand -getMovWideImm n - -- TODO: Handle sign extension +getMovWideImm :: Integer -> Width -> Maybe Operand +getMovWideImm n w + -- TODO: Handle sign extension/negatives | n <= 0 = Nothing -- Fits in 16 bits @@ -408,44 +408,46 @@ getMovWideImm n -- 0x0000 0000 xxxx 0000 | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 16) SLSL 16 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 16) SLSL 16 -- 0x 0000 xxxx 0000 0000 | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 32) SLSL 32 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 32) SLSL 32 -- 0x xxxx 0000 0000 0000 | trailing_zeros >= 48 - = Just $ OpImmShift (ImmInteger $ n `shiftR` 48) SLSL 48 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 48) SLSL 48 | otherwise = Nothing where - sized_n = fromIntegral n :: Word64 + truncated = narrowU w n + sized_n = fromIntegral truncated :: Word64 trailing_zeros = countTrailingZeros sized_n -- | Arithmetic(immediate) -- Allows for 12bit immediates which can be shifted by 0 or 12 bits. -- Used with ADD, ADDS, SUB, SUBS, CMP, CMN -- See Note [Aarch64 immediates] -getArithImm :: Integer -> Maybe Operand -getArithImm n +getArithImm :: Integer -> Width -> Maybe Operand +getArithImm n w -- TODO: Handle sign extension | n <= 0 = Nothing -- Fits in 16 bits -- Fits in 12 bits | sized_n < 2^(12::Int) - = Just $ OpImm (ImmInteger n) + = Just $ OpImm (ImmInteger truncated) -- 12 bits shifted by 12 places. | trailing_zeros >= 12 && sized_n < 2^(24::Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 12) SLSL 12 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 12) SLSL 12 | otherwise = Nothing where - sized_n = fromIntegral n :: Word64 + sized_n = fromIntegral truncated :: Word64 + truncated = narrowU w n trailing_zeros = countTrailingZeros sized_n -- | Logical (immediate) @@ -453,10 +455,12 @@ getArithImm n -- Used with AND, ANDS, EOR, ORR, TST -- and their aliases which includes at least MOV (bitmask immediate) -- See Note [Aarch64 immediates] -getBitmaskImm :: Integer -> Maybe Operand -getBitmaskImm n - | isAArch64Bitmask n = Just $ OpImm (ImmInteger n) +getBitmaskImm :: Integer -> Width -> Maybe Operand +getBitmaskImm n w + | isAArch64Bitmask truncated = Just $ OpImm (ImmInteger truncated) | otherwise = Nothing + where + truncated = narrowU w n -- TODO OPT: we might be able give getRegister ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -77,6 +77,8 @@ litToImm (CmmInt i w) = ImmInteger (narrowS w i) -- narrow to the width: a CmmInt might be out of -- range, but we assume that ImmInteger only contains -- in-range values. A signed value should be fine here. + -- AK: We do call this with out of range values, however + -- it just truncates as we would expect. litToImm (CmmFloat f W32) = ImmFloat f litToImm (CmmFloat f W64) = ImmDouble f litToImm (CmmLabel l) = ImmCLbl l View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5b217238dffa64369ddbf0dcf03ebb804e3c94c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b5b217238dffa64369ddbf0dcf03ebb804e3c94c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 14:52:09 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 20 Jul 2023 10:52:09 -0400 Subject: [Git][ghc/ghc][wip/hadrian-werror-ci] Deleted 1 commit: test Message-ID: <64b94a1983a79_78d13b77f01712c6@gitlab.mail> Matthew Pickering pushed to branch wip/hadrian-werror-ci at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: b4301905 by Matthew Pickering at 2023-07-20T13:52:36+01:00 test - - - - - 1 changed file: - hadrian/src/Expression.hs Changes: ===================================== hadrian/src/Expression.hs ===================================== @@ -35,6 +35,8 @@ import Hadrian.Expression hiding (Expr, Predicate, Args) import Hadrian.Haskell.Cabal.Type import Hadrian.Oracles.Cabal +foo = () + -- | Get values from a configured cabal stage. getContextData :: (ContextData -> a) -> Expr a getContextData key = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4301905c394d2cb77e804909c149722f2679616 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4301905c394d2cb77e804909c149722f2679616 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 15:01:37 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Thu, 20 Jul 2023 11:01:37 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] Aarch64 NCG: Don't emit overflowed literals Message-ID: <64b94c512092d_78d138f53694173489@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: f5488beb by Andreas Klebinger at 2023-07-20T16:51:51+02:00 Aarch64 NCG: Don't emit overflowed literals Rather than emitting overflowed literals we truncate them now. - - - - - 2 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -397,9 +397,9 @@ For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, -- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. -- Used with MOVZ,MOVN, MOVK -- See Note [Aarch64 immediates] -getMovWideImm :: Integer -> Maybe Operand -getMovWideImm n - -- TODO: Handle sign extension +getMovWideImm :: Integer -> Width -> Maybe Operand +getMovWideImm n w + -- TODO: Handle sign extension/negatives | n <= 0 = Nothing -- Fits in 16 bits @@ -408,44 +408,46 @@ getMovWideImm n -- 0x0000 0000 xxxx 0000 | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 16) SLSL 16 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 16) SLSL 16 -- 0x 0000 xxxx 0000 0000 | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 32) SLSL 32 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 32) SLSL 32 -- 0x xxxx 0000 0000 0000 | trailing_zeros >= 48 - = Just $ OpImmShift (ImmInteger $ n `shiftR` 48) SLSL 48 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 48) SLSL 48 | otherwise = Nothing where - sized_n = fromIntegral n :: Word64 + truncated = narrowU w n + sized_n = fromIntegral truncated :: Word64 trailing_zeros = countTrailingZeros sized_n -- | Arithmetic(immediate) -- Allows for 12bit immediates which can be shifted by 0 or 12 bits. -- Used with ADD, ADDS, SUB, SUBS, CMP, CMN -- See Note [Aarch64 immediates] -getArithImm :: Integer -> Maybe Operand -getArithImm n +getArithImm :: Integer -> Width -> Maybe Operand +getArithImm n w -- TODO: Handle sign extension | n <= 0 = Nothing -- Fits in 16 bits -- Fits in 12 bits | sized_n < 2^(12::Int) - = Just $ OpImm (ImmInteger n) + = Just $ OpImm (ImmInteger truncated) -- 12 bits shifted by 12 places. | trailing_zeros >= 12 && sized_n < 2^(24::Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 12) SLSL 12 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 12) SLSL 12 | otherwise = Nothing where - sized_n = fromIntegral n :: Word64 + sized_n = fromIntegral truncated :: Word64 + truncated = narrowU w n trailing_zeros = countTrailingZeros sized_n -- | Logical (immediate) @@ -453,10 +455,12 @@ getArithImm n -- Used with AND, ANDS, EOR, ORR, TST -- and their aliases which includes at least MOV (bitmask immediate) -- See Note [Aarch64 immediates] -getBitmaskImm :: Integer -> Maybe Operand -getBitmaskImm n - | isAArch64Bitmask n = Just $ OpImm (ImmInteger n) +getBitmaskImm :: Integer -> Width -> Maybe Operand +getBitmaskImm n w + | isAArch64Bitmask truncated = Just $ OpImm (ImmInteger truncated) | otherwise = Nothing + where + truncated = narrowU w n -- TODO OPT: we might be able give getRegister @@ -604,7 +608,7 @@ getRegister' config plat expr -- or figure out something smarter. Lowered to -- `MOV dst XZR` CmmInt i w | i >= 0 - , Just imm_op <- getMovWideImm i -> do + , Just imm_op <- getMovWideImm i w -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op))) CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do @@ -895,7 +899,7 @@ getRegister' config plat expr (reg_x, format_x, code_x) <- getSomeReg x (op_y, format_y, code_y) <- case y of CmmLit (CmmInt n w) - | Just imm_operand_y <- encode_imm n + | Just imm_operand_y <- encode_imm n w -> return (imm_operand_y, intFormat w, nilOL) _ -> do (reg_y, format_y, code_y) <- getSomeReg y @@ -910,7 +914,7 @@ getRegister' config plat expr -- In the case of 8- and 16-bit signed arithmetic we must first -- sign-extend both arguments to 32-bits. -- See Note [Signed arithmetic on AArch64]. - intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Maybe Operand) -> NatM (Register) + intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) intOpImm {- is signed -} True w op _encode_imm = intOp True w op intOpImm False w op encode_imm = do -- compute x <- x @@ -919,7 +923,7 @@ getRegister' config plat expr (reg_x, format_x, code_x) <- getSomeReg x (op_y, format_y, code_y) <- case y of CmmLit (CmmInt n w) - | Just imm_operand_y <- encode_imm n + | Just imm_operand_y <- encode_imm n w -> return (imm_operand_y, intFormat w, nilOL) _ -> do (reg_y, format_y, code_y) <- getSomeReg y ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -77,6 +77,8 @@ litToImm (CmmInt i w) = ImmInteger (narrowS w i) -- narrow to the width: a CmmInt might be out of -- range, but we assume that ImmInteger only contains -- in-range values. A signed value should be fine here. + -- AK: We do call this with out of range values, however + -- it just truncates as we would expect. litToImm (CmmFloat f W32) = ImmFloat f litToImm (CmmFloat f W64) = ImmDouble f litToImm (CmmLabel l) = ImmCLbl l View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5488bebb864e3386cbbb5a534e75247f17c87a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5488bebb864e3386cbbb5a534e75247f17c87a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 15:23:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 11:23:38 -0400 Subject: [Git][ghc/ghc][wip/ghc-internals-2] 13 commits: Reg.Liveness: Strictness Message-ID: <64b9517ac783a_78d138f328041810d@gitlab.mail> Ben Gamari pushed to branch wip/ghc-internals-2 at Glasgow Haskell Compiler / GHC Commits: 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 9970e87b by Ben Gamari at 2023-07-20T11:23:35-04:00 ghc-internals: Initial commit of the skeleton - - - - - 1e235650 by Ben Gamari at 2023-07-20T11:23:35-04:00 ghc-experimental: Initial commit - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs - compiler/GHC/Types/Unique/Set.hs - + docs/users_guide/9.10.1-notes.rst - docs/users_guide/release-notes.rst - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/base/base.cabal - + libraries/ghc-experimental/CHANGELOG.md - + libraries/ghc-experimental/LICENSE - + libraries/ghc-experimental/ghc-experimental.cabal - + libraries/ghc-experimental/src/Dummy.hs - + libraries/ghc-internals/CHANGELOG.md - + libraries/ghc-internals/LICENSE - + libraries/ghc-internals/ghc-internals.cabal - + libraries/ghc-internals/src/Dummy.hs - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_full.cmm - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/T20604/T20604.stdout - testsuite/tests/interface-stability/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71c11f058ae57701fea53bab921da748193aafd0...1e23565017ad9789cc34e868ca2d05124bae7f7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71c11f058ae57701fea53bab921da748193aafd0...1e23565017ad9789cc34e868ca2d05124bae7f7a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 16:24:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 12:24:10 -0400 Subject: [Git][ghc/ghc][wip/T22834] 156 commits: rts: Work around missing prototypes errors Message-ID: <64b95faab03d2_91ceb77a0100899@gitlab.mail> Ben Gamari pushed to branch wip/T22834 at Glasgow Haskell Compiler / GHC Commits: 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 4840ffb9 by Ben Gamari at 2023-07-20T12:23:42-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23b2ce2159f5f350a94e785a7767763a948f35f2...4840ffb94128539be2f6ed4e5446758104d20e3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/23b2ce2159f5f350a94e785a7767763a948f35f2...4840ffb94128539be2f6ed4e5446758104d20e3a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 17:32:42 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Thu, 20 Jul 2023 13:32:42 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 18 commits: EPA Use full range for Anchor, and do not widen for [TrailingAnn] Message-ID: <64b96fba9e21e_91ceb784013944a@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: e08e8385 by Alan Zimmerman at 2023-07-19T22:08:30+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 Summary: Patch: summary-epa-use-full-range-for Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:34:57 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] info: patch template saved to `-` - - - - - f4635fcb by Alan Zimmerman at 2023-07-19T23:11:33+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 38249f50 by Alan Zimmerman at 2023-07-19T23:21:43+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - c3c6a412 by Alan Zimmerman at 2023-07-19T23:21:46+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 17ed6237 by Alan Zimmerman at 2023-07-19T23:23:26+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - ae7c012f by Alan Zimmerman at 2023-07-19T23:23:30+01:00 Summary: Patch: use-anchor-end-as-prior-end Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-25 12:41:37 +0100 EPA: Use the current Anchor end as prior end Use the original anchor location end as the source of truth for calculating print deltas. This allows original spacing to apply in most cases, only changed AST items need initial delta positions. - - - - - b9741291 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 680f5f61 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 492d4483 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 31e96f70 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 5ef0e920 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: Fix simple tests - - - - - cf0a8713 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 6f56213a by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 717a8bb5 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: deal with fallout from getMonoBind - - - - - 3a6732a4 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA fix captureLineSpacing - - - - - 934ae598 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA print any comments in the span before exiting it - - - - - b9405051 by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 2698fa3c by Alan Zimmerman at 2023-07-19T23:23:30+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 23 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a361f8269f8440fe65f7ad187c88717780ba3dbd...2698fa3c0210691b2b77af166c6bc5cd9959bbc8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a361f8269f8440fe65f7ad187c88717780ba3dbd...2698fa3c0210691b2b77af166c6bc5cd9959bbc8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 17:36:42 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Thu, 20 Jul 2023 13:36:42 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 27 commits: Remove unused files in .gitlab Message-ID: <64b970aaa2909_91ceb7840139635@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 81a1213b by Alan Zimmerman at 2023-07-20T18:34:07+01:00 Summary: epa-improve-comb4-5 Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-27 23:08:05 +0100 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 23699f8f by Alan Zimmerman at 2023-07-20T18:34:07+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - 57d382de by Alan Zimmerman at 2023-07-20T18:34:08+01:00 Summary: EPA make getLocA a synonym for getHasLoc Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-16 09:25:10 +0100 EPA make getLocA a synonym for getHasLoc - - - - - 4760cf2b by Alan Zimmerman at 2023-07-20T18:34:08+01:00 EPA: Fix span for GRHS - - - - - b00b8591 by Alan Zimmerman at 2023-07-20T18:34:08+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 66fa8a92 by Alan Zimmerman at 2023-07-20T18:34:08+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 Summary: Patch: summary-epa-use-full-range-for Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:34:57 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] info: patch template saved to `-` - - - - - f3f2dec1 by Alan Zimmerman at 2023-07-20T18:34:08+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - c5b5235e by Alan Zimmerman at 2023-07-20T18:34:08+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - a8e47fb4 by Alan Zimmerman at 2023-07-20T18:34:08+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 0a8b6409 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 5167de07 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 Summary: Patch: use-anchor-end-as-prior-end Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-25 12:41:37 +0100 EPA: Use the current Anchor end as prior end Use the original anchor location end as the source of truth for calculating print deltas. This allows original spacing to apply in most cases, only changed AST items need initial delta positions. - - - - - 35a1faa3 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - dd21eee6 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 7c4907c8 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 9f74f7e1 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 700f01b6 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA: Fix simple tests - - - - - c7571a84 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 6f72bf74 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 43e452e4 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA: deal with fallout from getMonoBind - - - - - 8bdea9d1 by Alan Zimmerman at 2023-07-20T18:34:09+01:00 EPA fix captureLineSpacing - - - - - 776fff3d by Alan Zimmerman at 2023-07-20T18:34:10+01:00 EPA print any comments in the span before exiting it - - - - - 53fff66c by Alan Zimmerman at 2023-07-20T18:34:10+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 7e6f6e4f by Alan Zimmerman at 2023-07-20T18:34:10+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 27 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2698fa3c0210691b2b77af166c6bc5cd9959bbc8...7e6f6e4fd88f19d641af16ea71cd1d164bf0814a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2698fa3c0210691b2b77af166c6bc5cd9959bbc8...7e6f6e4fd88f19d641af16ea71cd1d164bf0814a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 17:44:37 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Thu, 20 Jul 2023 13:44:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-improve-comb4-5 Message-ID: <64b97285d3980_91ceb77f01427b0@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-improve-comb4-5 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-improve-comb4-5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 18:20:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 14:20:14 -0400 Subject: [Git][ghc/ghc][wip/T22834] nativeGen: Set explicit section types on all platforms Message-ID: <64b97ade9bb68_91ceb7854188619@gitlab.mail> Ben Gamari pushed to branch wip/T22834 at Glasgow Haskell Compiler / GHC Commits: 4052fbb0 by Ben Gamari at 2023-07-20T14:19:55-04:00 nativeGen: Set explicit section types on all platforms - - - - - 1 changed file: - compiler/GHC/CmmToAsm/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -248,6 +248,7 @@ pprGNUSectionHeader config t suffix = Text | OSMinGW32 <- platformOS platform -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4052fbb0af545c277fcf72c5e1ffd7a63102d474 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4052fbb0af545c277fcf72c5e1ffd7a63102d474 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 18:26:53 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 14:26:53 -0400 Subject: [Git][ghc/ghc][wip/T23210] 186 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <64b97c6d92f0f_91ceb780418936a@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 53e14a83 by Ben Gamari at 2023-07-20T14:22:37-04:00 rts: Tighten up invariants of PACK - - - - - 32689fe0 by Ben Gamari at 2023-07-20T14:22:38-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - df9b1c4b by Ben Gamari at 2023-07-20T14:22:38-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 28 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91fd470830308a9c66358f5bd00a1b8ffa549824...df9b1c4bbc96987eaf3b219ef68746ea7c7d28d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/91fd470830308a9c66358f5bd00a1b8ffa549824...df9b1c4bbc96987eaf3b219ef68746ea7c7d28d4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 19:18:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 15:18:49 -0400 Subject: [Git][ghc/ghc][ghc-9.8] 5 commits: configure: Bump minimal boot GHC version to 9.4 Message-ID: <64b988992b93f_1115e7b7818657a7@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 0d7a34c1 by Ben Gamari at 2023-07-18T20:36:07-04:00 configure: Bump minimal boot GHC version to 9.4 - - - - - ed28b0f2 by Ben Gamari at 2023-07-18T20:36:07-04:00 rts/win32: Ensure reliability of IO manager shutdown When the Win32 threaded IO manager shuts down, `ioManagerDie` sends an `IO_MANAGER_DIE` event to the IO manager thread using the `io_manager_event` event object. Finally, it will closes the event object, and invalidate `io_manager_event`. Previously, `readIOManagerEvent` would see that `io_manager_event` is invalid and return `0`, suggesting that everything is right with the world. This meant that if `ioManagerDie` invalidated the handle before the event manager was blocked on the event we would end up in a situation where the event manager would never realize it was asked to shut down. Fix this by ensuring that `readIOManagerEvent` instead returns `IO_MANAGER_DIE` when we detect that the event object has been invalidated by `ioManagerDie`. Fixes #23691. - - - - - 68cc675d by Ben Gamari at 2023-07-19T13:54:38-04:00 Bump array submodule to v0.5.6.0 - - - - - 6200e8fa by Ben Gamari at 2023-07-19T21:06:46-04:00 Bump containers submodule - - - - - 8b95c0e8 by Ben Gamari at 2023-07-19T21:06:46-04:00 users guide: Fix release notes and other documentation issues - - - - - 6 changed files: - − docs/users_guide/9.6.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/ghc_config.py.in - rts/win32/ThrIOManager.c - utils/haddock Changes: ===================================== docs/users_guide/9.6.1-notes.rst deleted ===================================== @@ -1,264 +0,0 @@ -.. _release-9-6-1: - -Version 9.6.1 -============== - -Language -~~~~~~~~ - -- GHC is now more conservative when solving constraints that arise from - superclass expansion in terms of other constraints that also arise from - superclass expansion. - - For example: :: - - class C a - class C a => D a b - instance D a a => D a b - - When typechecking the instance, we need to also solve the constraints arising - from the superclasses of ``D``; in this case, we need ``C a``. We could obtain - evidence for this constraint by expanding the superclasses of the context, - as ``D a a`` also has a superclass context of ``C a``. - However, is it unsound to do so in general, as we might be assuming precisely - the predicate we want to prove! This can lead to programs that loop at runtime. - - When such potentially-loopy situations arise, GHC now emits a warning. - In future releases, this behaviour will no longer be supported, and the - typechecker will outright refuse to solve these constraints, emitting a - ``Could not deduce`` error. - - In practice, you should be able to fix these issues by adding the necessary - constraint to the context, e.g. for the above example: :: - - instance (C a, D a a) => D a b - -- Record updates for GADTs and other existential datatypes are now - fully supported. - - For example: :: - - data D b where - MkD :: { fld1 :: a -> a, fld2 :: a -> (), fld3 :: b } -> D b - - foo :: D b -> D b - foo d = d { fld1 = id, fld2 = const () } - - In this example, we have an existential variable ``a``, and we update - all fields whose type involves ``a`` at once, so the update is valid. - - A side-effect of this change is that GHC now rejects some record updates - involving fields whose types contain type families (these record updates - were previously erroneously accepted). - - Example: :: - - type family F a where - F Int = Char - F Float = Char - - data T b = MkT { x :: [Int], y :: [F b] } - - emptyT :: forall b. T b - emptyT = MkT [] [] - - bar :: T Int - bar = emptyT { x = [3] } - - In this example, we can't infer the type of ``emptyT`` in ``bar``: it could be - ``T Int``, but it could also be ``T Float`` because the type family ``F`` - is not injective and ``T Float ~ T Int``. Indeed, the following typechecks :: - - baz :: T Int - baz = case ( emptyT :: T Float ) of { MkT _ y -> MkT [3] y } - - This means that the type of ``emptyT`` is ambiguous in the definition - of ``bar`` above, and thus GHC rejects the record update: :: - - Couldn't match type `F b0' with `Char' - Expected: [F Int] - Actual: [F b0] - NB: ‘F’ is a non-injective type family - The type variable ‘b0’ is ambiguous - - To fix these issues, add a type signature to the expression that the - record update is applied to (``emptyT`` in the example above), or - add an injectivity annotation to the type family in the case that - the type family is in fact injective. - -- Error messages are now assigned unique error codes, of the form ``[GHC-12345]``. - -- GHC Proposal `#106 - `_ - has been implemented, introducing a new language extension - :extension:`TypeData`. This extension permits ``type data`` declarations - as a more fine-grained alternative to :extension:`DataKinds`. - -- GHC now does a better job of solving constraints in the presence of multiple - matching quantified constraints. For example, if we want to solve - ``C a b Int`` and we have matching quantified constraints: :: - - forall x y z. (Ord x, Enum y, Num z) => C x y z - forall u v. (Enum v, Eq u) => C u v Int - - Then GHC will use the second quantified constraint to solve ``C a b Int``, - as it has a strictly weaker precondition. - -- GHC proposal `#170 Unrestricted OverloadedLabels - `_ - has been implemented. - This extends the variety syntax for constructing labels under :extension:`OverloadedLabels`. - Examples of newly allowed syntax: - - Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"` - - Numeric characters: `#1728` equivalent to `getLabel @"1728"` - - Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"` - -Compiler -~~~~~~~~ - -- The `WebAssembly backend - `_ - has been merged. This allows GHC to be built as a cross-compiler - that targets ``wasm32-wasi`` and compiles Haskell code to - self-contained WebAssembly modules that can be executed on a variety - of different runtimes. There are a few caveats to be aware of: - - - To use the WebAssembly backend, one would need to follow the - instructions on `ghc-wasm-meta - `_. The WebAssembly - backend is not included in the GHC release bindists for the time - being, nor is it supported by ``ghcup`` or ``stack`` yet. - - The WebAssembly backend is still under active development. It's - presented in this GHC version as a technology preview, bugs and - missing features are expected. - -- The JavaScript backend has been merged. GHC is now able to be built as a - cross-compiler targeting the JavaScript platform. The backend should be - considered a technology preview. As such it is not ready for use in - production, is not distributed in the GHC release bindists and requires the - user to manually build GHC as a cross-compiler. See the JavaScript backend - `wiki `_ page - on the GHC wiki for the current status, project roadmap, build instructions - and demos. - -- The :extension:`TypeInType` is now marked as deprecated. Its meaning has been included - in :extension:`PolyKinds` and :extension:`DataKinds`. - -- The :ghc-flag:`-Woperator-whitespace` warning no longer ignores constructor symbols - (operators starting with ``:``). - -- The :ghc-flag:`-Wstar-is-type` warning is now enabled by default. - -GHCi -~~~~ - -- GHCi will now accept any file-header pragmas it finds, such as - ``{-# OPTIONS_GHC ... #-}`` and ``{-# LANGUAGE ... #-}`` (see :ref:`pragmas`). For example, - instead of using :ghci-cmd:`:set` to enable :ghc-flag:`-Wmissing-signatures`, - you could instead write: - - .. code-block:: none - - ghci> {-# OPTIONS_GHC -Wmissing-signatures #-} - -This can be convenient when pasting large multi-line blocks of code into GHCi. - -Runtime system -~~~~~~~~~~~~~~ - -- The `Delimited continuation primops `_ - proposal has been implemented, adding native support for first-class, - delimited continuations to the RTS. For the reasons given in the proposal, - no safe API to access this functionality is provided anywhere in ``base``. - Instead, the ``prompt#`` and ``control0#`` primops are intended to be consumed - by library authors directly, who may wrap them a safe API that maintains the - necessary invariants. See the documentation in ``GHC.Prim`` for more details. - -- The behaviour of the ``-M`` flag has been made more strict. It will now trigger - a heap overflow if the total amount of memory used by the Haskell heap exceeds the limit. - Previously only live blocks were taken into account. - This makes it more likely to trigger promptly when the heap is highly fragmented. - -- Fixed a bug that sometimes caused live sparks to be GC'ed too early either during - minor GC or major GC with workstealing disabled. See #22528. - - -``base`` library -~~~~~~~~~~~~~~~~ - -- Exceptions thrown by weak pointer finalizers can now be reported by setting - a global exception handler, using ``GHC.Weak.Finalize.setFinalizerExceptionHandler``. - The default behaviour is unchanged (exceptions are ignored and not reported). - -- GHC now provides a set of operations for introspecting on the threads of a - program, ``GHC.Conc.listThreads``, as well as operations for querying a thread's - label (:base-ref:`GHC.Conc.Sync.threadLabel`) and status - (:base-ref:`GHC.Conc.threadStatus`). - -- Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use - ``(<=)`` instead of ``compare`` per CLC proposal: - https://github.com/haskell/core-libraries-committee/issues/24 - -- Updated to `Unicode 15.0.0 `_. - -- Add standard Unicode case predicates :base-ref:`Data.Char.isUpperCase` and - :base-ref:`Data.Char.isLowerCase`. These predicates use the standard Unicode - case properties and are more intuitive than :base-ref:`Data.Char.isUpper` and - :base-ref:`Data.Char.isLower`. - -``ghc-prim`` library -~~~~~~~~~~~~~~~~~~~~ - -``ghc`` library -~~~~~~~~~~~~~~~ - -- Add `Foreign.C.Types.ConstPtr` was added to encode ``const``-qualified pointer return - types in foreign declarations when using ``CApiFFI`` extension. - -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ - - -Included libraries ------------------- - -The package database provided with this distribution also contains a number of -packages other than GHC itself. See the changelogs provided with these packages -for further change information. - -.. ghc-package-list:: - - libraries/array/array.cabal: Dependency of ``ghc`` library - libraries/base/base.cabal: Core library - libraries/binary/binary.cabal: Dependency of ``ghc`` library - libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library - libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility - libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility - libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library - libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library - libraries/directory/directory.cabal: Dependency of ``ghc`` library - libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library - libraries/filepath/filepath.cabal: Dependency of ``ghc`` library - compiler/ghc.cabal: The compiler itself - libraries/ghci/ghci.cabal: The REPL interface - libraries/ghc-boot/ghc-boot.cabal: Internal compiler library - libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library - libraries/ghc-compact/ghc-compact.cabal: Core library - libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library - libraries/ghc-prim/ghc-prim.cabal: Core library - libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable - libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable - libraries/integer-gmp/integer-gmp.cabal: Core library - libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library - libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library - libraries/pretty/pretty.cabal: Dependency of ``ghc`` library - libraries/process/process.cabal: Dependency of ``ghc`` library - libraries/stm/stm.cabal: Dependency of ``haskeline`` library - libraries/template-haskell/template-haskell.cabal: Core library - libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library - libraries/text/text.cabal: Dependency of ``Cabal`` library - libraries/time/time.cabal: Dependency of ``ghc`` library - libraries/transformers/transformers.cabal: Dependency of ``ghc`` library - libraries/unix/unix.cabal: Dependency of ``ghc`` library - libraries/Win32/Win32.cabal: Dependency of ``ghc`` library - libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -3,21 +3,16 @@ Version 9.8.1 ============= -Language -~~~~~~~~ - -- There is a new extension :extension:`ExtendedLiterals`, which enables - sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. - See the GHC proposal `#451 `_. +The significant changes to the various parts of the compiler are listed in the +following sections. See the `migration guide +`_ on the GHC Wiki +for specific guidance on migrating programs to this release. -- GHC Proposal `#425 - `_ - has been partially implemented. Namely, the ``@k``-binders in type declarations are now permitted:: - - type T :: forall k. k -> forall j. j -> Type - data T @k (a :: k) @(j :: Type) (b :: j) +The :ghc-flag:`LLVM backend <-fllvm>` of this release is to be used with LLVM +11, 12, 13, 14 or 15. - This feature is guarded behind :extension:`TypeAbstractions`. +Breaking changes +~~~~~~~~~~~~~~~~ - In accordance with GHC proposal `#425 `_ @@ -35,6 +30,49 @@ Language type instance forall j . F1 Int = Any :: j -> j +- Data types with ``deriving`` clauses now reject inferred instance contexts + that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as + this one: :: + + newtype Foo = Foo Int + + class Bar a where + bar :: a + + instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined + + newtype Baz = Baz Foo + deriving Bar + + Here, the derived ``Bar`` instance for ``Baz`` would look like this: :: + + instance TypeError (Text "Boo") => Bar Baz + + While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``" + in the resulting error message. If you really want to derive this instance and + defer the error to sites where the instance is used, you must do so manually + with :extension:`StandaloneDeriving`, e.g. :: + + deriving instance TypeError (Text "Boo") => Bar Baz + + +Language +~~~~~~~~ + +- There is a new extension :extension:`ExtendedLiterals`, which enables + sized primitive numeric literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. + See the GHC proposal `#451 `_. + +- GHC Proposal `#425 + `_ + has been partially implemented. Namely, the ``@k``-binders in type declarations are now permitted:: + + type T :: forall k. k -> forall j. j -> Type + data T @k (a :: k) @(j :: Type) (b :: j) + + This feature is guarded behind :extension:`TypeAbstractions`. + Compiler ~~~~~~~~ @@ -58,9 +96,9 @@ Compiler - Incoherent instance applications are no longer specialised. The previous implementation of specialisation resulted in nondeterministic instance resolution in certain cases, breaking - the specification described in the documentation of the `INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. + the specification described in the documentation of the :pragma:`INCOHERENT` pragma. See :ghc-ticket:`22448` for further details. -- Fix a bug in TH causing excessive calls to ``setNumCapabilities`` when ``-j`` is greater than ``-N``. +- Fix a bug in TemplateHaskell evaluation causing excessive calls to ``setNumCapabilities`` when :ghc-flag:`-j[⟨n⟩]` is greater than :rts-flag:`-N`. See :ghc-ticket:`23049`. - The ``-Wno-⟨wflag⟩``, ``-Werror=⟨wflag⟩`` and ``-Wwarn=⟨wflag⟩`` options are @@ -86,45 +124,21 @@ Compiler blah x = x { foo = 5, bar = 6 } - The point is that only the type S has a constructor with both fields "foo" - and "bar", so this record update is unambiguous. - -- Data types with ``deriving`` clauses now reject inferred instance contexts - that mention ``TypeError`` constraints (see :ref:`custom-errors`), such as - this one: :: - - newtype Foo = Foo Int - - class Bar a where - bar :: a - - instance (TypeError (Text "Boo")) => Bar Foo where - bar = undefined - - newtype Baz = Baz Foo - deriving Bar - - Here, the derived ``Bar`` instance for ``Baz`` would look like this: :: - - instance TypeError (Text "Boo") => Bar Baz + The point is that only the type S has a constructor with both fields ``foo`` + and ``bar``, so this record update is unambiguous. - While GHC would accept this before, GHC 9.8 now rejects it, emitting "``Boo``" - in the resulting error message. If you really want to derive this instance and - defer the error to sites where the instance is used, you must do so manually - with :extension:`StandaloneDeriving`, e.g. :: - - deriving instance TypeError (Text "Boo") => Bar Baz - -- GHC Proposal `#540 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0540-jsem.rst`_ has been implemented. - This adds the `-jsem`:ghc-flag: flag, which instructs GHC to act as a jobserver client. +- GHC Proposal `#540 `_ has been implemented. + This adds the :ghc-flag:`-jsem` flag, which instructs GHC to act as a jobserver client. This enables multiple GHC processes running at once to share system resources with each other, communicating via the system semaphore specified by the flag argument. + Complementary support for this feature in ``cabal-install`` will come soon. + - GHC Proposal `#433 `_ has been implemented. This adds the class ``Unsatisfiable :: ErrorMessage -> Constraint`` - to the ``GHC.TypeError`` module. Constraints of the form ``Unsatisfiable msg`` + to the :base-ref:`GHC.TypeError` module. Constraints of the form ``Unsatisfiable msg`` provide a mechanism for custom type errors that reports the errors in a more predictable behaviour than ``TypeError``, as these constraints are handled purely during constraint solving. @@ -137,27 +151,31 @@ Compiler This allows errors to be reported when users use the instance, even when type errors are being deferred. -- GHC is now deals "insoluble Givens" in a consistent way. For example: :: +- GHC now deals with "insoluble Givens" in a consistent way. For example: :: k :: (Int ~ Bool) => Int -> Bool k x = x - GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. + GHC used to accept the contradictory ``Int~Bool`` in the type signature, but + reject the ``Int~Bool`` constraint that arises from typechecking the + definition itself. Now it accepts both. More details in + :ghc-ticket:`23413`, which gives examples of the previous inconsistency. GHC + now implements the "PermissivePlan" described in that ticket. -- The `-ddump-spec` flag has been split into `-ddump-spec` and - `-ddump-spec-constr`, allowing only output from the typeclass specialiser or - `SpecConstr` to be seen if desired. +- The :ghc-flag:`-ddump-spec` flag has been split into :ghc-flag:`-ddump-spec` and + :ghc-flag:`-ddump-spec-constr`, allowing only output from the typeclass specialiser or + data-constructor specialiser to be dumped if desired. - The compiler may now be configured to compress the debugging information included in :ghc-flag:`-finfo-table-map` enabled binaries. To do so, one must build GHC from source (see - `here` for directions) + `here `_ for directions) and supply the ``--enable-ipe-data-compression`` flag to the ``configure`` script. **Note**: This feature requires that the machine building GHC has `libzstd `_ version 1.4.0 or greater installed. The compression library `libzstd` may optionally be statically linked in the resulting compiler (on non-darwin machines) using the - `--enable-static-libzstd` configure flag. + ``--enable-static-libzstd`` configure flag. In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. @@ -169,11 +187,11 @@ Compiler For example :: - module X ( - {-# WARNING "do not use that constructor" D(D1), - D(D2) - ) - D = D1 | D2 + module X + ( {-# DEPRECATE D(D1) "D1 will not be exposed in a version 0.2 and later" #-} + D(D1, D2) + ) where + data D = D1 | D2 This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface @@ -182,7 +200,10 @@ Compiler GHCi ~~~~ -- The deprecated `:ctags` and `:etags` GHCi commands have been removed. See this `wiki page `_ if you want to add a macro to recover similar functionality. +- The deprecated ``:ctags`` and ``:etags`` GHCi commands have been removed. See + this `wiki page + `_ if you + want to add a macro to recover similar functionality. Runtime system ~~~~~~~~~~~~~~ @@ -193,7 +214,7 @@ Runtime system ``base`` library ~~~~~~~~~~~~~~~~ -- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``. +- :base-ref:`Data.Tuple` now exports ``getSolo :: Solo a -> a``. ``ghc-prim`` library ~~~~~~~~~~~~~~~~~~~~ @@ -211,7 +232,7 @@ Runtime system - New primops for fused multiply-add operations. These primops combine a multiplication and an addition, compiling to a single instruction when - the ``-mfma`` flag is enabled and the architecture supports it. + the :ghc-flag:`-mfma` flag is enabled and the architecture supports it. The new primops are ``fmaddFloat#, fmsubFloat#, fnmaddFloat#, fnmsubFloat# :: Float# -> Float# -> Float# -> Float#`` and ``fmaddDouble#, fmsubDouble#, fnmaddDouble#, fnmsubDouble# :: Double# -> Double# -> Double# -> Double#``. @@ -243,21 +264,18 @@ Runtime system - The extensions fields of constructors of ``IE`` now take ``Maybe (WarningTxt p)`` in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. This represents the warning assigned to a certain export item, - which is used for :ref:`deprecated-exports`. - -``ghc-heap`` library -~~~~~~~~~~~~~~~~~~~~ + which is used for :pragma:`deprecated exports `. ``template-haskell`` library ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Record fields now belong to separate ``NameSpace``s, keyed by the parent of +- Record fields now belong to separate ``NameSpace``\ s, keyed by the parent of the record field. This is the name of the first constructor of the parent type, even if this constructor does not have the field in question. - This change enables TemplateHaskell support for ``DuplicateRecordFields``. + This change enables :extension:`TemplateHaskell` support for :extension:`DuplicateRecordFields`. Included libraries ------------------- +~~~~~~~~~~~~~~~~~~ The package database provided with this distribution also contains a number of packages other than GHC itself. See the changelogs provided with these packages @@ -290,6 +308,7 @@ for further change information. libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library libraries/pretty/pretty.cabal: Dependency of ``ghc`` library libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/semaphore-compat/semaphore-compat.cabal: Dependency of ``ghc`` library libraries/stm/stm.cabal: Dependency of ``haskeline`` library libraries/template-haskell/template-haskell.cabal: Core library libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library ===================================== docs/users_guide/exts/implicit_parameters.rst ===================================== @@ -181,7 +181,7 @@ Adding a type signature dramatically changes the result! This is a rather counter-intuitive phenomenon, worth watching out for. Implicit parameters scoping guarantees -------------------------------------- +-------------------------------------- GHC always takes the most nested implicit parameter binding from the context to find the value. Consider the following code:: ===================================== docs/users_guide/ghc_config.py.in ===================================== @@ -1,6 +1,6 @@ extlinks = { - 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '%s'), - 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '#%s'), + 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#%s'), + 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '%s'), } libs_base_uri = '../libraries' ===================================== rts/win32/ThrIOManager.c ===================================== @@ -79,7 +79,9 @@ readIOManagerEvent (void) } } } else { - res = 0; + // Making it here means that we have hit ioManagerDie, which + // closed our event object. + res = IO_MANAGER_DIE; } OS_RELEASE_LOCK(&event_buf_mutex); ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 98c285fd9c6057b34341f91c2261d00df803735a +Subproject commit 7df029a19f38234af266ab1183eee768ad2d8516 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/031d7f7ca035cfe87a72da5c757ba85e52c50a40...8b95c0e822c39bec2153289d6e17ab24d024df0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/031d7f7ca035cfe87a72da5c757ba85e52c50a40...8b95c0e822c39bec2153289d6e17ab24d024df0d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 19:18:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 15:18:59 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 15 commits: JS: fix JS stack printing (#23565) Message-ID: <64b988a3b4bee_1115e7b77f065989@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: fb4ecd83 by Sylvain Henry at 2023-07-20T14:33:08-04:00 JS: fix JS stack printing (#23565) (cherry picked from commit 78b2f3ccb1d7603e11b3f364646240e361512cbc) - - - - - 77117e5f by Dave Barton at 2023-07-20T14:33:15-04:00 Fix some broken links and typos (cherry picked from commit 4457da2a7dba97ab2cd2f64bb338c904bb614244) - - - - - 7cec29d8 by Matthew Pickering at 2023-07-20T14:34:13-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 (cherry picked from commit 9f01d14b5bc1c73828b2b061206c45b84353620e) - - - - - e5215256 by Mario Blažević at 2023-07-20T14:34:45-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals (cherry picked from commit 4af7eac2a00e86c29509c119aacc7511a9c7747d) - - - - - d33581c5 by sheaf at 2023-07-20T14:34:56-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. (cherry picked from commit 2b55cb5f33666a71eaac7968c59e483860112e5c) - - - - - 0c877166 by Matthew Pickering at 2023-07-20T14:35:33-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 (cherry picked from commit 76983a0dca64dfb7e94aea0c4f494921f8513b41) - - - - - 30830523 by Bodigrim at 2023-07-20T14:35:40-04:00 Add since annotations for Data.Foldable1 (cherry picked from commit 054261dd319b505392458da7745e768847015887) - - - - - fd3fcfe5 by sheaf at 2023-07-20T14:35:50-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 (cherry picked from commit 61b1932eb7d529263330dcab404909997610dd43) - - - - - 90846d43 by Sylvain Henry at 2023-07-20T14:35:56-04:00 JS: support -this-unit-id for programs in the linker (#23613) (cherry picked from commit 550af50559931b7681fe24fddafd6e3467de077c) - - - - - b9c2aa3f by sheaf at 2023-07-20T14:36:44-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 (cherry picked from commit 630e302617a4a3e00d86d0650cb86fa9e6913e44) - - - - - e5ed9c58 by Matthew Pickering at 2023-07-20T14:54:03-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 (cherry picked from commit c39f279b7a23e7c3259dff9ad660b7f417d4fdcd) - - - - - ba2f9f34 by Krzysztof Gogolewski at 2023-07-20T14:54:23-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. (cherry picked from commit bf9b9de0685e23c191722dfdb78d28b44f1cba05) - - - - - e0fbb1d4 by Vladislav Zavialov at 2023-07-20T14:54:29-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. (cherry picked from commit 7f13acbf187d7a0810f42705b95d593b1e2e5611) - - - - - 27df38c2 by Sylvain Henry at 2023-07-20T15:04:52-04:00 JS: better implementation for plusWord64 (#23597) (cherry picked from commit b55a8ea70424032c19ef85ef95c5eee8b50d55c3) - - - - - 8f77107f by Krzysztof Gogolewski at 2023-07-20T15:06:18-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. (cherry picked from commit 787bae96f77562e603b6e9ebb86139cc5d120b8d) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/TyThing.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/pragmas.rst - docs/users_guide/exts/type_families.rst - docs/users_guide/exts/view_patterns.rst - docs/users_guide/using-optimisation.rst - libraries/base/Data/Foldable1.hs - libraries/base/changelog.md - libraries/ghc-prim/GHC/Tuple/Prim.hs - libraries/ghc-prim/GHC/Types.hs - libraries/ghc-prim/changelog.md - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - rts/js/arith.js The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b95c0e822c39bec2153289d6e17ab24d024df0d...8f77107f691b9f2f4ebaa5b331bdf8ca62e503ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b95c0e822c39bec2153289d6e17ab24d024df0d...8f77107f691b9f2f4ebaa5b331bdf8ca62e503ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 19:26:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 15:26:16 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] Fix typechecking of promoted empty lists Message-ID: <64b98a5841247_1115e7b786872670@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 6e044db1 by Ryan Scott at 2023-07-20T15:24:43-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. (cherry picked from commit c335fb7c44a8447b3e73e7f18d9d0dcb18cea8dd) - - - - - 7 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/ghci/scripts/T15898.stderr - testsuite/tests/ghci/scripts/T6018ghcifail.stderr - testsuite/tests/ghci/scripts/T7939.stdout - + testsuite/tests/typecheck/should_compile/T23543.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T6018fail.stderr Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1253,6 +1253,12 @@ tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind --------- Promoted lists and tuples tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind + -- The '[] case is handled in tc_infer_hs_type. + -- See Note [Future-proofing the type checker]. + | null tys + = tc_infer_hs_type_ek mode rn_ty exp_kind + + | otherwise = do { tks <- mapM (tc_infer_lhs_type mode) tys ; (taus', kind) <- unifyKinds tys tks ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus') ===================================== testsuite/tests/ghci/scripts/T15898.stderr ===================================== @@ -18,7 +18,7 @@ In an equation for ‘it’: it = undefined :: [(), ()] :6:14: error: [GHC-83865] - • Expected a type, but ‘'( '[], '[])’ has kind ‘([k0], [k1])’ + • Expected a type, but ‘'( '[], '[])’ has kind ‘([a0], [a1])’ • In an expression type signature: '( '[], '[]) In the expression: undefined :: '( '[], '[]) In an equation for ‘it’: it = undefined :: '( '[], '[]) ===================================== testsuite/tests/ghci/scripts/T6018ghcifail.stderr ===================================== @@ -41,18 +41,18 @@ :55:41: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at :55:41 :60:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at :60:15 :64:15: error: [GHC-05175] ===================================== testsuite/tests/ghci/scripts/T7939.stdout ===================================== @@ -19,12 +19,12 @@ type family H a where H False = True -- Defined at T7939.hs:15:1 H :: Bool -> Bool -type J :: forall {k}. [k] -> Bool -type family J a where +type J :: forall {a}. [a] -> Bool +type family J a1 where J '[] = False - forall k (h :: k) (t :: [k]). J (h : t) = True + forall a (h :: a) (t :: [a]). J (h : t) = True -- Defined at T7939.hs:18:1 -J :: [k] -> Bool +J :: [a] -> Bool type K :: forall {a}. [a] -> Maybe a type family K a1 where K '[] = Nothing ===================================== testsuite/tests/typecheck/should_compile/T23543.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T23543 where + +type N :: forall a. Maybe a +type N = ('Nothing :: forall a. Maybe a) + +type L :: forall a. [a] +type L = ('[] :: forall a. [a]) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -875,6 +875,7 @@ test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) test('T23156', normal, compile, ['']) +test('T23543', normal, compile, ['']) test('T22560a', normal, compile, ['']) test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T6018fail.stderr ===================================== @@ -52,18 +52,18 @@ T6018fail.hs:53:15: error: [GHC-05175] T6018fail.hs:61:10: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:61:10 T6018fail.hs:64:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:64:15 T6018fail.hs:68:15: error: [GHC-05175] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e044db19db65f824837bfdc15ba3def0315b6e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e044db19db65f824837bfdc15ba3def0315b6e4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 19:36:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 15:36:41 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-9.8-2 Message-ID: <64b98cc975b9e_1115e7b786874759@gitlab.mail> Ben Gamari pushed new branch wip/ghc-9.8-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-9.8-2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 19:43:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 15:43:28 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] gitlab-ci: Don't run nonmoving_gc job in release pipeline Message-ID: <64b98e606ba04_1115e7b77dc80046@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: ccb9981b by Ben Gamari at 2023-07-20T15:42:40-04:00 gitlab-ci: Don't run nonmoving_gc job in release pipeline This is merely intended to be a validation job. - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -930,7 +930,7 @@ job_groups = make_wasm_jobs wasm_build_config {bignumBackend = Native} , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} - , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , addValidateRule NonmovingGc (validateBuilds Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) , modifyNightlyJobs (addJobRule Disable) $ addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] @@ -1017,6 +1017,7 @@ main = do ("metadata":as) -> write_result as platform_mapping _ -> error "gen_ci.hs [file.json]" +write_result :: ToJSON a => [FilePath] -> a -> IO () write_result as obj = (case as of [] -> B.putStrLn ===================================== .gitlab/jobs.yaml ===================================== @@ -2916,68 +2916,6 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc", - "BUILD_FLAVOUR": "release+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", - "HADRIAN_ARGS": "--hash-unit-ids", - "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", - "TEST_ENV": "x86_64-linux-deb11-release+boot_nonmoving_gc", - "XZ_OPT": "-9" - } - }, "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccb9981bf74b78194d9baef9d9483235968b8849 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccb9981bf74b78194d9baef9d9483235968b8849 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 20 21:42:47 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 17:42:47 -0400 Subject: [Git][ghc/ghc][wip/T23210] 7 commits: Remove unused files in .gitlab Message-ID: <64b9aa578f901_19cb1ab787c101258@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 27104adf by Ben Gamari at 2023-07-20T17:40:27-04:00 rts: Tighten up invariants of PACK - - - - - 8b8ccfbf by Ben Gamari at 2023-07-20T17:40:27-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 5b5d7271 by Ben Gamari at 2023-07-20T17:40:27-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 10 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Parser.y - compiler/GHC/Stg/Utils.hs - compiler/GHC/StgToByteCode.hs - rts/Interpreter.c - rts/include/rts/storage/InfoTables.h Changes: ===================================== .gitlab-ci.yml ===================================== @@ -432,7 +432,7 @@ hadrian-multi: paths: - cabal-cache rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # stack-hadrian-build @@ -830,7 +830,7 @@ perf-nofib: - if: $CI_MERGE_REQUEST_ID - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' tags: - x86_64-linux before_script: @@ -897,7 +897,7 @@ perf: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ # ABI testing @@ -937,7 +937,7 @@ abi-test: paths: - out rules: - - if: '$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' ############################################################ ===================================== .gitlab/gen-ci.cabal deleted ===================================== @@ -1,18 +0,0 @@ -cabal-version: 3.0 -name: gen-ci -version: 0.1.0.0 -build-type: Simple - -common warnings - ghc-options: -Wall - -executable gen_ci - import: warnings - main-is: gen_ci.hs - build-depends: - , aeson >=1.8.1 - , base - , bytestring - , containers - - default-language: Haskell2010 ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -556,7 +556,8 @@ instance ToJSON OnOffRules where -- | A Rule corresponds to some condition which must be satisifed in order to -- run the job. -data Rule = FastCI -- ^ Run this job when the fast-ci label is set +data Rule = FastCI -- ^ Run this job on all validate pipelines, all pipelines are enabled + -- by the "full-ci" label. | ReleaseOnly -- ^ Only run this job in a release pipeline | Nightly -- ^ Only run this job in the nightly pipeline | LLVMBackend -- ^ Only run this job when the "LLVM backend" label is present @@ -578,7 +579,7 @@ false = "\"disabled\" != \"disabled\"" -- Convert the state of the rule into a string that gitlab understand. ruleString :: OnOff -> Rule -> String ruleString On FastCI = true -ruleString Off FastCI = "$CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/" +ruleString Off FastCI = "($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)" ruleString On LLVMBackend = "$CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/" ruleString Off LLVMBackend = true ruleString On FreeBSDLabel = "$CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/" @@ -767,17 +768,25 @@ delVariable k j = j { jobVariables = MonoidalMap $ Map.delete k $ unMonoidalMap validate :: Arch -> Opsys -> BuildConfig -> NamedJob Job validate = job +-- Nightly and release apply the FastCI configuration to all jobs so that they all run in +-- the pipeline (not conditional on the full-ci label) +nightlyRule :: Job -> Job +nightlyRule = addJobRule FastCI . addJobRule Nightly + +releaseRule :: Job -> Job +releaseRule = addJobRule FastCI . addJobRule ReleaseOnly + -- | Make a normal nightly CI job nightly :: Arch -> Opsys -> BuildConfig -> NamedJob Job nightly arch opsys bc = let NamedJob n j = job arch opsys bc - in NamedJob { name = "nightly-" ++ n, jobInfo = addJobRule Nightly . keepArtifacts "8 weeks" . highCompression $ j} + in NamedJob { name = "nightly-" ++ n, jobInfo = nightlyRule . keepArtifacts "8 weeks" . highCompression $ j} -- | Make a normal release CI job release :: Arch -> Opsys -> BuildConfig -> NamedJob Job release arch opsys bc = let NamedJob n j = job arch opsys (bc { buildFlavour = Release }) - in NamedJob { name = "release-" ++ n, jobInfo = addJobRule ReleaseOnly . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} + in NamedJob { name = "release-" ++ n, jobInfo = releaseRule . keepArtifacts "1 year" . ignorePerfFailures . useHashUnitIds . highCompression $ j} -- Specific job modification functions @@ -806,6 +815,7 @@ useHashUnitIds :: Job -> Job useHashUnitIds = addVariable "HADRIAN_ARGS" "--hash-unit-ids" -- | Mark the validate job to run in fast-ci mode +-- This is default way, to enable all jobs you have to apply the `full-ci` label. fastCI :: JobGroup Job -> JobGroup Job fastCI = modifyValidateJobs (addJobRule FastCI) @@ -888,7 +898,7 @@ job_groups = [ disableValidate (standardBuilds Amd64 (Linux Debian10)) , standardBuildsWithConfig Amd64 (Linux Debian10) dwarf , validateBuilds Amd64 (Linux Debian10) nativeInt - , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) + , validateBuilds Amd64 (Linux Debian10) unreg , fastCI (validateBuilds Amd64 (Linux Debian10) debug) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure @@ -907,7 +917,7 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla)) -- Fedora33 job is always built with perf so there's one job in the normal -- validate pipeline which is built with perf. - , standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig + , fastCI (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig) -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) @@ -915,8 +925,8 @@ job_groups = , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) - , standardBuilds AArch64 Darwin - , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) + , fastCI (standardBuilds AArch64 Darwin) + , fastCI (standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. ===================================== .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml ===================================== ===================================== .gitlab/jobs.yaml ===================================== @@ -37,7 +37,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -102,7 +102,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -163,7 +163,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -224,7 +224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -290,7 +290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -352,7 +352,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -414,7 +414,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -476,7 +476,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -545,7 +545,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -609,7 +609,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -674,7 +674,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -739,7 +739,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -804,7 +804,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -868,7 +868,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -932,7 +932,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -996,7 +996,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1059,7 +1059,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1121,7 +1121,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1183,7 +1183,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1246,7 +1246,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1308,7 +1308,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1370,7 +1370,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1432,7 +1432,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1494,7 +1494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1558,7 +1558,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1622,7 +1622,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1687,7 +1687,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1749,7 +1749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1811,7 +1811,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1873,7 +1873,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1937,7 +1937,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2002,7 +2002,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2066,7 +2066,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2129,7 +2129,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2191,7 +2191,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2249,7 +2249,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2311,7 +2311,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2377,7 +2377,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2444,7 +2444,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2508,7 +2508,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2572,7 +2572,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2774,7 +2774,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2840,7 +2840,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2904,7 +2904,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2968,7 +2968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3032,7 +3032,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3096,7 +3096,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3160,7 +3160,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3224,7 +3224,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3290,7 +3290,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3356,7 +3356,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3422,7 +3422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3486,7 +3486,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3550,7 +3550,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3610,7 +3610,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3673,7 +3673,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3740,7 +3740,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3808,7 +3808,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3871,7 +3871,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3935,7 +3935,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3999,7 +3999,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4063,7 +4063,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4126,7 +4126,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4188,7 +4188,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4311,7 +4311,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4372,7 +4372,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4433,7 +4433,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4494,7 +4494,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4556,7 +4556,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4619,7 +4619,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4682,7 +4682,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4746,7 +4746,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4807,7 +4807,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Parser.y ===================================== @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 $1 $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1073,11 +1073,11 @@ qcnames1 :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list -- Variable, data constructor or wildcard -- or tagged type constructor qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } - : qcname_ext { sL1A $1 ([],$1) } - | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } + : qcname_ext { sL1 $1 ([],$1) } + | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } qcname_ext :: { LocatedA ImpExpQcSpec } - : qcname { reLocA $ sL1N $1 (ImpExpQcName $1) } + : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} @@ -1231,7 +1231,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } - | op { sL1N $1 (unitOL $1) } + | op { sL1 $1 (unitOL $1) } ----------------------------------------------------------------------------- -- Top-Level Declarations @@ -1265,12 +1265,12 @@ topdecl_cs : topdecl {% commentsPA $1 } ----------------------------------------------------------------------------- topdecl :: { LHsDecl GhcPs } - : cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | standalone_kind_sig { sL1 $1 (KindSigD noExtField (unLoc $1)) } - | inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) } - | stand_alone_deriving { sL1 $1 (DerivD noExtField (unLoc $1)) } - | role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) } + : cl_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | ty_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | standalone_kind_sig { sL1a $1 (KindSigD noExtField (unLoc $1)) } + | inst_decl { sL1a $1 (InstD noExtField (unLoc $1)) } + | stand_alone_deriving { sL1a $1 (DerivD noExtField (unLoc $1)) } + | role_annot { sL1a $1 (RoleAnnotD noExtField (unLoc $1)) } | 'default' '(' comma_types0 ')' {% acsA (\cs -> sLL $1 $> (DefD noExtField (DefaultDecl (EpAnn (glR $1) [mj AnnDefault $1,mop $2,mcp $4] cs) $3))) } | 'foreign' fdecl {% acsA (\cs -> sLL $1 $> ((snd $ unLoc $2) (EpAnn (glR $1) (mj AnnForeign $1:(fst $ unLoc $2)) cs))) } @@ -1358,7 +1358,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | oqtycon { sL1N $1 [$1] } + | oqtycon { sL1 $1 [$1] } inst_decl :: { LInstDecl GhcPs } : 'instance' overlap_pragma inst_type where_inst @@ -1438,7 +1438,7 @@ injectivity_cond :: { LInjectivityAnn GhcPs } inj_varids :: { Located [LocatedN RdrName] } : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } - | tyvarid { sL1N $1 [$1] } + | tyvarid { sL1 $1 [$1] } -- Closed type families @@ -1588,7 +1588,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] - , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } + , (sL1a $> (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] @@ -1603,7 +1603,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } - | type { sL1A $1 (Nothing, $1) } + | type { sL1 $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 @@ -1620,7 +1620,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } - | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } + | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) } capi_ctype :: { Maybe (LocatedP CType) } @@ -1755,7 +1755,7 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl_cls { sL1A $1 ([], unitOL $1) } + | decl_cls { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist_cls @@ -1781,8 +1781,8 @@ where_cls :: { Located ([AddEpAnn] -- Declarations in instance bodies -- decl_inst :: { Located (OrdList (LHsDecl GhcPs)) } -decl_inst : at_decl_inst { sL1A $1 (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) } - | decl { sL1A $1 (unitOL $1) } +decl_inst : at_decl_inst { sL1 $1 (unitOL (sL1a $1 (InstD noExtField (unLoc $1)))) } + | decl { sL1 $1 (unitOL $1) } decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_inst ';' decl_inst {% if isNilOL (snd $ unLoc $1) @@ -1842,7 +1842,7 @@ decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl { sL1A $1 ([], unitOL $1) } + | decl { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } @@ -1957,7 +1957,7 @@ rule_vars :: { [LRuleTyTmVar] } | {- empty -} { [] } rule_var :: { LRuleTyTmVar } - : varid { sL1l $1 (RuleTyTmVar noAnn $1 Nothing) } + : varid { sL1a $1 (RuleTyTmVar noAnn $1 Nothing) } | '(' varid '::' ctype ')' {% acsA (\cs -> sLL $1 $> (RuleTyTmVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3,mcp $5] cs) $2 (Just $4))) } {- Note [Parsing explicit foralls in Rules] @@ -2143,7 +2143,7 @@ sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | var { sL1N $1 [$1] } + | var { sL1 $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } : sigtype { unitOL $1 } @@ -2266,11 +2266,11 @@ tyop :: { (LocatedN RdrName, PromotionFlag) } ; return (op, IsPromoted) } } atype :: { LHsType GhcPs } - : ntgtycon {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples + : ntgtycon {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples -- See Note [%shift: atype -> tyvar] - | tyvar %shift {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) + | tyvar %shift {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) - ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } + ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } @@ -2354,7 +2354,7 @@ tv_bndr :: { LHsTyVarBndr Specificity GhcPs } | '{' tyvar '::' kind '}' {% acsA (\cs -> sLL $1 $> (KindedTyVar (EpAnn (glR $1) [moc $1,mu AnnDcolon $3 ,mcc $5] cs) InferredSpec $2 $4)) } tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } - : tyvar {% acsA (\cs -> (sL1 (reLocN $1) (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } + : tyvar {% acsA (\cs -> (sL1 $1 (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } | '(' tyvar '::' kind ')' {% acsA (\cs -> (sLL $1 $> (KindedTyVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3 ,mcp $5] cs) SpecifiedSpec $2 $4))) } fds :: { Located ([AddEpAnn],[LHsFunDep GhcPs]) } @@ -2367,7 +2367,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | fd { sL1A $1 [$1] } + | fd { sL1 $1 [$1] } fd :: { LHsFunDep GhcPs } : varids0 '->' varids0 {% acsA (\cs -> L (comb3 $1 $2 $3) @@ -2465,7 +2465,7 @@ constrs1 :: { Located [LConDecl GhcPs] } {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | constr { sL1A $1 [$1] } + | constr { sL1 $1 [$1] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff @@ -2519,7 +2519,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? - | deriving { sL1 (reLoc $>) [$1] } + | deriving { sL1 $> [$1] } -- The outer Located is just to allow the caller to -- know the rightmost extremity of the 'deriving' clause @@ -2537,9 +2537,9 @@ deriving :: { LHsDerivingClause GhcPs } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $3) $2) } deriv_clause_types :: { LDerivClauseTys GhcPs } - : qtycon { let { tc = sL1 (reLocL $1) $ mkHsImplicitSigType $ - sL1 (reLocL $1) $ HsTyVar noAnn NotPromoted $1 } in - sL1 (reLocC $1) (DctSingle noExtField tc) } + : qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $ + sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in + sL1a $1 (DctSingle noExtField tc) } | '(' ')' {% amsrc (sLL $1 $> (DctMulti noExtField [])) (AnnContext Nothing [glAA $1] [glAA $2]) } | '(' deriv_types ')' {% amsrc (sLL $1 $> (DctMulti noExtField $2)) @@ -2604,7 +2604,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } - | gdrh { sL1 (reLoc $1) [$1] } + | gdrh { sL1 $1 [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 -> @@ -2639,7 +2639,7 @@ sigdecl :: { LHsDecl GhcPs } (Fixity fixText fixPrec (unLoc $1))))) }} - | pattern_synonym_sig { sL1 $1 . SigD noExtField . unLoc $ $1 } + | pattern_synonym_sig { sL1a $1 . SigD noExtField . unLoc $ $1 } | '{-# COMPLETE' qcon_list opt_tyconsig '#-}' {% let (dcolon, tc) = $3 @@ -3236,7 +3236,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } -- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) } -- | '{|' pquals '|}' { sL1 $1 [$2] } @@ -3283,7 +3283,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } h' <- addTrailingCommaA h (gl $2) return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } ----------------------------------------------------------------------------- -- Case alternatives @@ -3321,7 +3321,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (fst $ unLoc $1, h' : t)) } - | alt(PATS) { $1 >>= \ $1 -> return $ sL1 (reLoc $1) ([],[$1]) } + | alt(PATS) { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) } alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) } : PATS alt_rhs { $2 >>= \ $2 -> @@ -3346,7 +3346,7 @@ gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } - | gdpat { $1 >>= \gdpat -> return $ sL1A gdpat [gdpat] } + | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to -- generate the open brace in addition to the vertical bar in the lexer, and @@ -3418,7 +3418,7 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( { h' <- addTrailingSemiA h (gl $2) ; return $ sL1 $1 (fst $ unLoc $1,h':t) }} | stmt { $1 >>= \ $1 -> - return $ sL1A $1 (nilOL,[$1]) } + return $ sL1 $1 (nilOL,[$1]) } | {- empty -} { return $ noLoc (nilOL,[]) } @@ -3444,7 +3444,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> - return $ sL1 $1 $ mkBodyStmt $1 } + return $ sL1a $1 $ mkBodyStmt $1 } | 'let' binds { acsA (\cs -> (sLL $1 $> $ mkLetStmt (EpAnn (glR $1) [mj AnnLet $1] cs) (unLoc $2))) } @@ -3467,13 +3467,13 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1a $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... | qvar { placeHolderPunRhs >>= \rhs -> - fmap Left $ acsa (\cs -> sL1a (reLocN $1) $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1l $1 $ mkFieldOcc $1) rhs True) } + fmap Left $ acsa (\cs -> sL1a $1 $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1a $1 $ mkFieldOcc $1) rhs True) } -- In the punning case, use a place-holder -- The renamer fills in the final value @@ -3481,7 +3481,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3497,7 +3497,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3514,7 +3514,7 @@ fieldToUpdate : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> - return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } + return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } ----------------------------------------------------------------------------- -- Implicit Parameter Bindings @@ -3530,7 +3530,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | dbind { let this = $1 in this `seq` (sL1 (reLoc $1) [this]) } + | dbind { let this = $1 in this `seq` (sL1 $1 [this]) } -- | {- empty -} { [] } dbind :: { LIPBind GhcPs } @@ -3572,10 +3572,10 @@ name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } : '(' name_boolformula ')' {% amsrl (sLL $1 $> (Parens $2)) (AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) } - | name_var { reLocA $ sL1N $1 (Var $1) } + | name_var { sL1a $1 (Var $1) } namelist :: { Located [LocatedN RdrName] } -namelist : name_var { sL1N $1 [$1] } +namelist : name_var { sL1 $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -3608,11 +3608,11 @@ con :: { LocatedN RdrName } | sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) } con_list :: { Located (NonEmpty (LocatedN RdrName)) } -con_list : con { sL1N $1 (pure $1) } +con_list : con { sL1 $1 (pure $1) } | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } -qcon_list : qcon { sL1N $1 [$1] } +qcon_list : qcon { sL1 $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -4117,28 +4117,16 @@ sL0 :: a -> Located a sL0 = L noSrcSpan -- #define L0 L noSrcSpan {-# INLINE sL1 #-} -sL1 :: GenLocated l a -> b -> GenLocated l b -sL1 x = sL (getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1A #-} -sL1A :: LocatedAn t a -> b -> Located b -sL1A x = sL (getLocA x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1N #-} -sL1N :: LocatedN a -> b -> Located b -sL1N x = sL (getLocA x) -- #define sL1 sL (getLoc $1) +sL1 :: HasLoc a => a -> b -> Located b +sL1 x = sL (getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1a #-} -sL1a :: Located a -> b -> LocatedAn t b -sL1a x = sL (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1l #-} -sL1l :: LocatedAn t a -> b -> LocatedAn u b -sL1l x = sL (l2l $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1a :: HasLoc a => a -> b -> LocatedAn t b +sL1a x = sL (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1n #-} -sL1n :: Located a -> b -> LocatedN b -sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1n :: HasLoc a => a -> b -> LocatedN b +sL1n x = L (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -9,6 +9,7 @@ module GHC.Stg.Utils , idArgs , mkUnarisedId, mkUnarisedIds + , hasNoNonZeroWidthArgs ) where import GHC.Prelude @@ -16,6 +17,7 @@ import GHC.Prelude import GHC.Types.Id import GHC.Core.Type import GHC.Core.TyCon +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.DataCon import GHC.Core ( AltCon(..) ) import GHC.Types.Tickish @@ -31,6 +33,13 @@ import GHC.Utils.Panic import GHC.Data.FastString +-- | Returns whether there are any arguments with a non-zero-width runtime +-- representation. +-- +-- Returns True if the datacon has no or /just/ zero-width arguments. +hasNoNonZeroWidthArgs :: DataCon -> Bool +hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys + mkUnarisedIds :: MonadUnique m => FastString -> [UnaryType] -> m [Id] mkUnarisedIds fs tys = mapM (mkUnarisedId fs) tys ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1855,20 +1855,18 @@ pushAtom d p (StgVarArg var) -- PUSH_G doesn't tag constructors. So we use PACK here -- if we are dealing with nullary constructor. case isDataConWorkId_maybe var of - Just con -> do - massert (isNullaryRepDataCon con) - return (unitOL (PACK con 0), szb) + Just con + -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make. + | isNullaryRepDataCon con -> do + return (unitOL (PACK con 0), szb) - Nothing -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do - massert (idType var `eqType` addrPrimTy) + _ | idType var `eqType` addrPrimTy -> return (unitOL (PUSH_ADDR (getName var)), szb) | otherwise -> do return (unitOL (PUSH_G (getName var)), szb) - pushAtom _ _ (StgLitArg lit) = pushLiteral True lit pushLiteral :: Bool -> Literal -> BcM (BCInstrList, ByteOff) ===================================== rts/Interpreter.c ===================================== @@ -1674,23 +1674,28 @@ run_BCO: } case bci_PACK: { - W_ i; - W_ o_itbl = BCO_GET_LARGE_ARG; - W_ n_words = BCO_GET_LARGE_ARG; - StgInfoTable* itbl = INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl)); - int request = CONSTR_sizeW( itbl->layout.payload.ptrs, - itbl->layout.payload.nptrs ); + int o_itbl = BCO_GET_LARGE_ARG; + int n_words = BCO_GET_LARGE_ARG; + StgConInfoTable* itbl = CON_INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl)); + int n_ptrs = itbl->i.layout.payload.ptrs; + int n_nptrs = itbl->i.layout.payload.nptrs; + int request = CONSTR_sizeW( n_ptrs, n_nptrs ); StgClosure* con = (StgClosure*)allocate_NONUPD(cap,request); - ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0); - for (i = 0; i < n_words; i++) { + ASSERT(ip_HNF(&itbl->i)); // We don't have a CON flag, HNF is a good approximation + // N. + // N.B. we may have a nullary datacon with padding, in which case + // n_nptrs=1, n_ptrs=0. + ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0)); + ASSERT(n_ptrs + n_nptrs > 0); + for (int i = 0; i < n_words; i++) { con->payload[i] = (StgClosure*)SpW(i); } Sp_addW(n_words); Sp_subW(1); // No write barrier is needed here as this is a new allocation // visible only from our stack - StgInfoTable *con_itbl = (StgInfoTable*) BCO_LIT(o_itbl); - SET_HDR(con, con_itbl, cap->r.rCCCS); + StgInfoTable *con_ptr = (StgInfoTable*) BCO_LIT(o_itbl); + SET_HDR(con, con_ptr, cap->r.rCCCS); StgClosure* tagged_con = tagConstr(con); SpW(0) = (W_)tagged_con; ===================================== rts/include/rts/storage/InfoTables.h ===================================== @@ -86,7 +86,7 @@ extern const StgWord16 closure_flags[]; #define closure_IND(c) ( closureFlags(c) & _IND) /* same as above but for info-ptr rather than closure */ -#define ipFlags(ip) (closure_flags[ip->type]) +#define ipFlags(ip) (closure_flags[(ip)->type]) #define ip_HNF(ip) ( ipFlags(ip) & _HNF) #define ip_BITMAP(ip) ( ipFlags(ip) & _BTM) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df9b1c4bbc96987eaf3b219ef68746ea7c7d28d4...5b5d727194b3bc27da10f4d163b8125bda5a192d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/df9b1c4bbc96987eaf3b219ef68746ea7c7d28d4...5b5d727194b3bc27da10f4d163b8125bda5a192d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 01:15:46 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 20 Jul 2023 21:15:46 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 2 commits: Pop error context while checking do expansion generated GRHSs inside HsLam so... Message-ID: <64b9dc427d5a2_19cb1ab77c81221ef@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 574faca8 by Apoorv Ingle at 2023-07-19T17:10:13-05:00 Pop error context while checking do expansion generated GRHSs inside HsLam so that we do not print the previous statement error context - - - - - 4230daa7 by Apoorv Ingle at 2023-07-20T20:14:10-05:00 make template haskell happy - - - - - 10 changed files: - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - + testsuite/tests/typecheck/should_fail/DoExpansion1.hs - + testsuite/tests/typecheck/should_fail/DoExpansion1.stderr - + testsuite/tests/typecheck/should_fail/DoExpansion2.hs - + testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - + testsuite/tests/typecheck/should_fail/DoExpansion3.hs - + testsuite/tests/typecheck/should_fail/DoExpansion3.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -204,14 +204,15 @@ tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe -- See Note [Application chains and heads] in GHC.Tc.Gen.App tcExpr e@(HsVar {}) res_ty = tcApp e res_ty -tcExpr e@(HsApp {}) res_ty = tcApp e res_ty +tcExpr e@(HsApp {}) res_ty = do traceTc "tcExpr" (text "hsApp") + tcApp e res_ty tcExpr e@(OpApp {}) res_ty = tcApp e res_ty tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty tcExpr e@(XExpr (ExpandedExpr {})) res_ty - = do { traceTc "tcExpr" (text "calling tcApp for expanded Expr") + = do { traceTc "tcExpr" (text "ExpandedExpr") ; tcApp e res_ty } @@ -476,11 +477,11 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L _ stmts)) res_ty +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L loc stmts)) res_ty = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo ; if isApplicativeDo then tcDoStmts doFlav ss res_ty - else do { (L loc expanded_expr) <- expandDoStmts doFlav stmts + else do { (L _ expanded_expr) <- expandDoStmts doFlav stmts -- Do expansion on the fly -- ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) ; traceTc "tcDoStmts hsDo" (vcat [ ppr hsDo @@ -488,7 +489,7 @@ tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L _ stmts)) res_ty ]) ; setSrcSpanA loc $ -- addExprCtxt (text "tcExpr") hsDo $ - tcExpr expanded_expr res_ty + (\ x -> XExpr (ExpansionExpr (HsExpanded hsDo x))) <$> (tcExpr expanded_expr res_ty) } } @@ -504,7 +505,7 @@ tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) ss@(L loc stmts)) res_ty ]) ; setSrcSpanA loc $ -- addExprCtxt (text "tcExpr") hsDo $ - tcExpr expanded_expr res_ty + (\ x -> XExpr (ExpansionExpr (HsExpanded hsDo x))) <$> (tcExpr expanded_expr res_ty) } } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -345,7 +345,7 @@ splitHsApps e = -- maybeShiftCtxt $ go (XExpr (ExpandedStmt (HsExpanded stmt fun))) _ args = go fun (VAExpansionStmt stmt) - (EWrap (EExpandStmt stmt) : args) + (EWrap (EExpandStmt stmt) : args) -- See Note [Desugar OpApp in the typechecker] go e@(OpApp _ arg1 (L l op) arg2) _ args @@ -1514,7 +1514,7 @@ mis-match in the number of value arguments. addStmtCtxt :: SDoc -> ExprLStmt GhcRn -> TcRn a -> TcRn a addStmtCtxt _ stmt thing_inside - = addErrCtxt ( {-doc <+>-} + = addErrCtxt ({-doc <+>-} pprStmtInCtxt (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) thing_inside where ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -256,7 +256,11 @@ tcMatch ctxt pat_tys rhs_ty match match@(Match { m_pats = pats, m_grhss = grhss }) = add_match_ctxt match $ do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $ - tcGRHSs ctxt grhss rhs_ty + maybeErrPopCtxt (mc_what ctxt) $ -- we are likely in a do expansion generated match + -- pop the previous context as it is + -- the one for previous statement context + do { traceTc "tcMatch" (ppr pats) + ; tcGRHSs ctxt grhss rhs_ty } ; return (Match { m_ext = noAnn , m_ctxt = mc_what ctxt, m_pats = pats' , m_grhss = grhss' }) } @@ -269,6 +273,9 @@ tcMatch ctxt pat_tys rhs_ty match StmtCtxt (HsDoStmt{}) -> thing_inside -- this is an expanded do stmt _ -> addErrCtxt (pprMatchInCtxt match) thing_inside + maybeErrPopCtxt (StmtCtxt (HsDoStmt{})) thing_inside = do traceTc "tcMatch popErrCtxt" empty + popErrCtxt thing_inside + maybeErrPopCtxt _ thing_inside = thing_inside ------------- tcGRHSs :: AnnoBody body => TcMatchCtxt body -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType @@ -1223,13 +1230,13 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ _ _)): _) = pprPanic "expand_do_stmts: Applicative Stmt" $ ppr stmt -expand_do_stmts _ [stmt@(L _ (LastStmt _ b@(L b_loc body) _ ret_expr))] +expand_do_stmts _ [stmt@(L loc (LastStmt _ (L _ body) _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt = do traceTc "expand_do_stmts last" (ppr ret_expr) - return $ L b_loc (mkPopErrCtxtExpr $ L b_loc (mkExpandedStmt stmt body)) + return $ L loc (mkPopErrCtxtExpr $ L loc (mkExpandedStmt stmt body)) | SyntaxExprRn ret <- ret_expr -- @@ -1238,9 +1245,8 @@ expand_do_stmts _ [stmt@(L _ (LastStmt _ b@(L b_loc body) _ ret_expr))] -- to make T18324 work = do traceTc "expand_do_stmts last" (ppr ret_expr) return $ wrapGenSpan (mkPopErrCtxtExpr $ - L b_loc (mkExpandedStmt stmt ( - genHsApp (wrapGenSpan ret) b))) - + wrapGenSpan (mkExpandedStmt stmt ( + genHsApp (wrapGenSpan ret) (L loc body)))) expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bs)) : lstmts) = -- stmts ~~> stmts' @@ -1250,7 +1256,7 @@ expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bs)) : lstmts) = return $ wrapGenSpan (mkPopErrCtxtExpr $ L loc (mkExpandedStmt stmt (genHsLet bs $ expand_stmts))) -expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding pat can fail @@ -1265,14 +1271,13 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ wrapGenSpan (mkPopErrCtxtExpr $ L loc (wrapGenSpan (mkExpandedStmt stmt ( - (wrapGenSpan bind_op) -- (>>=) - `genHsApp` e)) - `genHsApp` - expr)) + return $ wrapGenSpan (mkPopErrCtxtExpr $ (wrapGenSpan (mkExpandedStmt stmt ( + (wrapGenSpan ((wrapGenSpan bind_op) -- (>>=) + `genHsApp` e)) + `genHsApp` expr)))) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) -expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- @@ -1280,7 +1285,7 @@ expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : do -- isRebindableOn <- xoptM LangExt.RebindableSyntax -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ wrapGenSpan (mkPopErrCtxtExpr $ L loc ((L loc (mkExpandedStmt stmt ( + return $ wrapGenSpan (mkPopErrCtxtExpr $ wrapGenSpan ((wrapGenSpan (mkExpandedStmt stmt ( (wrapGenSpan then_op) -- (>>) `genHsApp` e))) `genHsApp` ===================================== testsuite/tests/typecheck/should_fail/DoExpansion1.hs ===================================== @@ -0,0 +1,32 @@ +module DoExpansion1 where + + +-- Ensure that >> expansions work okay + +qqqqq1 :: IO () +qqqqq1 = putStrLn 1 >> putStrLn "q2" >> putStrLn "q3" -- this should error as "In the first argument to >>" + + +qqqqq2 :: IO () +qqqqq2 = (putStrLn "q1" >> putStrLn 2) >> putStrLn "q3" -- this should error as "In first argument to >> + -- In second argument to >>" + +qqqqq3 :: IO () +qqqqq3 = putStrLn "q1" >> (putStrLn "q2" >> putStrLn 3) -- this should error as "In second argument to >> + -- In second argument to >>" + +rrrr1 :: IO () +rrrr1 = do putStrLn 1 -- this should error as "In the stmt of a do block" + putStrLn "r2" + putStrLn "r3" + +rrrr2 :: IO () +rrrr2 = do putStrLn "r1" + putStrLn 2 -- this should error as "In the stmt of a do block" + putStrLn "r3" + + +rrrr3 :: IO () +rrrr3 = do putStrLn "r1" + putStrLn "r2" + putStrLn 3 -- this should error as "In the stmt of a do block" ===================================== testsuite/tests/typecheck/should_fail/DoExpansion1.stderr ===================================== @@ -0,0 +1,48 @@ + +DoExpansion1.hs:7:19: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • No instance for ‘Num String’ arising from the literal ‘1’ + • In the first argument of ‘putStrLn’, namely ‘1’ + In the first argument of ‘(>>)’, namely ‘putStrLn 1’ + In the first argument of ‘(>>)’, namely + ‘putStrLn 1 >> putStrLn "q2"’ + +DoExpansion1.hs:11:37: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • No instance for ‘Num String’ arising from the literal ‘2’ + • In the first argument of ‘putStrLn’, namely ‘2’ + In the second argument of ‘(>>)’, namely ‘putStrLn 2’ + In the first argument of ‘(>>)’, namely + ‘(putStrLn "q1" >> putStrLn 2)’ + +DoExpansion1.hs:15:54: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • No instance for ‘Num String’ arising from the literal ‘3’ + • In the first argument of ‘putStrLn’, namely ‘3’ + In the second argument of ‘(>>)’, namely ‘putStrLn 3’ + In the second argument of ‘(>>)’, namely + ‘(putStrLn "q2" >> putStrLn 3)’ + +DoExpansion1.hs:19:21: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • No instance for ‘Num String’ arising from the literal ‘1’ + • In the first argument of ‘putStrLn’, namely ‘1’ + In a stmt of a 'do' block: putStrLn 1 + In the expression: + do putStrLn 1 + putStrLn "r2" + putStrLn "r3" + +DoExpansion1.hs:25:21: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • No instance for ‘Num String’ arising from the literal ‘2’ + • In the first argument of ‘putStrLn’, namely ‘2’ + In a stmt of a 'do' block: putStrLn 2 + In the expression: + do putStrLn "r1" + putStrLn 2 + putStrLn "r3" + +DoExpansion1.hs:32:21: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] + • No instance for ‘Num String’ arising from the literal ‘3’ + • In the first argument of ‘putStrLn’, namely ‘3’ + In a stmt of a 'do' block: putStrLn 3 + In the expression: + do putStrLn "r1" + putStrLn "r2" + putStrLn 3 ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.hs ===================================== @@ -0,0 +1,28 @@ +module DoExpansion2 where + + +-- make sure all the (>>=) expansion works okay + +getVal :: Int -> IO String +getVal _ = return "x" + +ffff1, ffff2, ffff3, ffff4, ffff5 :: IO Int + + +ffff1 = do x <- getChar + return (x + 1) -- should error here + +ffff2 = do x <- (getVal 3) -- should error here + return x + +ffff3 = do x <- getChar + y <- getChar + return (x + y) -- should error here + +ffff4 = do Just x <- getChar -- should error here + return x + + +ffff5 = do x <- getChar -- should error here + Just x <- getChar + return x ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.stderr ===================================== @@ -0,0 +1,63 @@ + +DoExpansion2.hs:13:20: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the first argument of ‘(+)’, namely ‘x’ + In the first argument of ‘return’, namely ‘(x + 1)’ + In a stmt of a 'do' block: return (x + 1) + | +13 | return (x + 1) -- should error here + | ^ + +DoExpansion2.hs:16:19: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match type ‘[Char]’ with ‘Int’ + Expected: Int + Actual: String + • In the first argument of ‘return’, namely ‘x’ + In a stmt of a 'do' block: return x + In the expression: + do x <- (getVal 3) + return x + | +16 | return x + | ^ + +DoExpansion2.hs:20:20: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the first argument of ‘(+)’, namely ‘x’ + In the first argument of ‘return’, namely ‘(x + y)’ + In a stmt of a 'do' block: return (x + y) + | +20 | return (x + y) -- should error here + | ^ + +DoExpansion2.hs:20:24: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the second argument of ‘(+)’, namely ‘y’ + In the first argument of ‘return’, namely ‘(x + y)’ + In a stmt of a 'do' block: return (x + y) + | +20 | return (x + y) -- should error here + | ^ + +DoExpansion2.hs:22:12: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ + • In the pattern: Just x + In a stmt of a 'do' block: Just x <- getChar + In the expression: + do Just x <- getChar + return x + | +22 | ffff4 = do Just x <- getChar -- should error here + | ^^^^^^ + +DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ + • In the pattern: Just x + In a stmt of a 'do' block: Just x <- getChar + In the expression: + do x <- getChar + Just x <- getChar + return x + | +27 | Just x <- getChar + | ^^^^^^ ===================================== testsuite/tests/typecheck/should_fail/DoExpansion3.hs ===================================== @@ -0,0 +1,33 @@ +module DoExpansion2 where + + +-- make sure all the (>>=) expansion works okay + +getVal :: Int -> IO String +getVal _ = return "x" + +gggg1, gggg2, gggg3, gggg4, gggg5 :: IO Int + + +gggg1 = do let x = 1 + let y = 2 + putStrLn x -- should error here + return (x + 1) + +gggg2 = do let x = 1 + y = getChar 2 -- should error here + z = 3 + return x + +gggg3 = do x <- getChar + let y = 2 + z <- getChar + return (x + y) -- should error here + +gggg4 = do Just x <- getChar -- should error here + return x + + +gggg5 = do x <- getChar -- should error here + Just x <- getChar + return x ===================================== testsuite/tests/typecheck/should_fail/DoExpansion3.stderr ===================================== @@ -0,0 +1,55 @@ + +DoExpansion3.hs:15:20: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match type ‘[Char]’ with ‘Int’ + Expected: Int + Actual: String + • In the first argument of ‘(+)’, namely ‘x’ + In the first argument of ‘return’, namely ‘(x + 1)’ + In a stmt of a 'do' block: return (x + 1) + | +15 | return (x + 1) + | ^ + +DoExpansion3.hs:18:20: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type: t0 -> t + with actual type: IO Char + • The function ‘getChar’ is applied to one value argument, + but its type ‘IO Char’ has none + In the expression: getChar 2 + In an equation for ‘y’: y = getChar 2 + • Relevant bindings include y :: t (bound at DoExpansion3.hs:18:16) + | +18 | y = getChar 2 -- should error here + | ^^^^^^^^^ + +DoExpansion3.hs:25:20: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the first argument of ‘(+)’, namely ‘x’ + In the first argument of ‘return’, namely ‘(x + y)’ + In a stmt of a 'do' block: return (x + y) + | +25 | return (x + y) -- should error here + | ^ + +DoExpansion3.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ + • In the pattern: Just x + In a stmt of a 'do' block: Just x <- getChar + In the expression: + do Just x <- getChar + return x + | +27 | gggg4 = do Just x <- getChar -- should error here + | ^^^^^^ + +DoExpansion3.hs:32:12: warning: [GHC-83865] [-Wdeferred-type-errors] + • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ + • In the pattern: Just x + In a stmt of a 'do' block: Just x <- getChar + In the expression: + do x <- getChar + Just x <- getChar + return x + | +32 | Just x <- getChar + | ^^^^^^ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -699,3 +699,8 @@ test('VisFlag5', normal, compile_fail, ['']) test('T22684', normal, compile_fail, ['']) test('T23514a', normal, compile_fail, ['']) test('T22478c', normal, compile_fail, ['']) + +# all the various do expansion fail messages +test('DoExpansion1', normal, compile, ['-fdefer-type-errors']) +test('DoExpansion2', normal, compile, ['-fdefer-type-errors']) +test('DoExpansion3', normal, compile, ['-fdefer-type-errors']) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86a237307a8801d46651f1c72363ff92a364b772...4230daa7126321aaa700a38b0555a379d4b022cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86a237307a8801d46651f1c72363ff92a364b772...4230daa7126321aaa700a38b0555a379d4b022cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 02:04:33 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 20 Jul 2023 22:04:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23702 Message-ID: <64b9e7b15d0d5_19cb1ab782c1340e@gitlab.mail> Finley McIlwaine pushed new branch wip/t23702 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23702 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 02:05:33 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 20 Jul 2023 22:05:33 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] VDQ-related Notes Message-ID: <64b9e7ed33fa9_19cb1ab780413422b@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 0bf33f76 by Vladislav Zavialov at 2023-07-21T04:05:09+02:00 VDQ-related Notes - - - - - 4 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -572,12 +572,10 @@ data DataCon {- Note [TyVarBinders in DataCons] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -For the TyVarBinders in a DataCon and PatSyn: - - * Each argument flag is Inferred or Specified. - None are Required. (A DataCon is a term-level function; see - Note [No Required PiTyBinder in terms] in GHC.Core.TyCo.Rep.) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For the TyVarBinders in a DataCon and PatSyn, +each argument flag is either Inferred or Specified, never Required. +Lifting this restriction is tracked at #18389 (DataCon) and #23704 (PatSyn). Why do we need the TyVarBinders, rather than just the TyVars? So that we can construct the right type for the DataCon with its foralls ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -599,10 +599,11 @@ So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders: - but changing Anon/Required to Specified The last part about Required->Specified comes from this: - data T k (a:k) b = MkT (a b) -Here k is Required in T's kind, but we don't have Required binders in -the PiTyBinders for a term (see Note [No Required PiTyBinder in terms] -in GHC.Core.TyCo.Rep), so we change it to Specified when making MkT's PiTyBinders + data T k (a :: k) b = MkT (a b) +Here k is Required in T's kind, but we didn't have Required binders in +types of terms before the advent of the new, experimental RequiredTypeArguments +extension. So we historically changed Required to Specified when making MkT's PiTyBinders +and now continue to do so to avoid a breaking change. -} ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -791,6 +791,7 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside * * ********************************************************************* -} +-- See Note [Visible type application and abstraction] tcVTA :: ConcreteTyVars -- ^ Type variables that must be instantiated to concrete types. -- @@ -804,15 +805,13 @@ tcVTA :: ConcreteTyVars tcVTA conc_tvs fun_ty hs_ty | Just (tvb, inner_ty) <- tcSplitForAllTyVarBinder_maybe fun_ty , binderFlag tvb == Specified - -- It really can't be Inferred, because we've just - -- instantiated those. But, oddly, it might just be Required. - -- See Note [Required quantifiers in the type of a term] = do { tc_inst_forall_arg conc_tvs (tvb, inner_ty) hs_ty } | otherwise = do { (_, fun_ty) <- liftZonkM $ zonkTidyTcType emptyTidyEnv fun_ty ; failWith $ TcRnInvalidTypeApplication fun_ty hs_ty } +-- See Note [Visible type application and abstraction] tcVDQ :: ConcreteTyVars -- See Note [Representation-polymorphism checking built-ins] -> (ForAllTyBinder, TcType) -- Function type -> LHsExpr GhcRn -- Argument type @@ -875,27 +874,235 @@ tc_inst_forall_arg conc_tvs (tvb, inner_ty) hs_ty , text "insted_ty" <+> debugPprType insted_ty ]) ; return (ty_arg, insted_ty) } -{- Note [Required quantifiers in the type of a term] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#15859) - - data A k :: k -> Type -- A :: forall k -> k -> Type - type KindOf (a :: k) = k -- KindOf :: forall k. k -> Type - a = (undefined :: KindOf A) @Int - -With ImpredicativeTypes (thin ice, I know), we instantiate -KindOf at type (forall k -> k -> Type), so - KindOf A = forall k -> k -> Type -whose first argument is Required - -We want to reject this type application to Int, but in earlier -GHCs we had an ASSERT that Required could not occur here. - -The ice is thin; c.f. Note [No Required PiTyBinder in terms] -in GHC.Core.TyCo.Rep. +{- Note [Visible type application and abstraction] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +GHC supports the types + forall {a}. a -> t -- ForAllTyFlag is Inferred + forall a. a -> t -- ForAllTyFlag is Specified + forall a -> a -> t -- ForAllTyFlag is Required + +The design of type abstraction and type application for those types has gradually +evolved over time, and is based on the following papers and proposals: + - "Visible Type Application" + https://richarde.dev/papers/2016/type-app/visible-type-app.pdf + - "Type Variables in Patterns" + https://richarde.dev/papers/2018/pat-tyvars/pat-tyvars.pdf + - "Modern Scoped Type Variables" + https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0448-type-variable-scoping.rst + - "Visible forall in types of terms" + https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst + +The proposals have not been fully implemented at the time of writing this Note, +so we offer an overview of the design mixed with commentary on the implementation status. + +Now consider functions + fi :: forall {a}. a -> t -- Inferred: type argument cannot be supplied + fs :: forall a. a -> t -- Specified: type argument may be supplied + fr :: forall a -> a -> t -- Required: type argument must be supplied + +At a call site we may have calls looking like this + fi True -- Inferred: no visible type argument + fs True -- Specified: type argument omitted + fs @Bool True -- Specified: type argument supplied + fr (type Bool) True -- Required: type argument is compulsory, `type` qualifier used + fr Bool True -- Required: type argument is compulsory, `type` qualifier omitted (NB: not implemented) + +At definition sites we may have type /patterns/ to abstract over type variables + fi x = rhs -- Inferred: no type pattern + fs x = rhs -- Specified: type pattern omitted + fs @a (x :: a) = rhs -- Specified: type pattern supplied (NB: not implemented) + fr (type a) (x :: a) = rhs -- Required: type pattern is compulsory, `type` qualifier used + fr a (x :: a) = rhs -- Required: type pattern is compulsory, `type` qualifier omitted (NB: not implemented) + +Type patterns in lambdas work the same way as they do in a function LHS + fs = \ x -> rhs -- Specified: type pattern omitted + fs = \ @a (x :: a) -> rhs -- Specified: type pattern supplied (NB: not implemented) + fr = \ (type a) (x :: a) -> rhs -- Required: type pattern is compulsory, `type` qualifier used + fr = \ a (x :: a) -> rhs -- Required: type pattern is compulsory, `type` qualifier omitted (NB: not implemented) + +Type patterns may also occur in a constructor pattern. Consider the following data declaration + data T where + MkTI :: forall {a}. Show a => a -> T -- Inferred + MkTS :: forall a. Show a => a -> T -- Specified + MkTR :: forall a -> Show a => a -> T -- Required (NB: not implemented) + +Matching on its constructors may look like this + f (MkTI x) = rhs -- Inferred: no type pattern + f (MkTS x) = rhs -- Specified: type pattern omitted + f (MkTS @a (x :: a)) = rhs -- Specified: type pattern supplied + f (MkTR (type a) (x :: a)) = rhs -- Required: type pattern is compulsory, `type` qualifier used (NB: not implemented) + f (MkTR a (x :: a)) = rhs -- Required: type pattern is compulsory, `type` qualifier omitted (NB: not implemented) + +The moving parts are as follows: + (abbreviations used: "c.o." = "constructor of") + +Syntax of types +--------------- +* The types are all initially represented with HsForAllTy (c.o. HsType). + At this stage, we have + forall {a}. t -- HsForAllInvis (c.o. HsForAllTelescope) and InferredSpec (c.o. Specificity) + forall a. t -- HsForAllInvis (c.o. HsForAllTelescope) and SpecifiedSpec (c.o. Specificity) + forall a -> t -- HsForAllVis (c.o. HsForAllTelescope) + +* By the time we get to checking applications/abstractions, + the types have been desugared into ForAllTy (c.o. Type). + At this stage, we have: + forall {a}. t -- ForAllTy (c.o. Type) and Inferred (c.o. ForAllTyFlag) + forall a. t -- ForAllTy (c.o. Type) and Specified (c.o. ForAllTyFlag) + forall a -> t -- ForAllTy (c.o. Type) and Required (c.o. ForAllTyFlag) + +Syntax of applications +---------------------- +* Type applications are represented with the following constructors + f True -- HsApp (c.o. HsExpr, plain function application) + f @True -- HsAppType (c.o. HsExpr, function application with `@`) + type True -- HsEmbTy (c.o. HsExpr, embed a type into an expression with `type`) + +* The HsAppType constructor is only used with Specified type variables + f @True -- only valid for f :: forall a. t + +* The HsApp constructor without HsEmbTy is used with ordinary function application + and with Required type variables + f True -- valid for f :: Bool -> t + -- and f :: forall (a :: Bool) -> t (NB. not implemented) + +* The HsApp constructor with an HsEmbTy argument is only used + with Required type variables + f (type True) -- valid for f :: forall (a :: Bool) -> t + + The HsEmbTy node can occur nested inside a larger type argument, + or even multiple times + g (Maybe (type Int)) -- valid for g :: forall (a :: Type) -> t (NB. not implemented) + g (Either (type Int) (type Bool)) -- valid for g :: forall (a :: Type) -> t (NB. not implemented) + + This nesting makes `type` rather different from `@`. + +Syntax of abstractions +---------------------- +* Type abstractions are represented with the following constructors + \ (MkT @a (x :: a)) -> rhs -- ConPat (c.o. Pat) and HsConPatTyArg (c.o. HsConPatTyArg) + \ (type a) (x :: a) -> rhs -- EmbTyPat (c.o. Pat) + \ a (x :: a) -> rhs -- VarPat (c.o. Pat) (NB. not implemented) + \ @a (x :: a) -> rhs -- to be decided (NB. not implemented) + +* The type pattern itself is not necessarily a plain variable. At the very least, + we support kind signatures and wildcards: + \ (type _) -> rhs + \ (type (b :: Bool)) -> rhs + \ (type (_ :: Bool)) -> rhs + But in constructor patterns we also support full-on types + \ (P @(a -> Either b c)) -> rhs + All these forms are represented with HsTP (c.o. HsTyPat). + +Renaming type applications +-------------------------- +rnExpr delegates renaming of type arguments to rnHsWcType if possible: + f @t -- HsAppType, t is renamed with rnHsWcType + f (type t) -- HsApp and HsEmbTy, t is renamed with rnHsWcType + +But what about: + f t -- HsApp, no HsEmbTy (NB. not implemented) +Is `t` a term argument or a type argument? This depends on f's type + f :: A -> B -- t is a term argument + f :: forall (a :: A) -> B -- t is a type argument +But we don't want types to affect name resolution (Lexical Scoping Principle). +So we always rename `t` as a term using a recursive call to rnExpr. +The idea is to convert it to a type argument later. The details are spelled out +in the "Resolved Syntax Tree" and "T2T-Mapping" sections of GHC Proposal #281. + +Renaming type abstractions +-------------------------- +rnPat delegates renaming of type arguments to rnHsTyPat if possible: + f (P @t) = rhs -- ConPat, t is renamed with rnHsTyPat + f (type t) = rhs -- EmbTyPat, t is renamed with rnHsTyPat + +But what about: + f t = rhs -- VarPat +The solution is as before (see previous section), mutatis mutandis. +Rename `t` as a pattern using a recursive call to `rnPat`, convert it +to a type pattern later. One particularly prickly issue is that of +implicit quantification. Consider: + + f :: forall a -> ... + f t = ... -- binding site of `t` + where + g :: t -> t -- use site of `t` or a fresh variable? + g = ... + +Does the signature of `g` refer to `t` bound in `f`, or is it a fresh, +implicitly quantified variable? This is normally controlled by ScopedTypeVariables, +but in this example the renamer can't tell `t` from a term variable. +Only later (in the type checker) will we find out that it stands +for the forall-bound type variable `a`. +So when RequiredTypeArguments is in effect, we change implicit quantification +to take term variables into account. (NB. not implemented) +See Note [Term variable capture and implicit quantification]. + +Typechecking type applications +------------------------------ +Type applications are checked alongside ordinary function applications +in tcInstFun. + +First of all, we assume that the function type is known (i.e. not a metavariable) +and contains a `forall`. Consider: + f :: forall a. a -> a + f x = const x (f @Int 5) +If the type signature is removed, the definition results in an error: + Cannot apply expression of type ‘t1’ + to a visible type argument ‘Int’ + +The same principle applies to required type arguments: + f :: forall a -> a -> a + f (type a) x = const x (f (type Int) 5) +If the type signature is removed, the error is: + Illegal type pattern. + A type pattern must be checked against a visible forall. + +When the type of the function is known and contains a `forall`, +all we need to do is instantiate the forall-bound variable with +the supplied type argument. +This is done by tcVTA (if Specified) and tcVDQ (if Required). + +tcVDQ unwraps the HsEmbTy and uses the type contained within it. +Crucially, in tcVDQ we know that we are expecting a type argument. +This means that we can support + f (Maybe Int) -- HsApp, no HsEmbTy (NB. not implemented) +The type argument (Maybe Int) is represented as an HsExpr, +but tcVDQ can easily convert it to HsType. +This conversion is called the "T2T-Mapping" in GHC Proposal #281. + +Typechecking type abstractions +------------------------------ +Type abstractions are checked alongside ordinary patterns in tcPats. +One of its inputs is a list of ExpPatType that has two constructors + * ExpFunPatTy ... -- the type A of a function A -> B + * ExpForallPatTy ... -- the binder (a::A) of forall (a::A) -> B +so when we are checking + f :: forall a b -> a -> b -> ... + f (type a) (type b) (x :: a) (y :: b) = ... +our expected pattern types are + [ ExpForallPatTy ... -- forall a -> + , ExpForallPatTy ... -- forall b -> + , ExpFunPatTy ... -- a -> + , ExpFunPatTy ... -- b -> + ] + +This allows us to use different code paths for type abstractions +and ordinary patterns: + * tc_pat :: Scaled ExpSigmaTypeFRR -> Checker (Pat GhcRn) (Pat GhcTc) + * tc_forall_pat :: Checker (Pat GhcRn, TcTyVar) (Pat GhcTc) + +tc_forall_pat unwraps the EmbTyPat and uses the type pattern contained +within it. This is another spot where the "T2T-Mapping" can take place. +This would allow us to support + f a (x :: a) = rhs -- no EmbTyPat (NB. not implemented) + +Type patterns in constructor patterns are handled in with tcConTyArg. +Both tc_forall_pat and tcConTyArg delegate most of the work to tcHsTyPat. +-} -Note [VTA for out-of-scope functions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [VTA for out-of-scope functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose 'wurble' is not in scope, and we have (wurble @Int @Bool True 'x') ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -920,8 +920,7 @@ This table summarises the visibility rules: | tvis = Inferred: f :: forall {a}. type Arg not allowed: f f :: forall {co}. type Arg not allowed: f | tvis = Specified: f :: forall a. type Arg optional: f or f @Int -| tvis = Required: T :: forall k -> type Arg required: T * -| This last form is illegal in terms: See Note [No Required PiTyBinder in terms] +| tvis = Required: f :: forall k -> type Arg required: f (type Int) | | Bndr k cvis :: TyConBinder, in the TyConBinders of a TyCon | cvis :: TyConBndrVis @@ -952,22 +951,28 @@ This table summarises the visibility rules: f3 :: forall a. a -> a; f3 x = x So f3 gets the type f3 :: forall a. a -> a, with 'a' Specified +* Required. Function defn, with signature (explicit forall): + f4 :: forall a -> a -> a; f4 (type _) x = x + So f4 gets the type f4 :: forall a -> a -> a, with 'a' Required + This is the experimental RequiredTypeArguments extension, + see GHC Proposal #281 "Visible forall in types of terms" + * Inferred. Function defn, with signature (explicit forall), marked as inferred: - f4 :: forall {a}. a -> a; f4 x = x - So f4 gets the type f4 :: forall {a}. a -> a, with 'a' Inferred + f5 :: forall {a}. a -> a; f5 x = x + So f5 gets the type f5 :: forall {a}. a -> a, with 'a' Inferred It's Inferred because the user marked it as such, even though it does appear - in the user-written signature for f4 + in the user-written signature for f5 * Inferred/Specified. Function signature with inferred kind polymorphism. - f5 :: a b -> Int - So 'f5' gets the type f5 :: forall {k} (a:k->*) (b:k). a b -> Int + f6 :: a b -> Int + So 'f6' gets the type f6 :: forall {k} (a :: k -> Type) (b :: k). a b -> Int Here 'k' is Inferred (it's not mentioned in the type), but 'a' and 'b' are Specified. * Specified. Function signature with explicit kind polymorphism - f6 :: a (b :: k) -> Int + f7 :: a (b :: k) -> Int This time 'k' is Specified, because it is mentioned explicitly, - so we get f6 :: forall (k:*) (a:k->*) (b:k). a b -> Int + so we get f7 :: forall (k :: Type) (a :: k -> Type) (b :: k). a b -> Int * Similarly pattern synonyms: Inferred - from inferred types (e.g. no pattern type signature) @@ -1027,7 +1032,7 @@ See also Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl const :: forall a b. a -> b -> a Inferred: like Specified, but every binder is written in braces: - f :: forall {k} (a:k). S k a -> Int + f :: forall {k} (a :: k). S k a -> Int Required: binders are put between `forall` and `->`: T :: forall k -> * @@ -1039,19 +1044,6 @@ See also Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl * Inferred variables correspond to "generalized" variables from the Visible Type Applications paper (ESOP'16). - -Note [No Required PiTyBinder in terms] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We don't allow Required foralls for term variables, including pattern -synonyms and data constructors. Why? Because then an application -would need a /compulsory/ type argument (possibly without an "@"?), -thus (f Int); and we don't have concrete syntax for that. - -We could change this decision, but Required, Named PiTyBinders are rare -anyway. (Most are Anons.) - -However the type of a term can (just about) have a required quantifier; -see Note [Required quantifiers in the type of a term] in GHC.Tc.Gen.Expr. -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bf33f76357b046cb047cef6a5bbce9f9433550e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bf33f76357b046cb047cef6a5bbce9f9433550e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 02:25:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 22:25:59 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/ghc-9.8-2 Message-ID: <64b9ecb7cac2d_19cb1ab77c81387da@gitlab.mail> Ben Gamari deleted branch wip/ghc-9.8-2 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 02:26:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 20 Jul 2023 22:26:03 -0400 Subject: [Git][ghc/ghc][ghc-9.8] 27 commits: JS: fix JS stack printing (#23565) Message-ID: <64b9ecbb6913b_19cb1ab7804138910@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: fb4ecd83 by Sylvain Henry at 2023-07-20T14:33:08-04:00 JS: fix JS stack printing (#23565) (cherry picked from commit 78b2f3ccb1d7603e11b3f364646240e361512cbc) - - - - - 77117e5f by Dave Barton at 2023-07-20T14:33:15-04:00 Fix some broken links and typos (cherry picked from commit 4457da2a7dba97ab2cd2f64bb338c904bb614244) - - - - - 7cec29d8 by Matthew Pickering at 2023-07-20T14:34:13-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 (cherry picked from commit 9f01d14b5bc1c73828b2b061206c45b84353620e) - - - - - e5215256 by Mario Blažević at 2023-07-20T14:34:45-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals (cherry picked from commit 4af7eac2a00e86c29509c119aacc7511a9c7747d) - - - - - d33581c5 by sheaf at 2023-07-20T14:34:56-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. (cherry picked from commit 2b55cb5f33666a71eaac7968c59e483860112e5c) - - - - - 0c877166 by Matthew Pickering at 2023-07-20T14:35:33-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 (cherry picked from commit 76983a0dca64dfb7e94aea0c4f494921f8513b41) - - - - - 30830523 by Bodigrim at 2023-07-20T14:35:40-04:00 Add since annotations for Data.Foldable1 (cherry picked from commit 054261dd319b505392458da7745e768847015887) - - - - - fd3fcfe5 by sheaf at 2023-07-20T14:35:50-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 (cherry picked from commit 61b1932eb7d529263330dcab404909997610dd43) - - - - - 90846d43 by Sylvain Henry at 2023-07-20T14:35:56-04:00 JS: support -this-unit-id for programs in the linker (#23613) (cherry picked from commit 550af50559931b7681fe24fddafd6e3467de077c) - - - - - b9c2aa3f by sheaf at 2023-07-20T14:36:44-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 (cherry picked from commit 630e302617a4a3e00d86d0650cb86fa9e6913e44) - - - - - e5ed9c58 by Matthew Pickering at 2023-07-20T14:54:03-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 (cherry picked from commit c39f279b7a23e7c3259dff9ad660b7f417d4fdcd) - - - - - ba2f9f34 by Krzysztof Gogolewski at 2023-07-20T14:54:23-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. (cherry picked from commit bf9b9de0685e23c191722dfdb78d28b44f1cba05) - - - - - e0fbb1d4 by Vladislav Zavialov at 2023-07-20T14:54:29-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. (cherry picked from commit 7f13acbf187d7a0810f42705b95d593b1e2e5611) - - - - - 27df38c2 by Sylvain Henry at 2023-07-20T15:04:52-04:00 JS: better implementation for plusWord64 (#23597) (cherry picked from commit b55a8ea70424032c19ef85ef95c5eee8b50d55c3) - - - - - 8f77107f by Krzysztof Gogolewski at 2023-07-20T15:06:18-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. (cherry picked from commit 787bae96f77562e603b6e9ebb86139cc5d120b8d) - - - - - 6e044db1 by Ryan Scott at 2023-07-20T15:24:43-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. (cherry picked from commit c335fb7c44a8447b3e73e7f18d9d0dcb18cea8dd) - - - - - 3d913cbe by sheaf at 2023-07-20T15:29:21-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. (cherry picked from commit 6143838a5985ee3af1e8c2af4166d35bb4de12d8) - - - - - 45ab7560 by sheaf at 2023-07-20T15:29:24-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. (cherry picked from commit 6fd8f566c691b936b0b65e21700b224312611f4d) - - - - - c5533204 by sheaf at 2023-07-20T15:29:25-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- (cherry picked from commit 7f0a86edeeda674f27c80e81be592d325447a897) - - - - - ff06b820 by sheaf at 2023-07-20T15:30:07-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 (cherry picked from commit c7bbad9a0aab2d7b4336ae411e13d9450d8483a7) - - - - - 2734d370 by sheaf at 2023-07-20T15:34:20-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. (cherry picked from commit 1af2e7735283251c686bdb1154afab6df5e45053) - - - - - 84e6df59 by sheaf at 2023-07-20T15:34:20-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 (cherry picked from commit 3bd4d5b5482fd44914f22492877b3f3ca27299e0) - - - - - fa084def by sheaf at 2023-07-20T15:34:33-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 (cherry picked from commit 22565506515313c928d13a43b2946e0106110353) - - - - - f9f4714e by sheaf at 2023-07-20T15:34:34-04:00 exactprint: silence incomplete record update warnings (cherry picked from commit 860f6269bc016e11400b7e3176a5ea6dfe291a46) - - - - - 071dd8ca by sheaf at 2023-07-20T15:35:45-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings (cherry picked from commit df706de378e3415a3972ddd14863f54fc7162dc7) - - - - - c7688443 by sheaf at 2023-07-20T15:35:55-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 (cherry picked from commit 1d05971e24f6cb1120789d1e1ab4f086eebd504a) - - - - - ae88ed9a by sheaf at 2023-07-20T15:35:56-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. (cherry picked from commit bea0e323c09e9e4b841a37aacd6b67e87a85e7cb) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b95c0e822c39bec2153289d6e17ab24d024df0d...ae88ed9a73d52ab103df491ef2e43c483f1d548d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8b95c0e822c39bec2153289d6e17ab24d024df0d...ae88ed9a73d52ab103df491ef2e43c483f1d548d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 05:10:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 01:10:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: EPA: Simplify GHC/Parser.y sL1 Message-ID: <64ba13549f335_19cb1ab7868167941@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 5e02268d by Ben Gamari at 2023-07-21T01:10:33-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - fc4da014 by Ben Gamari at 2023-07-21T01:10:33-04:00 nativeGen: Set explicit section types on all platforms - - - - - a6757d9a by Finley McIlwaine at 2023-07-21T01:10:33-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 11 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Parser.y - + testsuite/tests/parser/should_compile/T23315/Makefile - + testsuite/tests/parser/should_compile/T23315/Setup.hs - + testsuite/tests/parser/should_compile/T23315/T23315.cabal - + testsuite/tests/parser/should_compile/T23315/T23315.hsig - + testsuite/tests/parser/should_compile/T23315/T23315.stderr - + testsuite/tests/parser/should_compile/T23315/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -511,7 +511,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release+no_split_sections + - job: release-x86_64-windows-release optional: true tags: @@ -535,7 +535,7 @@ doc-tarball: || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \ || true mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \ - || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \ + || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \ || true if [ ! -f "$LINUX_BINDIST" ]; then echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -921,8 +921,8 @@ job_groups = -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) - , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) - , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) + , fastCI (standardBuildsWithConfig Amd64 Windows vanilla) + , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , fastCI (standardBuilds AArch64 Darwin) ===================================== .gitlab/jobs.yaml ===================================== @@ -3577,7 +3577,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-windows-int_native-release+no_split_sections": { + "release-x86_64-windows-int_native-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3587,7 +3587,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-int_native-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3626,8 +3626,8 @@ ], "variables": { "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3636,11 +3636,11 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", + "TEST_ENV": "x86_64-windows-int_native-release", "XZ_OPT": "-9" } }, - "release-x86_64-windows-release+no_split_sections": { + "release-x86_64-windows-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3650,7 +3650,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3689,8 +3689,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3699,7 +3699,7 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-release+no_split_sections", + "TEST_ENV": "x86_64-windows-release", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix = OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of + Text + | OSMinGW32 <- platformOS platform + -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty ===================================== compiler/GHC/Parser.y ===================================== @@ -751,7 +751,7 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } -- Exported parsers %name parseModuleNoHaddock module -%name parseSignature signature +%name parseSignatureNoHaddock signature %name parseImport importdecl %name parseStatement e_stmt %name parseDeclaration topdecl @@ -846,8 +846,8 @@ rns :: { OrdList LRenaming } | rn { unitOL $1 } rn :: { LRenaming } - : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } - | modid { sL1 (reLoc $1) $ Renaming (reLoc $1) Nothing } + : modid 'as' modid { sLL $1 $> $ Renaming (reLoc $1) (Just (reLoc $3)) } + | modid { sL1 $1 $ Renaming (reLoc $1) Nothing } unitbody :: { OrdList (LHsUnitDecl PackageName) } : '{' unitdecls '}' { $2 } @@ -1073,11 +1073,11 @@ qcnames1 :: { ([AddEpAnn], [LocatedA ImpExpQcSpec]) } -- A reversed list -- Variable, data constructor or wildcard -- or tagged type constructor qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } - : qcname_ext { sL1A $1 ([],$1) } - | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } + : qcname_ext { sL1 $1 ([],$1) } + | '..' { sL1 $1 ([mj AnnDotdot $1], sL1a $1 ImpExpQcWildcard) } qcname_ext :: { LocatedA ImpExpQcSpec } - : qcname { reLocA $ sL1N $1 (ImpExpQcName $1) } + : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} @@ -1231,7 +1231,7 @@ ops :: { Located (OrdList (LocatedN RdrName)) } SnocOL hs t -> do t' <- addTrailingCommaN t (gl $2) return (sLL $1 $> (snocOL hs t' `appOL` unitOL $3)) } - | op { sL1N $1 (unitOL $1) } + | op { sL1 $1 (unitOL $1) } ----------------------------------------------------------------------------- -- Top-Level Declarations @@ -1265,12 +1265,12 @@ topdecl_cs : topdecl {% commentsPA $1 } ----------------------------------------------------------------------------- topdecl :: { LHsDecl GhcPs } - : cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) } - | standalone_kind_sig { sL1 $1 (KindSigD noExtField (unLoc $1)) } - | inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) } - | stand_alone_deriving { sL1 $1 (DerivD noExtField (unLoc $1)) } - | role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) } + : cl_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | ty_decl { sL1a $1 (TyClD noExtField (unLoc $1)) } + | standalone_kind_sig { sL1a $1 (KindSigD noExtField (unLoc $1)) } + | inst_decl { sL1a $1 (InstD noExtField (unLoc $1)) } + | stand_alone_deriving { sL1a $1 (DerivD noExtField (unLoc $1)) } + | role_annot { sL1a $1 (RoleAnnotD noExtField (unLoc $1)) } | 'default' '(' comma_types0 ')' {% acsA (\cs -> sLL $1 $> (DefD noExtField (DefaultDecl (EpAnn (glR $1) [mj AnnDefault $1,mop $2,mcp $4] cs) $3))) } | 'foreign' fdecl {% acsA (\cs -> sLL $1 $> ((snd $ unLoc $2) (EpAnn (glR $1) (mj AnnForeign $1:(fst $ unLoc $2)) cs))) } @@ -1358,7 +1358,7 @@ sks_vars :: { Located [LocatedN RdrName] } -- Returned in reverse order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | oqtycon { sL1N $1 [$1] } + | oqtycon { sL1 $1 [$1] } inst_decl :: { LInstDecl GhcPs } : 'instance' overlap_pragma inst_type where_inst @@ -1438,7 +1438,7 @@ injectivity_cond :: { LInjectivityAnn GhcPs } inj_varids :: { Located [LocatedN RdrName] } : inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) } - | tyvarid { sL1N $1 [$1] } + | tyvarid { sL1 $1 [$1] } -- Closed type families @@ -1588,7 +1588,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) } | '::' kind { sLL $1 $> ( [mu AnnDcolon $1] - , (sL1a (reLoc $>) (KindSig noExtField $2), Nothing)) } + , (sL1a $> (KindSig noExtField $2), Nothing)) } | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] @@ -1603,7 +1603,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs -- Rather a lot of inlining here, else we get reduce/reduce errors tycl_hdr :: { Located (Maybe (LHsContext GhcPs), LHsType GhcPs) } : context '=>' type {% acs (\cs -> (sLL $1 $> (Just (addTrailingDarrowC $1 $2 cs), $3))) } - | type { sL1A $1 (Nothing, $1) } + | type { sL1 $1 (Nothing, $1) } datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs GhcPs, LHsType GhcPs) } : 'forall' tv_bndrs '.' context '=>' type {% hintExplicitForall $1 @@ -1620,7 +1620,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4)) } } | context '=>' type {% acs (\cs -> (sLL $1 $>(Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) } - | type { sL1A $1 (Nothing, mkHsOuterImplicit, $1) } + | type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) } capi_ctype :: { Maybe (LocatedP CType) } @@ -1755,7 +1755,7 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl_cls { sL1A $1 ([], unitOL $1) } + | decl_cls { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist_cls @@ -1781,8 +1781,8 @@ where_cls :: { Located ([AddEpAnn] -- Declarations in instance bodies -- decl_inst :: { Located (OrdList (LHsDecl GhcPs)) } -decl_inst : at_decl_inst { sL1A $1 (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) } - | decl { sL1A $1 (unitOL $1) } +decl_inst : at_decl_inst { sL1 $1 (unitOL (sL1a $1 (InstD noExtField (unLoc $1)))) } + | decl { sL1 $1 (unitOL $1) } decls_inst :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed : decls_inst ';' decl_inst {% if isNilOL (snd $ unLoc $1) @@ -1842,7 +1842,7 @@ decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) } t' <- addTrailingSemiA t (gl $2) return (sLL $1 $> (fst $ unLoc $1 , snocOL hs t')) } - | decl { sL1A $1 ([], unitOL $1) } + | decl { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) } @@ -1957,7 +1957,7 @@ rule_vars :: { [LRuleTyTmVar] } | {- empty -} { [] } rule_var :: { LRuleTyTmVar } - : varid { sL1l $1 (RuleTyTmVar noAnn $1 Nothing) } + : varid { sL1a $1 (RuleTyTmVar noAnn $1 Nothing) } | '(' varid '::' ctype ')' {% acsA (\cs -> sLL $1 $> (RuleTyTmVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3,mcp $5] cs) $2 (Just $4))) } {- Note [Parsing explicit foralls in Rules] @@ -2143,7 +2143,7 @@ sig_vars :: { Located [LocatedN RdrName] } -- Returned in reversed order (h:t) -> do h' <- addTrailingCommaN h (gl $2) return (sLL $1 $> ($3 : h' : t)) } - | var { sL1N $1 [$1] } + | var { sL1 $1 [$1] } sigtypes1 :: { OrdList (LHsSigType GhcPs) } : sigtype { unitOL $1 } @@ -2266,11 +2266,11 @@ tyop :: { (LocatedN RdrName, PromotionFlag) } ; return (op, IsPromoted) } } atype :: { LHsType GhcPs } - : ntgtycon {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples + : ntgtycon {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- Not including unit tuples -- See Note [%shift: atype -> tyvar] - | tyvar %shift {% acsa (\cs -> sL1a (reLocN $1) (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) + | tyvar %shift {% acsa (\cs -> sL1a $1 (HsTyVar (EpAnn (glNR $1) [] cs) NotPromoted $1)) } -- (See Note [Unit tuples]) | '*' {% do { warnStarIsType (getLoc $1) - ; return $ reLocA $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } } + ; return $ sL1a $1 (HsStarTy noExtField (isUnicode $1)) } } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer | PREFIX_TILDE atype {% acsA (\cs -> sLL $1 $> (mkBangTy (EpAnn (glR $1) [mj AnnTilde $1] cs) SrcLazy $2)) } @@ -2354,7 +2354,7 @@ tv_bndr :: { LHsTyVarBndr Specificity GhcPs } | '{' tyvar '::' kind '}' {% acsA (\cs -> sLL $1 $> (KindedTyVar (EpAnn (glR $1) [moc $1,mu AnnDcolon $3 ,mcc $5] cs) InferredSpec $2 $4)) } tv_bndr_no_braces :: { LHsTyVarBndr Specificity GhcPs } - : tyvar {% acsA (\cs -> (sL1 (reLocN $1) (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } + : tyvar {% acsA (\cs -> (sL1 $1 (UserTyVar (EpAnn (glNR $1) [] cs) SpecifiedSpec $1))) } | '(' tyvar '::' kind ')' {% acsA (\cs -> (sLL $1 $> (KindedTyVar (EpAnn (glR $1) [mop $1,mu AnnDcolon $3 ,mcp $5] cs) SpecifiedSpec $2 $4))) } fds :: { Located ([AddEpAnn],[LHsFunDep GhcPs]) } @@ -2367,7 +2367,7 @@ fds1 :: { Located [LHsFunDep GhcPs] } do { let (h:t) = unLoc $1 -- Safe from fds1 rules ; h' <- addTrailingCommaA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | fd { sL1A $1 [$1] } + | fd { sL1 $1 [$1] } fd :: { LHsFunDep GhcPs } : varids0 '->' varids0 {% acsA (\cs -> L (comb3 $1 $2 $3) @@ -2465,7 +2465,7 @@ constrs1 :: { Located [LConDecl GhcPs] } {% do { let (h:t) = unLoc $1 ; h' <- addTrailingVbarA h (gl $2) ; return (sLL $1 $> ($3 : h' : t)) }} - | constr { sL1A $1 [$1] } + | constr { sL1 $1 [$1] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff @@ -2519,7 +2519,7 @@ maybe_derivings :: { Located (HsDeriving GhcPs) } -- A list of one or more deriving clauses at the end of a datatype derivings :: { Located (HsDeriving GhcPs) } : derivings deriving { sLL $1 $> ($2 : unLoc $1) } -- AZ: order? - | deriving { sL1 (reLoc $>) [$1] } + | deriving { sL1 $> [$1] } -- The outer Located is just to allow the caller to -- know the rightmost extremity of the 'deriving' clause @@ -2537,9 +2537,9 @@ deriving :: { LHsDerivingClause GhcPs } in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glR $1) [mj AnnDeriving $1] cs) (Just $3) $2) } deriv_clause_types :: { LDerivClauseTys GhcPs } - : qtycon { let { tc = sL1 (reLocL $1) $ mkHsImplicitSigType $ - sL1 (reLocL $1) $ HsTyVar noAnn NotPromoted $1 } in - sL1 (reLocC $1) (DctSingle noExtField tc) } + : qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $ + sL1a $1 $ HsTyVar noAnn NotPromoted $1 } in + sL1a $1 (DctSingle noExtField tc) } | '(' ')' {% amsrc (sLL $1 $> (DctMulti noExtField [])) (AnnContext Nothing [glAA $1] [glAA $2]) } | '(' deriv_types ')' {% amsrc (sLL $1 $> (DctMulti noExtField $2)) @@ -2604,7 +2604,7 @@ rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) } gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] } : gdrhs gdrh { sLL $1 $> ($2 : unLoc $1) } - | gdrh { sL1 (reLoc $1) [$1] } + | gdrh { sL1 $1 [$1] } gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) } : '|' guardquals '=' exp {% runPV (unECP $4) >>= \ $4 -> @@ -2639,7 +2639,7 @@ sigdecl :: { LHsDecl GhcPs } (Fixity fixText fixPrec (unLoc $1))))) }} - | pattern_synonym_sig { sL1 $1 . SigD noExtField . unLoc $ $1 } + | pattern_synonym_sig { sL1a $1 . SigD noExtField . unLoc $ $1 } | '{-# COMPLETE' qcon_list opt_tyconsig '#-}' {% let (dcolon, tc) = $3 @@ -3236,7 +3236,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau return (sLL $1 $> ($3 : (h':t))) } | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } -- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) } -- | '{|' pquals '|}' { sL1 $1 [$2] } @@ -3283,7 +3283,7 @@ guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } h' <- addTrailingCommaA h (gl $2) return (sLL $1 $> ($3 : (h':t))) } | qual {% runPV $1 >>= \ $1 -> - return $ sL1A $1 [$1] } + return $ sL1 $1 [$1] } ----------------------------------------------------------------------------- -- Case alternatives @@ -3321,7 +3321,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (fst $ unLoc $1, h' : t)) } - | alt(PATS) { $1 >>= \ $1 -> return $ sL1 (reLoc $1) ([],[$1]) } + | alt(PATS) { $1 >>= \ $1 -> return $ sL1 $1 ([],[$1]) } alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) } : PATS alt_rhs { $2 >>= \ $2 -> @@ -3346,7 +3346,7 @@ gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } - | gdpat { $1 >>= \gdpat -> return $ sL1A gdpat [gdpat] } + | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to -- generate the open brace in addition to the vertical bar in the lexer, and @@ -3418,7 +3418,7 @@ stmts :: { forall b. DisambECP b => PV (Located (OrdList AddEpAnn,[LStmt GhcPs ( { h' <- addTrailingSemiA h (gl $2) ; return $ sL1 $1 (fst $ unLoc $1,h':t) }} | stmt { $1 >>= \ $1 -> - return $ sL1A $1 (nilOL,[$1]) } + return $ sL1 $1 (nilOL,[$1]) } | {- empty -} { return $ noLoc (nilOL,[]) } @@ -3444,7 +3444,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) } acsA (\cs -> sLL $1 $> $ mkPsBindStmt (EpAnn (glAR $1) [mu AnnLarrow $2] cs) $1 $3) } | exp { unECP $1 >>= \ $1 -> - return $ sL1 $1 $ mkBodyStmt $1 } + return $ sL1a $1 $ mkBodyStmt $1 } | 'let' binds { acsA (\cs -> (sLL $1 $> $ mkLetStmt (EpAnn (glR $1) [mj AnnLet $1] cs) (unLoc $2))) } @@ -3467,13 +3467,13 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1l $1 $ mkFieldOcc $1) $3 False) } + fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glNR $1) [mj AnnEqual $2] cs) (sL1a $1 $ mkFieldOcc $1) $3 False) } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg -- f (R { x = show -> s }) = ... | qvar { placeHolderPunRhs >>= \rhs -> - fmap Left $ acsa (\cs -> sL1a (reLocN $1) $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1l $1 $ mkFieldOcc $1) rhs True) } + fmap Left $ acsa (\cs -> sL1a $1 $ HsFieldBind (EpAnn (glNR $1) [] cs) (sL1a $1 $ mkFieldOcc $1) rhs True) } -- In the punning case, use a place-holder -- The renamer fills in the final value @@ -3481,7 +3481,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3497,7 +3497,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- AZ: need to pull out the let block into a helper | field TIGHT_INFIX_PROJ fieldToUpdate { do - let top = sL1 (la2la $1) $ DotFieldOcc noAnn $1 + let top = sL1a $1 $ DotFieldOcc noAnn $1 ((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t @@ -3514,7 +3514,7 @@ fieldToUpdate : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> - return (sL1 (reLoc $1) [sL1a (reLoc $1) (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } + return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } ----------------------------------------------------------------------------- -- Implicit Parameter Bindings @@ -3530,7 +3530,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed (h:t) -> do h' <- addTrailingSemiA h (gl $2) return (sLL $1 $> (h':t)) } - | dbind { let this = $1 in this `seq` (sL1 (reLoc $1) [this]) } + | dbind { let this = $1 in this `seq` (sL1 $1 [this]) } -- | {- empty -} { [] } dbind :: { LIPBind GhcPs } @@ -3572,10 +3572,10 @@ name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } name_boolformula_atom :: { LBooleanFormula (LocatedN RdrName) } : '(' name_boolformula ')' {% amsrl (sLL $1 $> (Parens $2)) (AnnList Nothing (Just (mop $1)) (Just (mcp $3)) [] []) } - | name_var { reLocA $ sL1N $1 (Var $1) } + | name_var { sL1a $1 (Var $1) } namelist :: { Located [LocatedN RdrName] } -namelist : name_var { sL1N $1 [$1] } +namelist : name_var { sL1 $1 [$1] } | name_var ',' namelist {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -3608,11 +3608,11 @@ con :: { LocatedN RdrName } | sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) } con_list :: { Located (NonEmpty (LocatedN RdrName)) } -con_list : con { sL1N $1 (pure $1) } +con_list : con { sL1 $1 (pure $1) } | con ',' con_list {% sLL $1 $> . (:| toList (unLoc $3)) <\$> addTrailingCommaN $1 (gl $2) } qcon_list :: { Located [LocatedN RdrName] } -qcon_list : qcon { sL1N $1 [$1] } +qcon_list : qcon { sL1 $1 [$1] } | qcon ',' qcon_list {% do { h <- addTrailingCommaN $1 (gl $2) ; return (sLL $1 $> (h : unLoc $3)) }} @@ -4117,28 +4117,16 @@ sL0 :: a -> Located a sL0 = L noSrcSpan -- #define L0 L noSrcSpan {-# INLINE sL1 #-} -sL1 :: GenLocated l a -> b -> GenLocated l b -sL1 x = sL (getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1A #-} -sL1A :: LocatedAn t a -> b -> Located b -sL1A x = sL (getLocA x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1N #-} -sL1N :: LocatedN a -> b -> Located b -sL1N x = sL (getLocA x) -- #define sL1 sL (getLoc $1) +sL1 :: HasLoc a => a -> b -> Located b +sL1 x = sL (getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1a #-} -sL1a :: Located a -> b -> LocatedAn t b -sL1a x = sL (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) - -{-# INLINE sL1l #-} -sL1l :: LocatedAn t a -> b -> LocatedAn u b -sL1l x = sL (l2l $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1a :: HasLoc a => a -> b -> LocatedAn t b +sL1a x = sL (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sL1n #-} -sL1n :: Located a -> b -> LocatedN b -sL1n x = L (noAnnSrcSpan $ getLoc x) -- #define sL1 sL (getLoc $1) +sL1n :: HasLoc a => a -> b -> LocatedN b +sL1n x = L (noAnnSrcSpan $ getHasLoc x) -- #define sL1 sL (getLoc $1) {-# INLINE sLL #-} sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c @@ -4428,18 +4416,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a) pvL a = do { av <- a ; return (reLoc av) } --- | Parse a Haskell module with Haddock comments. --- This is done in two steps: +-- | Parse a Haskell module with Haddock comments. This is done in two steps: -- -- * 'parseModuleNoHaddock' to build the AST -- * 'addHaddockToModule' to insert Haddock comments into it -- --- This is the only parser entry point that deals with Haddock comments. --- The other entry points ('parseDeclaration', 'parseExpression', etc) do --- not insert them into the AST. +-- This and the signature module parser are the only parser entry points that +-- deal with Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule +-- | Parse a Haskell signature module with Haddock comments. This is done in two +-- steps: +-- +-- * 'parseSignatureNoHaddock' to build the AST +-- * 'addHaddockToModule' to insert Haddock comments into it +-- +-- This and the module parser are the only parser entry points that deal with +-- Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. +parseSignature :: P (Located (HsModule GhcPs)) +parseSignature = parseSignatureNoHaddock >>= addHaddockToModule + commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc ===================================== testsuite/tests/parser/should_compile/T23315/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +T23315: clean + $(MAKE) clean + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build 1>&2 +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi ===================================== testsuite/tests/parser/should_compile/T23315/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file ===================================== testsuite/tests/parser/should_compile/T23315/T23315.cabal ===================================== @@ -0,0 +1,10 @@ +name: T23315 +version: 0.1.0.0 +build-type: Simple +cabal-version: 2.0 + +library + signatures: T23315 + build-depends: base >= 4.3 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -haddock -ddump-parsed-ast ===================================== testsuite/tests/parser/should_compile/T23315/T23315.hsig ===================================== @@ -0,0 +1,4 @@ +signature T23315 where +-- | My unit +a :: () +-- ^ More docs ===================================== testsuite/tests/parser/should_compile/T23315/T23315.stderr ===================================== @@ -0,0 +1,112 @@ + +==================== Parser AST ==================== + +(L + { T23315.hsig:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T23315.hsig:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 })) + ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))] + [] + (Nothing)) + (EpaComments + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 }) + {ModuleName: T23315})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 }) + (DocD + (NoExtField) + (DocCommentNext + (L + { T23315.hsig:2:1-12 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T23315.hsig:2:5-12 } + (HsDocStringChunk + " My unit")) + [])) + []))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T23315.hsig:3:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T23315.hsig:3:1-7 }) + (SigD + (NoExtField) + (TypeSig + (EpAnn + (Anchor + { T23315.hsig:3:1 } + (UnchangedAnchor)) + (AnnSig + (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 })) + []) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 }) + (Unqual + {OccName: a}))] + (HsWC + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsTupleTy + (EpAnn + (Anchor + { T23315.hsig:3:6 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T23315.hsig:3:6 }) + (EpaSpan { T23315.hsig:3:7 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 }) + (DocD + (NoExtField) + (DocCommentPrev + (L + { T23315.hsig:4:1-14 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringPrevious) + (:| + (L + { T23315.hsig:4:5-14 } + (HsDocStringChunk + " More docs")) + [])) + [])))))])) + + ===================================== testsuite/tests/parser/should_compile/T23315/all.T ===================================== @@ -0,0 +1,3 @@ +test('T23315', + [extra_files(['Setup.hs']), js_broken(22352)], + makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13cfab8f8b1991b6b0ab14d469f0a77b2d132659...a6757d9a7c66013d299ea8ad24548354435eda00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13cfab8f8b1991b6b0ab14d469f0a77b2d132659...a6757d9a7c66013d299ea8ad24548354435eda00 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 05:23:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 01:23:35 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 11 commits: Remove unused files in .gitlab Message-ID: <64ba1657a952_19cb1ab78541735ed@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - e0ac5f0f by Ben Gamari at 2023-07-21T01:21:25-04:00 base: Introduce Data.Enum - - - - - 4f986160 by Ben Gamari at 2023-07-21T01:21:31-04:00 base: Add export list to GHC.Num.Integer - - - - - f81f84cf by Ben Gamari at 2023-07-21T01:21:31-04:00 base: Add export list to GHC.Num - - - - - 615f661e by Ben Gamari at 2023-07-21T01:21:31-04:00 base: Add export list to GHC.Num.Natural - - - - - c48af449 by Ben Gamari at 2023-07-21T01:22:20-04:00 base: Add export list to GHC.Float - - - - - 5ef2fdce by Ben Gamari at 2023-07-21T01:22:38-04:00 base: Add export list to GHC.Real - - - - - 9be9b7e4 by Ben Gamari at 2023-07-21T01:22:41-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T13386 - - - - - 17 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Parser.y - + libraries/base/Data/Enum.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09ac0e6b30ae1bb6662fccd386dba14b7cfe995c...9be9b7e4d03c3de7bcb81597ac2a0fb93a58c040 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/09ac0e6b30ae1bb6662fccd386dba14b7cfe995c...9be9b7e4d03c3de7bcb81597ac2a0fb93a58c040 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 10:00:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 21 Jul 2023 06:00:40 -0400 Subject: [Git][ghc/ghc][wip/t23465] 83 commits: Filter out nontrivial substituted expressions in substTickish Message-ID: <64ba5748d83f8_19cb1ab7818226431@gitlab.mail> Matthew Pickering pushed to branch wip/t23465 at Glasgow Haskell Compiler / GHC Commits: 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - b37cdc67 by Matthew Pickering at 2023-07-21T11:00:11+01:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - 12 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b480eb9a3422e8f59ce35458b47d3b5622eabed...b37cdc6781ab8a3480430ecdf5b74677e3aaf29c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b480eb9a3422e8f59ce35458b47d3b5622eabed...b37cdc6781ab8a3480430ecdf5b74677e3aaf29c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 11:10:58 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 21 Jul 2023 07:10:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/enable-late-ccs-release Message-ID: <64ba67c2eab00_19cb1a1af74440247684@gitlab.mail> Matthew Pickering pushed new branch wip/enable-late-ccs-release at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/enable-late-ccs-release You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 11:17:02 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 21 Jul 2023 07:17:02 -0400 Subject: [Git][ghc/ghc][wip/enable-late-ccs-release] packaging: Enable late-ccs for perf (and hence release) flavours Message-ID: <64ba692edd523_19cb1a1af75548247853@gitlab.mail> Matthew Pickering pushed to branch wip/enable-late-ccs-release at Glasgow Haskell Compiler / GHC Commits: df1e3d37 by Matthew Pickering at 2023-07-21T12:13:02+01:00 packaging: Enable late-ccs for perf (and hence release) flavours This enables late cost centres when building profiled libraries and subsequently greatly improves the resolution of cost centre stacks when profiling. Fixes #21732 - - - - - 2 changed files: - hadrian/src/Flavour.hs - hadrian/src/Settings/Flavours/Performance.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -7,6 +7,7 @@ module Flavour , addArgs , splitSections , enableThreadSanitizer + , enableLateCCS , enableDebugInfo, enableTickyGhc , viaLlvmBackend , enableProfiledGhc ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -6,7 +6,7 @@ import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. performanceFlavour :: Flavour -performanceFlavour = splitSections $ defaultFlavour +performanceFlavour = enableLateCCS $ splitSections $ defaultFlavour { name = "perf" , extraArgs = performanceArgs } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df1e3d3731b45a0cc024b6fd4e815e774ebad4d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df1e3d3731b45a0cc024b6fd4e815e774ebad4d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 11:23:48 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 21 Jul 2023 07:23:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/mr-template-full-ci Message-ID: <64ba6ac41ee9d_19cb1a1af7415c251842@gitlab.mail> Matthew Pickering pushed new branch wip/mr-template-full-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mr-template-full-ci You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 11:29:11 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 21 Jul 2023 07:29:11 -0400 Subject: [Git][ghc/ghc][wip/T21077-take-two] Draft: Don't use VAExpansion Message-ID: <64ba6c07b2238_19cb1a1af75548254199@gitlab.mail> Ryan Scott pushed to branch wip/T21077-take-two at Glasgow Haskell Compiler / GHC Commits: 6a247718 by Ryan Scott at 2023-07-21T07:28:41-04:00 Draft: Don't use VAExpansion See https://gitlab.haskell.org/ghc/ghc/-/issues/21077#note_514392 - - - - - 1 changed file: - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -310,10 +310,9 @@ splitHsApps e = go e (top_ctxt 0 e) [] (EWrap (EExpand orig) : args) go (HsUntypedSplice (HsUntypedSpliceTop mod_finalizers fun) - (HsUntypedSpliceExpr _ (L _ orig))) ctxt args + (HsUntypedSpliceExpr _ (L l orig))) ctxt args = do addModFinalizersWithLclEnv mod_finalizers - go fun (VAExpansion orig (appCtxtLoc ctxt)) - (EWrap (EExpand orig) : args) + go fun (set l ctxt) (EWrap (EExpand orig) : args) -- See Note [Desugar OpApp in the typechecker] go e@(OpApp _ arg1 (L l op) arg2) _ args View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a247718be5bea2a1f5d47ade42c6c57d635dab1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a247718be5bea2a1f5d47ade42c6c57d635dab1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 11:31:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 07:31:33 -0400 Subject: [Git][ghc/ghc][master] 2 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64ba6c951d9f4_19cb1a1af7446825983d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/Ppr.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -511,7 +511,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release+no_split_sections + - job: release-x86_64-windows-release optional: true tags: @@ -535,7 +535,7 @@ doc-tarball: || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \ || true mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \ - || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \ + || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \ || true if [ ! -f "$LINUX_BINDIST" ]; then echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -921,8 +921,8 @@ job_groups = -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) - , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) - , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) + , fastCI (standardBuildsWithConfig Amd64 Windows vanilla) + , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , fastCI (standardBuilds AArch64 Darwin) ===================================== .gitlab/jobs.yaml ===================================== @@ -3577,7 +3577,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-windows-int_native-release+no_split_sections": { + "release-x86_64-windows-int_native-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3587,7 +3587,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-int_native-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3626,8 +3626,8 @@ ], "variables": { "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3636,11 +3636,11 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", + "TEST_ENV": "x86_64-windows-int_native-release", "XZ_OPT": "-9" } }, - "release-x86_64-windows-release+no_split_sections": { + "release-x86_64-windows-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3650,7 +3650,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3689,8 +3689,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3699,7 +3699,7 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-release+no_split_sections", + "TEST_ENV": "x86_64-windows-release", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix = OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of + Text + | OSMinGW32 <- platformOS platform + -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b23db0314139a4ad453c590a184efb54bc842dd...db7f7240b53c01447e44d2790ee37eacaabfbcf3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b23db0314139a4ad453c590a184efb54bc842dd...db7f7240b53c01447e44d2790ee37eacaabfbcf3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 11:31:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 07:31:55 -0400 Subject: [Git][ghc/ghc][master] Insert documentation into parsed signature modules Message-ID: <64ba6cab9bed3_19cb1a1af7442c2651ce@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 7 changed files: - compiler/GHC/Parser.y - + testsuite/tests/parser/should_compile/T23315/Makefile - + testsuite/tests/parser/should_compile/T23315/Setup.hs - + testsuite/tests/parser/should_compile/T23315/T23315.cabal - + testsuite/tests/parser/should_compile/T23315/T23315.hsig - + testsuite/tests/parser/should_compile/T23315/T23315.stderr - + testsuite/tests/parser/should_compile/T23315/all.T Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -751,7 +751,7 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } -- Exported parsers %name parseModuleNoHaddock module -%name parseSignature signature +%name parseSignatureNoHaddock signature %name parseImport importdecl %name parseStatement e_stmt %name parseDeclaration topdecl @@ -4416,18 +4416,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a) pvL a = do { av <- a ; return (reLoc av) } --- | Parse a Haskell module with Haddock comments. --- This is done in two steps: +-- | Parse a Haskell module with Haddock comments. This is done in two steps: -- -- * 'parseModuleNoHaddock' to build the AST -- * 'addHaddockToModule' to insert Haddock comments into it -- --- This is the only parser entry point that deals with Haddock comments. --- The other entry points ('parseDeclaration', 'parseExpression', etc) do --- not insert them into the AST. +-- This and the signature module parser are the only parser entry points that +-- deal with Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule +-- | Parse a Haskell signature module with Haddock comments. This is done in two +-- steps: +-- +-- * 'parseSignatureNoHaddock' to build the AST +-- * 'addHaddockToModule' to insert Haddock comments into it +-- +-- This and the module parser are the only parser entry points that deal with +-- Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. +parseSignature :: P (Located (HsModule GhcPs)) +parseSignature = parseSignatureNoHaddock >>= addHaddockToModule + commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc ===================================== testsuite/tests/parser/should_compile/T23315/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +T23315: clean + $(MAKE) clean + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build 1>&2 +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi ===================================== testsuite/tests/parser/should_compile/T23315/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file ===================================== testsuite/tests/parser/should_compile/T23315/T23315.cabal ===================================== @@ -0,0 +1,10 @@ +name: T23315 +version: 0.1.0.0 +build-type: Simple +cabal-version: 2.0 + +library + signatures: T23315 + build-depends: base >= 4.3 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -haddock -ddump-parsed-ast ===================================== testsuite/tests/parser/should_compile/T23315/T23315.hsig ===================================== @@ -0,0 +1,4 @@ +signature T23315 where +-- | My unit +a :: () +-- ^ More docs ===================================== testsuite/tests/parser/should_compile/T23315/T23315.stderr ===================================== @@ -0,0 +1,112 @@ + +==================== Parser AST ==================== + +(L + { T23315.hsig:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T23315.hsig:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 })) + ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))] + [] + (Nothing)) + (EpaComments + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 }) + {ModuleName: T23315})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 }) + (DocD + (NoExtField) + (DocCommentNext + (L + { T23315.hsig:2:1-12 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T23315.hsig:2:5-12 } + (HsDocStringChunk + " My unit")) + [])) + []))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T23315.hsig:3:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T23315.hsig:3:1-7 }) + (SigD + (NoExtField) + (TypeSig + (EpAnn + (Anchor + { T23315.hsig:3:1 } + (UnchangedAnchor)) + (AnnSig + (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 })) + []) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 }) + (Unqual + {OccName: a}))] + (HsWC + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsTupleTy + (EpAnn + (Anchor + { T23315.hsig:3:6 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T23315.hsig:3:6 }) + (EpaSpan { T23315.hsig:3:7 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 }) + (DocD + (NoExtField) + (DocCommentPrev + (L + { T23315.hsig:4:1-14 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringPrevious) + (:| + (L + { T23315.hsig:4:5-14 } + (HsDocStringChunk + " More docs")) + [])) + [])))))])) + + ===================================== testsuite/tests/parser/should_compile/T23315/all.T ===================================== @@ -0,0 +1,3 @@ +test('T23315', + [extra_files(['Setup.hs']), js_broken(22352)], + makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b444c16f4ff64938a8bec9587bd90209bda682b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b444c16f4ff64938a8bec9587bd90209bda682b9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 12:02:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 08:02:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64ba73e53c52b_19cb1a1af6ff1c2793f1@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 70f3b87c by Matthew Pickering at 2023-07-21T08:02:30-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - 1321f1e9 by Matthew Pickering at 2023-07-21T08:02:31-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 335926aa by Krzysztof Gogolewski at 2023-07-21T08:02:31-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 46c04c0c by Matthew Pickering at 2023-07-21T08:02:32-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Parser.y - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Default.hs-boot - hadrian/src/Settings/Flavours/Benchmark.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Performance.hs - hadrian/src/Settings/Flavours/Validate.hs - + testsuite/tests/parser/should_compile/T23315/Makefile - + testsuite/tests/parser/should_compile/T23315/Setup.hs - + testsuite/tests/parser/should_compile/T23315/T23315.cabal - + testsuite/tests/parser/should_compile/T23315/T23315.hsig - + testsuite/tests/parser/should_compile/T23315/T23315.stderr - + testsuite/tests/parser/should_compile/T23315/all.T - + testsuite/tests/simplCore/should_compile/T23630.hs - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_compile/T23413.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -433,6 +433,7 @@ hadrian-multi: - cabal-cache rules: - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' ############################################################ # stack-hadrian-build @@ -511,7 +512,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release+no_split_sections + - job: release-x86_64-windows-release optional: true tags: @@ -535,7 +536,7 @@ doc-tarball: || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \ || true mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \ - || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \ + || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \ || true if [ ! -f "$LINUX_BINDIST" ]; then echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?" @@ -831,6 +832,7 @@ perf-nofib: - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' tags: - x86_64-linux before_script: @@ -898,6 +900,7 @@ perf: - out rules: - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' ############################################################ # ABI testing @@ -938,6 +941,7 @@ abi-test: - out rules: - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' ############################################################ ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -921,8 +921,8 @@ job_groups = -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) - , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) - , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) + , fastCI (standardBuildsWithConfig Amd64 Windows vanilla) + , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , fastCI (standardBuilds AArch64 Darwin) ===================================== .gitlab/jobs.yaml ===================================== @@ -3577,7 +3577,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-windows-int_native-release+no_split_sections": { + "release-x86_64-windows-int_native-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3587,7 +3587,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-int_native-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3626,8 +3626,8 @@ ], "variables": { "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3636,11 +3636,11 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", + "TEST_ENV": "x86_64-windows-int_native-release", "XZ_OPT": "-9" } }, - "release-x86_64-windows-release+no_split_sections": { + "release-x86_64-windows-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3650,7 +3650,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3689,8 +3689,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3699,7 +3699,7 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-release+no_split_sections", + "TEST_ENV": "x86_64-windows-release", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix = OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of + Text + | OSMinGW32 <- platformOS platform + -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -888,9 +888,6 @@ So we must add the template vars to the in-scope set before starting; see `init_menv` in `matchN`. -} -rvInScopeEnv :: RuleMatchEnv -> InScopeEnv -rvInScopeEnv renv = ISE (rnInScopeSet (rv_lcl renv)) (rv_unf renv) - -- * The domain of the TvSubstEnv and IdSubstEnv are the template -- variables passed into the match. -- @@ -1271,7 +1268,16 @@ match renv subst e1 (Let bind e2) mco ------------------------ Lambdas --------------------- match renv subst (Lam x1 e1) e2 mco - | Just (x2, e2', ts) <- exprIsLambda_maybe (rvInScopeEnv renv) (mkCastMCo e2 mco) + | let casted_e2 = mkCastMCo e2 mco + in_scope = extendInScopeSetSet (rnInScopeSet (rv_lcl renv)) + (exprFreeVars casted_e2) + in_scope_env = ISE in_scope (rv_unf renv) + -- extendInScopeSetSet: The InScopeSet of rn_env is not necessarily + -- a superset of the free vars of e2; it is only guaranteed a superset of + -- applyng the (rnEnvR rn_env) substitution to e2. But exprIsLambda_maybe + -- wants an in-scope set that includes all the free vars of its argument. + -- Hence adding adding (exprFreeVars casted_e2) to the in-scope set (#23630) + , Just (x2, e2', ts) <- exprIsLambda_maybe in_scope_env casted_e2 -- See Note [Lambdas in the template] = let renv' = rnMatchBndr2 renv x1 x2 subst' = subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts } ===================================== compiler/GHC/Parser.y ===================================== @@ -751,7 +751,7 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } -- Exported parsers %name parseModuleNoHaddock module -%name parseSignature signature +%name parseSignatureNoHaddock signature %name parseImport importdecl %name parseStatement e_stmt %name parseDeclaration topdecl @@ -4416,18 +4416,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a) pvL a = do { av <- a ; return (reLoc av) } --- | Parse a Haskell module with Haddock comments. --- This is done in two steps: +-- | Parse a Haskell module with Haddock comments. This is done in two steps: -- -- * 'parseModuleNoHaddock' to build the AST -- * 'addHaddockToModule' to insert Haddock comments into it -- --- This is the only parser entry point that deals with Haddock comments. --- The other entry points ('parseDeclaration', 'parseExpression', etc) do --- not insert them into the AST. +-- This and the signature module parser are the only parser entry points that +-- deal with Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule +-- | Parse a Haskell signature module with Haddock comments. This is done in two +-- steps: +-- +-- * 'parseSignatureNoHaddock' to build the AST +-- * 'addHaddockToModule' to insert Haddock comments into it +-- +-- This and the module parser are the only parser entry points that deal with +-- Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. +parseSignature :: P (Located (HsModule GhcPs)) +parseSignature = parseSignatureNoHaddock >>= addHaddockToModule + commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -50,6 +50,10 @@ haddockBuilderArgs = mconcat baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) let baseUrl p = substituteTemplate baseUrlTemplate p ghcOpts <- haddockGhcArgs + -- These are the options which are necessary to perform the build. Additional + -- options such as `--hyperlinked-source`, `--hoogle`, `--quickjump` are + -- added by the `extraArgs` field in the flavour. The defaults are provided + -- by `defaultHaddockExtraArgs`. mconcat [ arg "--verbosity=0" , arg $ "-B" ++ root -/- stageString Stage1 -/- "lib" @@ -57,9 +61,6 @@ haddockBuilderArgs = mconcat , arg $ "--odir=" ++ takeDirectory output , arg $ "--dump-interface=" ++ output , arg "--html" - , arg "--hyperlinked-source" - , arg "--hoogle" - , arg "--quickjump" , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version ++ ": " ++ synopsis , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -7,7 +7,7 @@ module Settings.Default ( -- * Default command line arguments for various builders SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, - defaultExtraArgs, + defaultExtraArgs, defaultHaddockExtraArgs, -- * Default build flavour and BigNum backend defaultFlavour, defaultBignumBackend @@ -219,7 +219,13 @@ sourceArgs SourceArgs {..} = builder Ghc ? mconcat -- | All default command line arguments. defaultExtraArgs :: Args -defaultExtraArgs = sourceArgs defaultSourceArgs +defaultExtraArgs = + mconcat [ sourceArgs defaultSourceArgs, defaultHaddockExtraArgs ] + +defaultHaddockExtraArgs :: Args +defaultHaddockExtraArgs = builder (Haddock BuildPackage) ? + mconcat [ arg "--hyperlinked-source", arg "--hoogle", arg "--quickjump" ] + -- | Default source arguments, e.g. optimisation settings. defaultSourceArgs :: SourceArgs ===================================== hadrian/src/Settings/Default.hs-boot ===================================== @@ -1,6 +1,6 @@ module Settings.Default ( SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, - defaultExtraArgs, defaultLibraryWays, defaultRtsWays, + defaultExtraArgs, defaultHaddockExtraArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultBignumBackend ) where @@ -15,7 +15,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args -defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs :: Args +defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs, defaultHaddockExtraArgs :: Args defaultLibraryWays, defaultRtsWays :: Ways defaultFlavour :: Flavour defaultBignumBackend :: String ===================================== hadrian/src/Settings/Flavours/Benchmark.hs ===================================== @@ -10,7 +10,7 @@ import {-# SOURCE #-} Settings.Default benchmarkFlavour :: Flavour benchmarkFlavour = defaultFlavour { name = "bench" - , extraArgs = benchmarkArgs + , extraArgs = benchmarkArgs <> defaultHaddockExtraArgs , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = Set.fromList <$> mconcat [pure [vanilla], targetSupportsThreadedRts ? pure [threaded]] } ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default developmentFlavour :: Stage -> Flavour developmentFlavour ghcStage = defaultFlavour { name = "devel" ++ stageString ghcStage - , extraArgs = developmentArgs ghcStage + , extraArgs = developmentArgs ghcStage <> defaultHaddockExtraArgs , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = Set.fromList <$> mconcat [pure [vanilla, debug], targetSupportsThreadedRts ? pure [threaded, threadedDebug]] , dynamicGhcPrograms = return False ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -8,7 +8,7 @@ import {-# SOURCE #-} Settings.Default performanceFlavour :: Flavour performanceFlavour = splitSections $ defaultFlavour { name = "perf" - , extraArgs = performanceArgs } + , extraArgs = performanceArgs <> defaultHaddockExtraArgs } performanceArgs :: Args performanceArgs = sourceArgs SourceArgs ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default validateFlavour :: Flavour validateFlavour = enableLinting $ werror $ defaultFlavour { name = "validate" - , extraArgs = validateArgs + , extraArgs = validateArgs <> defaultHaddockExtraArgs , libraryWays = Set.fromList <$> mconcat [ pure [vanilla] , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ===================================== testsuite/tests/parser/should_compile/T23315/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +T23315: clean + $(MAKE) clean + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build 1>&2 +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi ===================================== testsuite/tests/parser/should_compile/T23315/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file ===================================== testsuite/tests/parser/should_compile/T23315/T23315.cabal ===================================== @@ -0,0 +1,10 @@ +name: T23315 +version: 0.1.0.0 +build-type: Simple +cabal-version: 2.0 + +library + signatures: T23315 + build-depends: base >= 4.3 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -haddock -ddump-parsed-ast ===================================== testsuite/tests/parser/should_compile/T23315/T23315.hsig ===================================== @@ -0,0 +1,4 @@ +signature T23315 where +-- | My unit +a :: () +-- ^ More docs ===================================== testsuite/tests/parser/should_compile/T23315/T23315.stderr ===================================== @@ -0,0 +1,112 @@ + +==================== Parser AST ==================== + +(L + { T23315.hsig:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T23315.hsig:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 })) + ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))] + [] + (Nothing)) + (EpaComments + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 }) + {ModuleName: T23315})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 }) + (DocD + (NoExtField) + (DocCommentNext + (L + { T23315.hsig:2:1-12 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T23315.hsig:2:5-12 } + (HsDocStringChunk + " My unit")) + [])) + []))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T23315.hsig:3:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T23315.hsig:3:1-7 }) + (SigD + (NoExtField) + (TypeSig + (EpAnn + (Anchor + { T23315.hsig:3:1 } + (UnchangedAnchor)) + (AnnSig + (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 })) + []) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 }) + (Unqual + {OccName: a}))] + (HsWC + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsTupleTy + (EpAnn + (Anchor + { T23315.hsig:3:6 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T23315.hsig:3:6 }) + (EpaSpan { T23315.hsig:3:7 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 }) + (DocD + (NoExtField) + (DocCommentPrev + (L + { T23315.hsig:4:1-14 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringPrevious) + (:| + (L + { T23315.hsig:4:5-14 } + (HsDocStringChunk + " More docs")) + [])) + [])))))])) + + ===================================== testsuite/tests/parser/should_compile/T23315/all.T ===================================== @@ -0,0 +1,3 @@ +test('T23315', + [extra_files(['Setup.hs']), js_broken(22352)], + makefile_test, []) ===================================== testsuite/tests/simplCore/should_compile/T23630.hs ===================================== @@ -0,0 +1,17 @@ +module T23630 where + +data HOLType = UTypeIn !HOLType deriving Eq + +tyVars :: HOLType -> [HOLType] +tyVars (UTypeIn tv) = [undefined] + +union :: Eq a => [a] -> [a] -> [a] +union l1 l2 = foldr insert l2 l1 + +insert :: Eq a => a -> [a] -> [a] +insert x l + | x `elem` l = l + | otherwise = x : l + +catTyVars :: [HOLType] -> [HOLType] +catTyVars = foldr (union . tyVars) [] ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -472,6 +472,7 @@ test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-agg test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) +test('T23630', normal, compile, ['-O']) test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) ===================================== testsuite/tests/typecheck/should_compile/T23413.hs ===================================== @@ -0,0 +1,13 @@ +module T23413 where + +f :: (Int ~ Bool) => Int -> Bool +f x = f x + +g1 :: (Int ~ Bool) => Int -> Bool +g1 x = f x + +g2 :: (Bool ~ Int) => Int -> Bool +g2 x = f x + +h :: (Int ~ Bool) => Int -> Bool +h x = x ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -888,3 +888,4 @@ test('T23514c', normal, compile, ['']) test('T22537', normal, compile, ['']) test('T18986a', normal, compile, ['']) test('T18986b', normal, compile, ['']) +test('T23413', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6757d9a7c66013d299ea8ad24548354435eda00...46c04c0c5d69d03651eaa4645b3b5a29a66aebf3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a6757d9a7c66013d299ea8ad24548354435eda00...46c04c0c5d69d03651eaa4645b3b5a29a66aebf3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 12:48:48 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 21 Jul 2023 08:48:48 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] Some edit to the Note Message-ID: <64ba7eaff13d0_19cb1a1af7442c3134f4@gitlab.mail> Simon Peyton Jones pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 52f16a58 by Simon Peyton Jones at 2023-07-21T13:48:23+01:00 Some edit to the Note done in a call with Vlad - - - - - 1 changed file: - compiler/GHC/Tc/Gen/App.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -892,8 +892,9 @@ evolved over time, and is based on the following papers and proposals: - "Visible forall in types of terms" https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst -The proposals have not been fully implemented at the time of writing this Note, -so we offer an overview of the design mixed with commentary on the implementation status. +Here we offer an overview of the design mixed with commentary on the +implementation status. The proposals have not been fully implemented at the +time of writing this Note (see "non implemented" in the rest of this Note). Now consider functions fi :: forall {a}. a -> t -- Inferred: type argument cannot be supplied @@ -939,26 +940,27 @@ The moving parts are as follows: Syntax of types --------------- * The types are all initially represented with HsForAllTy (c.o. HsType). + The binders are in the (hst_tele :: HsForAllTelescope pass) field of the HsForAllTy At this stage, we have forall {a}. t -- HsForAllInvis (c.o. HsForAllTelescope) and InferredSpec (c.o. Specificity) forall a. t -- HsForAllInvis (c.o. HsForAllTelescope) and SpecifiedSpec (c.o. Specificity) forall a -> t -- HsForAllVis (c.o. HsForAllTelescope) -* By the time we get to checking applications/abstractions, - the types have been desugared into ForAllTy (c.o. Type). +* By the time we get to checking applications/abstractions (e.g. GHC.Tc.Gen.App) + the types have been kind-checked (e.g. by tcHsType) into ForAllTy (c.o. Type). At this stage, we have: forall {a}. t -- ForAllTy (c.o. Type) and Inferred (c.o. ForAllTyFlag) forall a. t -- ForAllTy (c.o. Type) and Specified (c.o. ForAllTyFlag) forall a -> t -- ForAllTy (c.o. Type) and Required (c.o. ForAllTyFlag) -Syntax of applications ----------------------- -* Type applications are represented with the following constructors - f True -- HsApp (c.o. HsExpr, plain function application) - f @True -- HsAppType (c.o. HsExpr, function application with `@`) - type True -- HsEmbTy (c.o. HsExpr, embed a type into an expression with `type`) +Syntax of applications in HsExpr +-------------------------------- +* We represent applications like this (ignoring parameterisation) + data HsExpr = HsApp HsExpr HsExpr -- (f True) plain function application) + | HsTyApp HsExpr HsType -- (f @True) function application with `@`) + | HsEmbType HsType -- (type ty) embed a type into an expression with `type`) -* The HsAppType constructor is only used with Specified type variables +* The HsAppType constructor is only used for Specified type variables f @True -- only valid for f :: forall a. t * The HsApp constructor without HsEmbTy is used with ordinary function application @@ -976,9 +978,17 @@ Syntax of applications g (Either (type Int) (type Bool)) -- valid for g :: forall (a :: Type) -> t (NB. not implemented) This nesting makes `type` rather different from `@`. + The HsEmbTy mainly just switches name-space, and affects the term-to-type transformation. + +Syntax of abstractions in Pat +----------------------------- +similary... + + +data HsPat = ConPat [HsTyPat] [HsPat] + + | EmbPat HsTyPat -Syntax of abstractions ----------------------- * Type abstractions are represented with the following constructors \ (MkT @a (x :: a)) -> rhs -- ConPat (c.o. Pat) and HsConPatTyArg (c.o. HsConPatTyArg) \ (type a) (x :: a) -> rhs -- EmbTyPat (c.o. Pat) @@ -994,6 +1004,8 @@ Syntax of abstractions \ (P @(a -> Either b c)) -> rhs All these forms are represented with HsTP (c.o. HsTyPat). + + Renaming type applications -------------------------- rnExpr delegates renaming of type arguments to rnHsWcType if possible: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52f16a585c2ba651aa663430464816ad47d4abc0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52f16a585c2ba651aa663430464816ad47d4abc0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 15:06:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 11:06:22 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 14 commits: Fix deprecation of record fields Message-ID: <64ba9eeeb1901_19cb1a1af74454332515@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 3d913cbe by sheaf at 2023-07-20T15:29:21-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. (cherry picked from commit 6143838a5985ee3af1e8c2af4166d35bb4de12d8) - - - - - 45ab7560 by sheaf at 2023-07-20T15:29:24-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. (cherry picked from commit 6fd8f566c691b936b0b65e21700b224312611f4d) - - - - - c5533204 by sheaf at 2023-07-20T15:29:25-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- (cherry picked from commit 7f0a86edeeda674f27c80e81be592d325447a897) - - - - - ff06b820 by sheaf at 2023-07-20T15:30:07-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 (cherry picked from commit c7bbad9a0aab2d7b4336ae411e13d9450d8483a7) - - - - - 2734d370 by sheaf at 2023-07-20T15:34:20-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. (cherry picked from commit 1af2e7735283251c686bdb1154afab6df5e45053) - - - - - 84e6df59 by sheaf at 2023-07-20T15:34:20-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 (cherry picked from commit 3bd4d5b5482fd44914f22492877b3f3ca27299e0) - - - - - fa084def by sheaf at 2023-07-20T15:34:33-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 (cherry picked from commit 22565506515313c928d13a43b2946e0106110353) - - - - - f9f4714e by sheaf at 2023-07-20T15:34:34-04:00 exactprint: silence incomplete record update warnings (cherry picked from commit 860f6269bc016e11400b7e3176a5ea6dfe291a46) - - - - - 071dd8ca by sheaf at 2023-07-20T15:35:45-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings (cherry picked from commit df706de378e3415a3972ddd14863f54fc7162dc7) - - - - - c7688443 by sheaf at 2023-07-20T15:35:55-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 (cherry picked from commit 1d05971e24f6cb1120789d1e1ab4f086eebd504a) - - - - - ae88ed9a by sheaf at 2023-07-20T15:35:56-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. (cherry picked from commit bea0e323c09e9e4b841a37aacd6b67e87a85e7cb) - - - - - f00446f5 by Ben Gamari at 2023-07-21T15:04:43+00:00 gitlab-ci: Don't run nonmoving bootstrap release job This was only intended for validation. - - - - - c9e18bb7 by Ben Gamari at 2023-07-21T15:05:04+00:00 fetch-gitlab: Update job mapping - - - - - 7c5386d2 by Ben Gamari at 2023-07-21T15:05:34+00:00 nofib: Bump submodule - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Data/FastString.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Deriv/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccb9981bf74b78194d9baef9d9483235968b8849...7c5386d29626759a8cca561811acc514e57c603e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ccb9981bf74b78194d9baef9d9483235968b8849...7c5386d29626759a8cca561811acc514e57c603e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 15:49:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 11:49:25 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 10 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64baa905ef7ab_19cb1a1af755483414e1@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - f7ce8a63 by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Introduce Data.Enum - - - - - e2c6430d by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Num.Integer - - - - - d03cd0ce by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Num - - - - - d31b53ef by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Num.Natural - - - - - 85b7225c by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Float - - - - - 22d1f46c by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Real - - - - - dd16a902 by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T13386 Metric Decrease: T13386 T8095 - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Parser.y - + libraries/base/Data/Enum.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + testsuite/tests/parser/should_compile/T23315/Makefile - + testsuite/tests/parser/should_compile/T23315/Setup.hs - + testsuite/tests/parser/should_compile/T23315/T23315.cabal - + testsuite/tests/parser/should_compile/T23315/T23315.hsig - + testsuite/tests/parser/should_compile/T23315/T23315.stderr - + testsuite/tests/parser/should_compile/T23315/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -511,7 +511,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release+no_split_sections + - job: release-x86_64-windows-release optional: true tags: @@ -535,7 +535,7 @@ doc-tarball: || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \ || true mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \ - || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \ + || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \ || true if [ ! -f "$LINUX_BINDIST" ]; then echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -921,8 +921,8 @@ job_groups = -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) - , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) - , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) + , fastCI (standardBuildsWithConfig Amd64 Windows vanilla) + , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , fastCI (standardBuilds AArch64 Darwin) ===================================== .gitlab/jobs.yaml ===================================== @@ -3577,7 +3577,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-windows-int_native-release+no_split_sections": { + "release-x86_64-windows-int_native-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3587,7 +3587,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-int_native-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3626,8 +3626,8 @@ ], "variables": { "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3636,11 +3636,11 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", + "TEST_ENV": "x86_64-windows-int_native-release", "XZ_OPT": "-9" } }, - "release-x86_64-windows-release+no_split_sections": { + "release-x86_64-windows-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3650,7 +3650,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3689,8 +3689,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3699,7 +3699,7 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-release+no_split_sections", + "TEST_ENV": "x86_64-windows-release", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix = OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of + Text + | OSMinGW32 <- platformOS platform + -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty ===================================== compiler/GHC/Parser.y ===================================== @@ -751,7 +751,7 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } -- Exported parsers %name parseModuleNoHaddock module -%name parseSignature signature +%name parseSignatureNoHaddock signature %name parseImport importdecl %name parseStatement e_stmt %name parseDeclaration topdecl @@ -4416,18 +4416,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a) pvL a = do { av <- a ; return (reLoc av) } --- | Parse a Haskell module with Haddock comments. --- This is done in two steps: +-- | Parse a Haskell module with Haddock comments. This is done in two steps: -- -- * 'parseModuleNoHaddock' to build the AST -- * 'addHaddockToModule' to insert Haddock comments into it -- --- This is the only parser entry point that deals with Haddock comments. --- The other entry points ('parseDeclaration', 'parseExpression', etc) do --- not insert them into the AST. +-- This and the signature module parser are the only parser entry points that +-- deal with Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule +-- | Parse a Haskell signature module with Haddock comments. This is done in two +-- steps: +-- +-- * 'parseSignatureNoHaddock' to build the AST +-- * 'addHaddockToModule' to insert Haddock comments into it +-- +-- This and the module parser are the only parser entry points that deal with +-- Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. +parseSignature :: P (Located (HsModule GhcPs)) +parseSignature = parseSignatureNoHaddock >>= addHaddockToModule + commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,102 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + , floorFloat + , ceilingFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Monomorphic equality operators + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , eqFloat, eqDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,66 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -6999,7 +7018,6 @@ module GHC.Float where castWord64ToDouble :: GHC.Word.Word64 -> Double ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b - clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int cosDouble :: Double -> Double cosFloat :: Float -> Float coshDouble :: Double -> Double @@ -7014,9 +7032,6 @@ module GHC.Float where expFloat :: Float -> Float expm1Double :: Double -> Double expm1Float :: Float -> Float - expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer - expts :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer - expts10 :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer fabsDouble :: Double -> Double fabsFloat :: Float -> Float float2Double :: Float -> Double @@ -7028,7 +7043,6 @@ module GHC.Float where formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Base.String fromRat :: forall a. RealFloat a => GHC.Real.Rational -> a fromRat' :: forall a. RealFloat a => GHC.Real.Rational -> a - fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a geDouble :: Double -> Double -> GHC.Types.Bool geFloat :: Float -> Float -> GHC.Types.Bool gtDouble :: Double -> Double -> GHC.Types.Bool @@ -7057,9 +7071,6 @@ module GHC.Float where logFloat :: Float -> Float ltDouble :: Double -> Double -> GHC.Types.Bool ltFloat :: Float -> Float -> GHC.Types.Bool - maxExpt :: GHC.Types.Int - maxExpt10 :: GHC.Types.Int - minExpt :: GHC.Types.Int minusDouble :: Double -> Double -> Double minusFloat :: Float -> Float -> Float naturalToDouble# :: GHC.Num.Natural.Natural -> Double# @@ -7068,8 +7079,6 @@ module GHC.Float where negateFloat :: Float -> Float plusDouble :: Double -> Double -> Double plusFloat :: Float -> Float -> Float - powerDouble :: Double -> Double -> Double - powerFloat :: Float -> Float -> Float properFractionDouble :: forall b. GHC.Real.Integral b => Double -> (b, Double) properFractionFloat :: forall b. GHC.Real.Integral b => Float -> (b, Float) rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double @@ -7086,10 +7095,6 @@ module GHC.Float where sinhFloat :: Float -> Float sqrtDouble :: Double -> Double sqrtFloat :: Float -> Float - stgDoubleToWord64 :: Double# -> GHC.Prim.Word64# - stgFloatToWord32 :: Float# -> GHC.Prim.Word32# - stgWord32ToFloat :: GHC.Prim.Word32# -> Float# - stgWord64ToDouble :: GHC.Prim.Word64# -> Double# tanDouble :: Double -> Double tanFloat :: Float -> Float tanhDouble :: Double -> Double @@ -7097,7 +7102,6 @@ module GHC.Float where timesDouble :: Double -> Double -> Double timesFloat :: Float -> Float -> Float truncateDouble :: forall b. GHC.Real.Integral b => Double -> b - truncateFloat :: forall b. GHC.Real.Integral b => Float -> b word2Double :: GHC.Types.Word -> Double word2Float :: GHC.Types.Word -> Float @@ -9002,8 +9006,6 @@ module GHC.Real where recip :: a -> a fromRational :: Rational -> a {-# MINIMAL fromRational, (recip | (/)) #-} - type FractionalExponentBase :: * - data FractionalExponentBase = Base2 | Base10 type Integral :: * -> Constraint class (Real a, GHC.Enum.Enum a) => Integral a where quot :: a -> a -> a @@ -9031,9 +9033,7 @@ module GHC.Real where floor :: forall b. Integral b => a -> b {-# MINIMAL properFraction #-} (^) :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - (^%^) :: forall a. Integral a => Rational -> a -> Rational (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a - (^^%^^) :: forall a. Integral a => Rational -> a -> Rational denominator :: forall a. Ratio a -> a divZeroError :: forall a. a even :: forall a. Integral a => a -> GHC.Types.Bool @@ -9047,7 +9047,6 @@ module GHC.Real where lcm :: forall a. Integral a => a -> a -> a mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational - mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational notANumber :: Rational numerator :: forall a. Ratio a -> a numericEnumFrom :: forall a. Fractional a => a -> [a] @@ -9056,8 +9055,6 @@ module GHC.Real where numericEnumFromTo :: forall a. (GHC.Classes.Ord a, Fractional a) => a -> a -> [a] odd :: forall a. Integral a => a -> GHC.Types.Bool overflowError :: forall a. a - powImpl :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - powImplAcc :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a -> a ratioPrec :: GHC.Types.Int ratioPrec1 :: GHC.Types.Int ratioZeroDenominatorError :: forall a. a @@ -11309,6 +11306,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -11334,30 +11355,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -11371,6 +11368,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -11395,18 +11404,6 @@ instance GHC.Enum.Enum GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -6968,7 +6987,6 @@ module GHC.Float where castWord64ToDouble :: GHC.Word.Word64 -> Double ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b - clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int cosDouble :: Double -> Double cosFloat :: Float -> Float coshDouble :: Double -> Double @@ -6983,9 +7001,6 @@ module GHC.Float where expFloat :: Float -> Float expm1Double :: Double -> Double expm1Float :: Float -> Float - expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer - expts :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer - expts10 :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer fabsDouble :: Double -> Double fabsFloat :: Float -> Float float2Double :: Float -> Double @@ -6997,7 +7012,6 @@ module GHC.Float where formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Base.String fromRat :: forall a. RealFloat a => GHC.Real.Rational -> a fromRat' :: forall a. RealFloat a => GHC.Real.Rational -> a - fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a geDouble :: Double -> Double -> GHC.Types.Bool geFloat :: Float -> Float -> GHC.Types.Bool gtDouble :: Double -> Double -> GHC.Types.Bool @@ -7026,9 +7040,6 @@ module GHC.Float where logFloat :: Float -> Float ltDouble :: Double -> Double -> GHC.Types.Bool ltFloat :: Float -> Float -> GHC.Types.Bool - maxExpt :: GHC.Types.Int - maxExpt10 :: GHC.Types.Int - minExpt :: GHC.Types.Int minusDouble :: Double -> Double -> Double minusFloat :: Float -> Float -> Float naturalToDouble# :: GHC.Num.Natural.Natural -> Double# @@ -7037,8 +7048,6 @@ module GHC.Float where negateFloat :: Float -> Float plusDouble :: Double -> Double -> Double plusFloat :: Float -> Float -> Float - powerDouble :: Double -> Double -> Double - powerFloat :: Float -> Float -> Float properFractionDouble :: forall b. GHC.Real.Integral b => Double -> (b, Double) properFractionFloat :: forall b. GHC.Real.Integral b => Float -> (b, Float) rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double @@ -7055,10 +7064,6 @@ module GHC.Float where sinhFloat :: Float -> Float sqrtDouble :: Double -> Double sqrtFloat :: Float -> Float - stgDoubleToWord64 :: Double# -> GHC.Prim.Word64# - stgFloatToWord32 :: Float# -> GHC.Prim.Word32# - stgWord32ToFloat :: GHC.Prim.Word32# -> Float# - stgWord64ToDouble :: GHC.Prim.Word64# -> Double# tanDouble :: Double -> Double tanFloat :: Float -> Float tanhDouble :: Double -> Double @@ -7066,7 +7071,6 @@ module GHC.Float where timesDouble :: Double -> Double -> Double timesFloat :: Float -> Float -> Float truncateDouble :: forall b. GHC.Real.Integral b => Double -> b - truncateFloat :: forall b. GHC.Real.Integral b => Float -> b word2Double :: GHC.Types.Word -> Double word2Float :: GHC.Types.Word -> Float @@ -11780,8 +11784,6 @@ module GHC.Real where recip :: a -> a fromRational :: Rational -> a {-# MINIMAL fromRational, (recip | (/)) #-} - type FractionalExponentBase :: * - data FractionalExponentBase = Base2 | Base10 type Integral :: * -> Constraint class (Real a, GHC.Enum.Enum a) => Integral a where quot :: a -> a -> a @@ -11809,9 +11811,7 @@ module GHC.Real where floor :: forall b. Integral b => a -> b {-# MINIMAL properFraction #-} (^) :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - (^%^) :: forall a. Integral a => Rational -> a -> Rational (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a - (^^%^^) :: forall a. Integral a => Rational -> a -> Rational denominator :: forall a. Ratio a -> a divZeroError :: forall a. a even :: forall a. Integral a => a -> GHC.Types.Bool @@ -11825,7 +11825,6 @@ module GHC.Real where lcm :: forall a. Integral a => a -> a -> a mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational - mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational notANumber :: Rational numerator :: forall a. Ratio a -> a numericEnumFrom :: forall a. Fractional a => a -> [a] @@ -11834,8 +11833,6 @@ module GHC.Real where numericEnumFromTo :: forall a. (GHC.Classes.Ord a, Fractional a) => a -> a -> [a] odd :: forall a. Integral a => a -> GHC.Types.Bool overflowError :: forall a. a - powImpl :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - powImplAcc :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a -> a ratioPrec :: GHC.Types.Int ratioPrec1 :: GHC.Types.Int ratioZeroDenominatorError :: forall a. a @@ -14080,6 +14077,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -14105,30 +14126,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -14142,6 +14139,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -14166,18 +14175,6 @@ instance GHC.Enum.Enum GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -7148,7 +7167,6 @@ module GHC.Float where castWord64ToDouble :: GHC.Word.Word64 -> Double ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b - clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int cosDouble :: Double -> Double cosFloat :: Float -> Float coshDouble :: Double -> Double @@ -7163,9 +7181,6 @@ module GHC.Float where expFloat :: Float -> Float expm1Double :: Double -> Double expm1Float :: Float -> Float - expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer - expts :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer - expts10 :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer fabsDouble :: Double -> Double fabsFloat :: Float -> Float float2Double :: Float -> Double @@ -7177,7 +7192,6 @@ module GHC.Float where formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Base.String fromRat :: forall a. RealFloat a => GHC.Real.Rational -> a fromRat' :: forall a. RealFloat a => GHC.Real.Rational -> a - fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a geDouble :: Double -> Double -> GHC.Types.Bool geFloat :: Float -> Float -> GHC.Types.Bool gtDouble :: Double -> Double -> GHC.Types.Bool @@ -7206,9 +7220,6 @@ module GHC.Float where logFloat :: Float -> Float ltDouble :: Double -> Double -> GHC.Types.Bool ltFloat :: Float -> Float -> GHC.Types.Bool - maxExpt :: GHC.Types.Int - maxExpt10 :: GHC.Types.Int - minExpt :: GHC.Types.Int minusDouble :: Double -> Double -> Double minusFloat :: Float -> Float -> Float naturalToDouble# :: GHC.Num.Natural.Natural -> Double# @@ -7217,8 +7228,6 @@ module GHC.Float where negateFloat :: Float -> Float plusDouble :: Double -> Double -> Double plusFloat :: Float -> Float -> Float - powerDouble :: Double -> Double -> Double - powerFloat :: Float -> Float -> Float properFractionDouble :: forall b. GHC.Real.Integral b => Double -> (b, Double) properFractionFloat :: forall b. GHC.Real.Integral b => Float -> (b, Float) rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double @@ -7235,10 +7244,6 @@ module GHC.Float where sinhFloat :: Float -> Float sqrtDouble :: Double -> Double sqrtFloat :: Float -> Float - stgDoubleToWord64 :: Double# -> GHC.Prim.Word64# - stgFloatToWord32 :: Float# -> GHC.Prim.Word32# - stgWord32ToFloat :: GHC.Prim.Word32# -> Float# - stgWord64ToDouble :: GHC.Prim.Word64# -> Double# tanDouble :: Double -> Double tanFloat :: Float -> Float tanhDouble :: Double -> Double @@ -7246,7 +7251,6 @@ module GHC.Float where timesDouble :: Double -> Double -> Double timesFloat :: Float -> Float -> Float truncateDouble :: forall b. GHC.Real.Integral b => Double -> b - truncateFloat :: forall b. GHC.Real.Integral b => Float -> b word2Double :: GHC.Types.Word -> Double word2Float :: GHC.Types.Word -> Float @@ -9226,8 +9230,6 @@ module GHC.Real where recip :: a -> a fromRational :: Rational -> a {-# MINIMAL fromRational, (recip | (/)) #-} - type FractionalExponentBase :: * - data FractionalExponentBase = Base2 | Base10 type Integral :: * -> Constraint class (Real a, GHC.Enum.Enum a) => Integral a where quot :: a -> a -> a @@ -9255,9 +9257,7 @@ module GHC.Real where floor :: forall b. Integral b => a -> b {-# MINIMAL properFraction #-} (^) :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - (^%^) :: forall a. Integral a => Rational -> a -> Rational (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a - (^^%^^) :: forall a. Integral a => Rational -> a -> Rational denominator :: forall a. Ratio a -> a divZeroError :: forall a. a even :: forall a. Integral a => a -> GHC.Types.Bool @@ -9271,7 +9271,6 @@ module GHC.Real where lcm :: forall a. Integral a => a -> a -> a mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational - mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational notANumber :: Rational numerator :: forall a. Ratio a -> a numericEnumFrom :: forall a. Fractional a => a -> [a] @@ -9280,8 +9279,6 @@ module GHC.Real where numericEnumFromTo :: forall a. (GHC.Classes.Ord a, Fractional a) => a -> a -> [a] odd :: forall a. Integral a => a -> GHC.Types.Bool overflowError :: forall a. a - powImpl :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - powImplAcc :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a -> a ratioPrec :: GHC.Types.Int ratioPrec1 :: GHC.Types.Int ratioZeroDenominatorError :: forall a. a @@ -11577,6 +11574,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -11602,30 +11623,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -11639,6 +11636,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -11664,18 +11673,6 @@ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ instance GHC.Enum.Enum GHC.Event.Windows.ConsoleEvent.ConsoleEvent -- Defined in ‘GHC.Event.Windows.ConsoleEvent’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -906,6 +906,25 @@ module Data.Either where partitionEithers :: forall a b. [Either a b] -> ([a], [b]) rights :: forall a b. [Either a b] -> [b] +module Data.Enum where + -- Safety: Safe-Inferred + type Bounded :: * -> Constraint + class Bounded a where + minBound :: a + maxBound :: a + {-# MINIMAL minBound, maxBound #-} + type Enum :: * -> Constraint + class Enum a where + succ :: a -> a + pred :: a -> a + toEnum :: GHC.Types.Int -> a + fromEnum :: a -> GHC.Types.Int + enumFrom :: a -> [a] + enumFromThen :: a -> a -> [a] + enumFromTo :: a -> a -> [a] + enumFromThenTo :: a -> a -> a -> [a] + {-# MINIMAL toEnum, fromEnum #-} + module Data.Eq where -- Safety: Trustworthy type Eq :: * -> Constraint @@ -6999,7 +7018,6 @@ module GHC.Float where castWord64ToDouble :: GHC.Word.Word64 -> Double ceilingDouble :: forall b. GHC.Real.Integral b => Double -> b ceilingFloat :: forall b. GHC.Real.Integral b => Float -> b - clamp :: GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int cosDouble :: Double -> Double cosFloat :: Float -> Float coshDouble :: Double -> Double @@ -7014,9 +7032,6 @@ module GHC.Float where expFloat :: Float -> Float expm1Double :: Double -> Double expm1Float :: Float -> Float - expt :: GHC.Num.Integer.Integer -> GHC.Types.Int -> GHC.Num.Integer.Integer - expts :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer - expts10 :: GHC.Arr.Array GHC.Types.Int GHC.Num.Integer.Integer fabsDouble :: Double -> Double fabsFloat :: Float -> Float float2Double :: Float -> Double @@ -7028,7 +7043,6 @@ module GHC.Float where formatRealFloatAlt :: forall a. RealFloat a => FFFormat -> GHC.Maybe.Maybe GHC.Types.Int -> GHC.Types.Bool -> a -> GHC.Base.String fromRat :: forall a. RealFloat a => GHC.Real.Rational -> a fromRat' :: forall a. RealFloat a => GHC.Real.Rational -> a - fromRat'' :: forall a. RealFloat a => GHC.Types.Int -> GHC.Types.Int -> GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> a geDouble :: Double -> Double -> GHC.Types.Bool geFloat :: Float -> Float -> GHC.Types.Bool gtDouble :: Double -> Double -> GHC.Types.Bool @@ -7057,9 +7071,6 @@ module GHC.Float where logFloat :: Float -> Float ltDouble :: Double -> Double -> GHC.Types.Bool ltFloat :: Float -> Float -> GHC.Types.Bool - maxExpt :: GHC.Types.Int - maxExpt10 :: GHC.Types.Int - minExpt :: GHC.Types.Int minusDouble :: Double -> Double -> Double minusFloat :: Float -> Float -> Float naturalToDouble# :: GHC.Num.Natural.Natural -> Double# @@ -7068,8 +7079,6 @@ module GHC.Float where negateFloat :: Float -> Float plusDouble :: Double -> Double -> Double plusFloat :: Float -> Float -> Float - powerDouble :: Double -> Double -> Double - powerFloat :: Float -> Float -> Float properFractionDouble :: forall b. GHC.Real.Integral b => Double -> (b, Double) properFractionFloat :: forall b. GHC.Real.Integral b => Float -> (b, Float) rationalToDouble :: GHC.Num.Integer.Integer -> GHC.Num.Integer.Integer -> Double @@ -7086,10 +7095,6 @@ module GHC.Float where sinhFloat :: Float -> Float sqrtDouble :: Double -> Double sqrtFloat :: Float -> Float - stgDoubleToWord64 :: Double# -> GHC.Prim.Word64# - stgFloatToWord32 :: Float# -> GHC.Prim.Word32# - stgWord32ToFloat :: GHC.Prim.Word32# -> Float# - stgWord64ToDouble :: GHC.Prim.Word64# -> Double# tanDouble :: Double -> Double tanFloat :: Float -> Float tanhDouble :: Double -> Double @@ -7097,7 +7102,6 @@ module GHC.Float where timesDouble :: Double -> Double -> Double timesFloat :: Float -> Float -> Float truncateDouble :: forall b. GHC.Real.Integral b => Double -> b - truncateFloat :: forall b. GHC.Real.Integral b => Float -> b word2Double :: GHC.Types.Word -> Double word2Float :: GHC.Types.Word -> Float @@ -9006,8 +9010,6 @@ module GHC.Real where recip :: a -> a fromRational :: Rational -> a {-# MINIMAL fromRational, (recip | (/)) #-} - type FractionalExponentBase :: * - data FractionalExponentBase = Base2 | Base10 type Integral :: * -> Constraint class (Real a, GHC.Enum.Enum a) => Integral a where quot :: a -> a -> a @@ -9035,9 +9037,7 @@ module GHC.Real where floor :: forall b. Integral b => a -> b {-# MINIMAL properFraction #-} (^) :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - (^%^) :: forall a. Integral a => Rational -> a -> Rational (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a - (^^%^^) :: forall a. Integral a => Rational -> a -> Rational denominator :: forall a. Ratio a -> a divZeroError :: forall a. a even :: forall a. Integral a => a -> GHC.Types.Bool @@ -9051,7 +9051,6 @@ module GHC.Real where lcm :: forall a. Integral a => a -> a -> a mkRationalBase10 :: Rational -> GHC.Num.Integer.Integer -> Rational mkRationalBase2 :: Rational -> GHC.Num.Integer.Integer -> Rational - mkRationalWithExponentBase :: Rational -> GHC.Num.Integer.Integer -> FractionalExponentBase -> Rational notANumber :: Rational numerator :: forall a. Ratio a -> a numericEnumFrom :: forall a. Fractional a => a -> [a] @@ -9060,8 +9059,6 @@ module GHC.Real where numericEnumFromTo :: forall a. (GHC.Classes.Ord a, Fractional a) => a -> a -> [a] odd :: forall a. Integral a => a -> GHC.Types.Bool overflowError :: forall a. a - powImpl :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a - powImplAcc :: forall a b. (GHC.Num.Num a, Integral b) => a -> b -> a -> a ratioPrec :: GHC.Types.Int ratioPrec1 :: GHC.Types.Int ratioZeroDenominatorError :: forall a. a @@ -11313,6 +11310,30 @@ instance GHC.Enum.Bounded GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unico instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Bounded (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (t :: k). GHC.Enum.Bounded (Data.Proxy.Proxy t) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ +instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ +instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ +instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ +instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ +instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Bounded (f (g a)) => GHC.Enum.Bounded (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ instance GHC.Enum.Bounded GHC.Int.Int16 -- Defined in ‘GHC.Int’ @@ -11338,30 +11359,6 @@ instance GHC.Enum.Bounded GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Bounded Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Bounded Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Bounded GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Bounded GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Bounded a => GHC.Enum.Bounded (Solo a) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i j k l m n o. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i, GHC.Enum.Bounded j, GHC.Enum.Bounded k, GHC.Enum.Bounded l, GHC.Enum.Bounded m, GHC.Enum.Bounded n, GHC.Enum.Bounded o) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -- Defined in ‘GHC.Enum’ -instance forall a b. (GHC.Enum.Bounded a, GHC.Enum.Bounded b) => GHC.Enum.Bounded (a, b) -- Defined in ‘GHC.Enum’ -instance forall a b c. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c) => GHC.Enum.Bounded (a, b, c) -- Defined in ‘GHC.Enum’ -instance forall a b c d. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d) => GHC.Enum.Bounded (a, b, c, d) -- Defined in ‘GHC.Enum’ -instance forall a b c d e. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e) => GHC.Enum.Bounded (a, b, c, d, e) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f) => GHC.Enum.Bounded (a, b, c, d, e, f) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g) => GHC.Enum.Bounded (a, b, c, d, e, f, g) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h) -- Defined in ‘GHC.Enum’ -instance forall a b c d e f g h i. (GHC.Enum.Bounded a, GHC.Enum.Bounded b, GHC.Enum.Bounded c, GHC.Enum.Bounded d, GHC.Enum.Bounded e, GHC.Enum.Bounded f, GHC.Enum.Bounded g, GHC.Enum.Bounded h, GHC.Enum.Bounded i) => GHC.Enum.Bounded (a, b, c, d, e, f, g, h, i) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Bounded GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Bounded GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.DecidedStrictness -- Defined in ‘GHC.Generics’ instance GHC.Enum.Bounded GHC.Generics.SourceStrictness -- Defined in ‘GHC.Generics’ @@ -11375,6 +11372,18 @@ instance GHC.Enum.Enum GHC.Unicode.GeneralCategory -- Defined in ‘GHC.Unicode instance forall k (a :: k) (b :: k). (a ~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~: b) -- Defined in ‘Data.Type.Equality’ instance forall k1 k2 (a :: k1) (b :: k2). (a ~~ b) => GHC.Enum.Enum (a Data.Type.Equality.:~~: b) -- Defined in ‘Data.Type.Equality’ instance forall k (s :: k). GHC.Enum.Enum (Data.Proxy.Proxy s) -- Defined in ‘Data.Proxy’ +instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ +instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ +instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance forall k (a :: k). GHC.Enum.Enum (Data.Fixed.Fixed a) -- Defined in ‘Data.Fixed’ instance forall k1 k2 (f :: k1 -> *) (g :: k2 -> k1) (a :: k2). GHC.Enum.Enum (f (g a)) => GHC.Enum.Enum (Data.Functor.Compose.Compose f g a) -- Defined in ‘Data.Functor.Compose’ instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Data.Functor.Identity.Identity a) -- Defined in ‘Data.Functor.Identity’ @@ -11399,18 +11408,6 @@ instance GHC.Enum.Enum GHC.Word.Word8 -- Defined in ‘GHC.Word’ instance GHC.Enum.Enum Foreign.Ptr.IntPtr -- Defined in ‘Foreign.Ptr’ instance GHC.Enum.Enum Foreign.Ptr.WordPtr -- Defined in ‘Foreign.Ptr’ instance [safe] GHC.Enum.Enum GHC.ByteOrder.ByteOrder -- Defined in ‘GHC.ByteOrder’ -instance GHC.Enum.Enum GHC.Types.Bool -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Char -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Int -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Integer.Integer -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Levity -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Num.Natural.Natural -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Ordering -- Defined in ‘GHC.Enum’ -instance forall a. GHC.Enum.Enum a => GHC.Enum.Enum (Solo a) -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum () -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecCount -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.VecElem -- Defined in ‘GHC.Enum’ -instance GHC.Enum.Enum GHC.Types.Word -- Defined in ‘GHC.Enum’ instance GHC.Enum.Enum GHC.Types.Double -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Types.Float -- Defined in ‘GHC.Float’ instance GHC.Enum.Enum GHC.Generics.Associativity -- Defined in ‘GHC.Generics’ ===================================== testsuite/tests/parser/should_compile/T23315/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +T23315: clean + $(MAKE) clean + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build 1>&2 +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi ===================================== testsuite/tests/parser/should_compile/T23315/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file ===================================== testsuite/tests/parser/should_compile/T23315/T23315.cabal ===================================== @@ -0,0 +1,10 @@ +name: T23315 +version: 0.1.0.0 +build-type: Simple +cabal-version: 2.0 + +library + signatures: T23315 + build-depends: base >= 4.3 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -haddock -ddump-parsed-ast ===================================== testsuite/tests/parser/should_compile/T23315/T23315.hsig ===================================== @@ -0,0 +1,4 @@ +signature T23315 where +-- | My unit +a :: () +-- ^ More docs ===================================== testsuite/tests/parser/should_compile/T23315/T23315.stderr ===================================== @@ -0,0 +1,112 @@ + +==================== Parser AST ==================== + +(L + { T23315.hsig:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T23315.hsig:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 })) + ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))] + [] + (Nothing)) + (EpaComments + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 }) + {ModuleName: T23315})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 }) + (DocD + (NoExtField) + (DocCommentNext + (L + { T23315.hsig:2:1-12 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T23315.hsig:2:5-12 } + (HsDocStringChunk + " My unit")) + [])) + []))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T23315.hsig:3:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T23315.hsig:3:1-7 }) + (SigD + (NoExtField) + (TypeSig + (EpAnn + (Anchor + { T23315.hsig:3:1 } + (UnchangedAnchor)) + (AnnSig + (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 })) + []) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 }) + (Unqual + {OccName: a}))] + (HsWC + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsTupleTy + (EpAnn + (Anchor + { T23315.hsig:3:6 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T23315.hsig:3:6 }) + (EpaSpan { T23315.hsig:3:7 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 }) + (DocD + (NoExtField) + (DocCommentPrev + (L + { T23315.hsig:4:1-14 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringPrevious) + (:| + (L + { T23315.hsig:4:5-14 } + (HsDocStringChunk + " More docs")) + [])) + [])))))])) + + ===================================== testsuite/tests/parser/should_compile/T23315/all.T ===================================== @@ -0,0 +1,3 @@ +test('T23315', + [extra_files(['Setup.hs']), js_broken(22352)], + makefile_test, []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9be9b7e4d03c3de7bcb81597ac2a0fb93a58c040...dd16a902160a42d293c4399291bc5ab372dc3117 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9be9b7e4d03c3de7bcb81597ac2a0fb93a58c040...dd16a902160a42d293c4399291bc5ab372dc3117 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 15:49:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 11:49:50 -0400 Subject: [Git][ghc/ghc][wip/T23691] Apply 1 suggestion(s) to 1 file(s) Message-ID: <64baa91e92bce_19cb1a1af7442c3416ea@gitlab.mail> Ben Gamari pushed to branch wip/T23691 at Glasgow Haskell Compiler / GHC Commits: fc15f1da by Andreas Klebinger at 2023-07-21T15:49:48+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - rts/win32/ThrIOManager.c Changes: ===================================== rts/win32/ThrIOManager.c ===================================== @@ -79,8 +79,8 @@ readIOManagerEvent (void) } } } else { - // Making it here means that we have hit ioManagerDie, which - // closed our event object. + // Making it here after getIOManagerEvent has been called means that we + // have hit ioManagerDie, which closed our event object. res = IO_MANAGER_DIE; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc15f1da5a8739d7a4fe7391976bf01143dba919 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc15f1da5a8739d7a4fe7391976bf01143dba919 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 15:50:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 11:50:44 -0400 Subject: [Git][ghc/ghc][wip/T23210] 7 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64baa954a74ce_19cb1a1af74468344085@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - ba7a5753 by Ben Gamari at 2023-07-21T11:50:27-04:00 rts: Tighten up invariants of PACK - - - - - cc5ee991 by Ben Gamari at 2023-07-21T11:50:27-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 1fe4fc2b by Ben Gamari at 2023-07-21T11:50:27-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 35d666ae by Ben Gamari at 2023-07-21T11:50:27-04:00 testsuite: Mark MulMayOflo_full as req_cmm As it involves cmm compilation and can't currently be run in the ghci ways. - - - - - 18 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Parser.y - compiler/GHC/Stg/Utils.hs - compiler/GHC/StgToByteCode.hs - rts/Interpreter.c - rts/include/rts/storage/InfoTables.h - testsuite/tests/codeGen/should_run/T23146/all.T - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/parser/should_compile/T23315/Makefile - + testsuite/tests/parser/should_compile/T23315/Setup.hs - + testsuite/tests/parser/should_compile/T23315/T23315.cabal - + testsuite/tests/parser/should_compile/T23315/T23315.hsig - + testsuite/tests/parser/should_compile/T23315/T23315.stderr - + testsuite/tests/parser/should_compile/T23315/all.T - testsuite/tests/unlifted-datatypes/should_run/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -511,7 +511,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release+no_split_sections + - job: release-x86_64-windows-release optional: true tags: @@ -535,7 +535,7 @@ doc-tarball: || mv "ghc-x86_64-linux-deb10-release.tar.xz" "$LINUX_BINDIST" \ || true mv "ghc-x86_64-windows-validate.tar.xz" "$WINDOWS_BINDIST" \ - || mv "ghc-x86_64-windows-release+no_split_sections.tar.xz" "$WINDOWS_BINDIST" \ + || mv "ghc-x86_64-windows-release.tar.xz" "$WINDOWS_BINDIST" \ || true if [ ! -f "$LINUX_BINDIST" ]; then echo "Error: $LINUX_BINDIST does not exist. Did the Debian 9 job fail?" ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -921,8 +921,8 @@ job_groups = -- This job is only for generating head.hackage docs , hackage_doc_job (disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) releaseConfig)) , disableValidate (standardBuildsWithConfig Amd64 (Linux Fedora33) dwarf) - , fastCI (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken vanilla)) - , disableValidate (standardBuildsWithConfig Amd64 Windows (splitSectionsBroken nativeInt)) + , fastCI (standardBuildsWithConfig Amd64 Windows vanilla) + , disableValidate (standardBuildsWithConfig Amd64 Windows nativeInt) , standardBuilds Amd64 Darwin , allowFailureGroup (addValidateRule FreeBSDLabel (validateBuilds Amd64 FreeBSD13 vanilla)) , fastCI (standardBuilds AArch64 Darwin) ===================================== .gitlab/jobs.yaml ===================================== @@ -3577,7 +3577,7 @@ "XZ_OPT": "-9" } }, - "release-x86_64-windows-int_native-release+no_split_sections": { + "release-x86_64-windows-int_native-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3587,7 +3587,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-int_native-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3626,8 +3626,8 @@ ], "variables": { "BIGNUM_BACKEND": "native", - "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3636,11 +3636,11 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", + "TEST_ENV": "x86_64-windows-int_native-release", "XZ_OPT": "-9" } }, - "release-x86_64-windows-release+no_split_sections": { + "release-x86_64-windows-release": { "after_script": [ "bash .gitlab/ci.sh save_cache", "bash .gitlab/ci.sh save_test_output", @@ -3650,7 +3650,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-x86_64-windows-release+no_split_sections.tar.xz", + "ghc-x86_64-windows-release.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -3689,8 +3689,8 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-windows-release+no_split_sections", - "BUILD_FLAVOUR": "release+no_split_sections", + "BIN_DIST_NAME": "ghc-x86_64-windows-release", + "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", "CONFIGURE_ARGS": "", "GHC_VERSION": "9.4.3", @@ -3699,7 +3699,7 @@ "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", "RUNTEST_ARGS": "", - "TEST_ENV": "x86_64-windows-release+no_split_sections", + "TEST_ENV": "x86_64-windows-release", "XZ_OPT": "-9" } }, ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -245,6 +245,10 @@ pprGNUSectionHeader config t suffix = OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of + Text + | OSMinGW32 <- platformOS platform + -> text ",\"xr\"" + | otherwise -> text ",\"ax\"," <> sectionType platform "progbits" CString | OSMinGW32 <- platformOS platform -> empty ===================================== compiler/GHC/Parser.y ===================================== @@ -751,7 +751,7 @@ TH_QQUASIQUOTE { L _ (ITqQuasiQuote _) } -- Exported parsers %name parseModuleNoHaddock module -%name parseSignature signature +%name parseSignatureNoHaddock signature %name parseImport importdecl %name parseStatement e_stmt %name parseDeclaration topdecl @@ -4416,18 +4416,29 @@ pvL :: MonadP m => m (LocatedAn t a) -> m (Located a) pvL a = do { av <- a ; return (reLoc av) } --- | Parse a Haskell module with Haddock comments. --- This is done in two steps: +-- | Parse a Haskell module with Haddock comments. This is done in two steps: -- -- * 'parseModuleNoHaddock' to build the AST -- * 'addHaddockToModule' to insert Haddock comments into it -- --- This is the only parser entry point that deals with Haddock comments. --- The other entry points ('parseDeclaration', 'parseExpression', etc) do --- not insert them into the AST. +-- This and the signature module parser are the only parser entry points that +-- deal with Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule +-- | Parse a Haskell signature module with Haddock comments. This is done in two +-- steps: +-- +-- * 'parseSignatureNoHaddock' to build the AST +-- * 'addHaddockToModule' to insert Haddock comments into it +-- +-- This and the module parser are the only parser entry points that deal with +-- Haddock comments. The other entry points ('parseDeclaration', +-- 'parseExpression', etc) do not insert them into the AST. +parseSignature :: P (Located (HsModule GhcPs)) +parseSignature = parseSignatureNoHaddock >>= addHaddockToModule + commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -9,6 +9,7 @@ module GHC.Stg.Utils , idArgs , mkUnarisedId, mkUnarisedIds + , hasNoNonZeroWidthArgs ) where import GHC.Prelude @@ -16,6 +17,7 @@ import GHC.Prelude import GHC.Types.Id import GHC.Core.Type import GHC.Core.TyCon +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.DataCon import GHC.Core ( AltCon(..) ) import GHC.Types.Tickish @@ -31,6 +33,13 @@ import GHC.Utils.Panic import GHC.Data.FastString +-- | Returns whether there are any arguments with a non-zero-width runtime +-- representation. +-- +-- Returns True if the datacon has no or /just/ zero-width arguments. +hasNoNonZeroWidthArgs :: DataCon -> Bool +hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys + mkUnarisedIds :: MonadUnique m => FastString -> [UnaryType] -> m [Id] mkUnarisedIds fs tys = mapM (mkUnarisedId fs) tys ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1855,20 +1855,18 @@ pushAtom d p (StgVarArg var) -- PUSH_G doesn't tag constructors. So we use PACK here -- if we are dealing with nullary constructor. case isDataConWorkId_maybe var of - Just con -> do - massert (isNullaryRepDataCon con) - return (unitOL (PACK con 0), szb) + Just con + -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make. + | isNullaryRepDataCon con -> do + return (unitOL (PACK con 0), szb) - Nothing -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do - massert (idType var `eqType` addrPrimTy) + _ | idType var `eqType` addrPrimTy -> return (unitOL (PUSH_ADDR (getName var)), szb) | otherwise -> do return (unitOL (PUSH_G (getName var)), szb) - pushAtom _ _ (StgLitArg lit) = pushLiteral True lit pushLiteral :: Bool -> Literal -> BcM (BCInstrList, ByteOff) ===================================== rts/Interpreter.c ===================================== @@ -1674,23 +1674,28 @@ run_BCO: } case bci_PACK: { - W_ i; - W_ o_itbl = BCO_GET_LARGE_ARG; - W_ n_words = BCO_GET_LARGE_ARG; - StgInfoTable* itbl = INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl)); - int request = CONSTR_sizeW( itbl->layout.payload.ptrs, - itbl->layout.payload.nptrs ); + int o_itbl = BCO_GET_LARGE_ARG; + int n_words = BCO_GET_LARGE_ARG; + StgConInfoTable* itbl = CON_INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl)); + int n_ptrs = itbl->i.layout.payload.ptrs; + int n_nptrs = itbl->i.layout.payload.nptrs; + int request = CONSTR_sizeW( n_ptrs, n_nptrs ); StgClosure* con = (StgClosure*)allocate_NONUPD(cap,request); - ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0); - for (i = 0; i < n_words; i++) { + ASSERT(ip_HNF(&itbl->i)); // We don't have a CON flag, HNF is a good approximation + // N. + // N.B. we may have a nullary datacon with padding, in which case + // n_nptrs=1, n_ptrs=0. + ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0)); + ASSERT(n_ptrs + n_nptrs > 0); + for (int i = 0; i < n_words; i++) { con->payload[i] = (StgClosure*)SpW(i); } Sp_addW(n_words); Sp_subW(1); // No write barrier is needed here as this is a new allocation // visible only from our stack - StgInfoTable *con_itbl = (StgInfoTable*) BCO_LIT(o_itbl); - SET_HDR(con, con_itbl, cap->r.rCCCS); + StgInfoTable *con_ptr = (StgInfoTable*) BCO_LIT(o_itbl); + SET_HDR(con, con_ptr, cap->r.rCCCS); StgClosure* tagged_con = tagConstr(con); SpW(0) = (W_)tagged_con; ===================================== rts/include/rts/storage/InfoTables.h ===================================== @@ -86,7 +86,7 @@ extern const StgWord16 closure_flags[]; #define closure_IND(c) ( closureFlags(c) & _IND) /* same as above but for info-ptr rather than closure */ -#define ipFlags(ip) (closure_flags[ip->type]) +#define ipFlags(ip) (closure_flags[(ip)->type]) #define ip_HNF(ip) ( ipFlags(ip) & _HNF) #define ip_BITMAP(ip) ( ipFlags(ip) & _BTM) ===================================== testsuite/tests/codeGen/should_run/T23146/all.T ===================================== @@ -1,4 +1,4 @@ -test('T23146', expect_broken_for(23060, ghci_ways), compile_and_run, ['']) +test('T23146', normal, compile_and_run, ['']) test('T23146_lifted', normal, compile_and_run, ['']) test('T23146_liftedeq', expect_broken_for(23060, ghci_ways), compile_and_run, ['']) test('T23146_lifted_unlifted', normal, compile_and_run, ['']) ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -232,6 +232,7 @@ test('OrigThunkInfo', normal, compile_and_run, ['-forig-thunk-info']) # Note [MO_S_MulMayOflo significant width]) and may require fixing/adjustment. test('MulMayOflo_full', [ extra_files(['MulMayOflo.hs']), + req_cmm, when(unregisterised(), skip), unless(arch('x86_64') or arch('i386'), skip), ignore_stdout], ===================================== testsuite/tests/parser/should_compile/T23315/Makefile ===================================== @@ -0,0 +1,18 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP = ./Setup -v0 + +T23315: clean + $(MAKE) clean + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + $(SETUP) clean + $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' + $(SETUP) build 1>&2 +ifneq "$(CLEANUP)" "" + $(MAKE) clean +endif + +clean : + $(RM) -r */dist Setup$(exeext) *.o *.hi ===================================== testsuite/tests/parser/should_compile/T23315/Setup.hs ===================================== @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain \ No newline at end of file ===================================== testsuite/tests/parser/should_compile/T23315/T23315.cabal ===================================== @@ -0,0 +1,10 @@ +name: T23315 +version: 0.1.0.0 +build-type: Simple +cabal-version: 2.0 + +library + signatures: T23315 + build-depends: base >= 4.3 && < 5 + default-language: Haskell2010 + ghc-options: -Wall -haddock -ddump-parsed-ast ===================================== testsuite/tests/parser/should_compile/T23315/T23315.hsig ===================================== @@ -0,0 +1,4 @@ +signature T23315 where +-- | My unit +a :: () +-- ^ More docs ===================================== testsuite/tests/parser/should_compile/T23315/T23315.stderr ===================================== @@ -0,0 +1,112 @@ + +==================== Parser AST ==================== + +(L + { T23315.hsig:1:1 } + (HsModule + (XModulePs + (EpAnn + (Anchor + { T23315.hsig:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 })) + ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))] + [] + (Nothing)) + (EpaComments + [])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) + (Just + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:1:11-16 }) + {ModuleName: T23315})) + (Nothing) + [] + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:2:1-12 }) + (DocD + (NoExtField) + (DocCommentNext + (L + { T23315.hsig:2:1-12 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T23315.hsig:2:5-12 } + (HsDocStringChunk + " My unit")) + [])) + []))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T23315.hsig:3:1-7 } + (UnchangedAnchor)) + (AnnListItem + []) + (EpaComments + [])) { T23315.hsig:3:1-7 }) + (SigD + (NoExtField) + (TypeSig + (EpAnn + (Anchor + { T23315.hsig:3:1 } + (UnchangedAnchor)) + (AnnSig + (AddEpAnn AnnDcolon (EpaSpan { T23315.hsig:3:3-4 })) + []) + (EpaComments + [])) + [(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:1 }) + (Unqual + {OccName: a}))] + (HsWC + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + (L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:3:6-7 }) + (HsTupleTy + (EpAnn + (Anchor + { T23315.hsig:3:6 } + (UnchangedAnchor)) + (AnnParen + (AnnParens) + (EpaSpan { T23315.hsig:3:6 }) + (EpaSpan { T23315.hsig:3:7 })) + (EpaComments + [])) + (HsBoxedOrConstraintTuple) + [])))))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T23315.hsig:4:1-14 }) + (DocD + (NoExtField) + (DocCommentPrev + (L + { T23315.hsig:4:1-14 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringPrevious) + (:| + (L + { T23315.hsig:4:5-14 } + (HsDocStringChunk + " More docs")) + [])) + [])))))])) + + ===================================== testsuite/tests/parser/should_compile/T23315/all.T ===================================== @@ -0,0 +1,3 @@ +test('T23315', + [extra_files(['Setup.hs']), js_broken(22352)], + makefile_test, []) ===================================== testsuite/tests/unlifted-datatypes/should_run/all.T ===================================== @@ -1,3 +1,3 @@ test('UnlData1', normal, compile_and_run, ['']) -test('UnlGadt1', [exit_code(1), expect_broken_for(23060, ghci_ways)], compile_and_run, ['']) +test('UnlGadt1', exit_code(1), compile_and_run, ['']) test('T23549', normal, multimod_compile_and_run, ['T23549', '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b5d727194b3bc27da10f4d163b8125bda5a192d...35d666aedd9b70d3d6452cb6efb11be56fffa715 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5b5d727194b3bc27da10f4d163b8125bda5a192d...35d666aedd9b70d3d6452cb6efb11be56fffa715 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 15:51:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 11:51:20 -0400 Subject: [Git][ghc/ghc][wip/T23691] 30 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64baa978a7fc3_19cb1a1af6ff1c3471c3@gitlab.mail> Ben Gamari pushed to branch wip/T23691 at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 1b769e1a by Ben Gamari at 2023-07-21T11:51:12-04:00 rts/win32: Ensure reliability of IO manager shutdown When the Win32 threaded IO manager shuts down, `ioManagerDie` sends an `IO_MANAGER_DIE` event to the IO manager thread using the `io_manager_event` event object. Finally, it will closes the event object, and invalidate `io_manager_event`. Previously, `readIOManagerEvent` would see that `io_manager_event` is invalid and return `0`, suggesting that everything is right with the world. This meant that if `ioManagerDie` invalidated the handle before the event manager was blocked on the event we would end up in a situation where the event manager would never realize it was asked to shut down. Fix this by ensuring that `readIOManagerEvent` instead returns `IO_MANAGER_DIE` when we detect that the event object has been invalidated by `ioManagerDie`. Fixes #23691. - - - - - 29 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc15f1da5a8739d7a4fe7391976bf01143dba919...1b769e1af03880686b4a21408e04ec73a97c8a97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc15f1da5a8739d7a4fe7391976bf01143dba919...1b769e1af03880686b4a21408e04ec73a97c8a97 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 15:52:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 11:52:48 -0400 Subject: [Git][ghc/ghc][wip/T23554] 77 commits: Drop circle-ci-job.sh Message-ID: <64baa9d0b1cc3_19cb1a1af7446835132b@gitlab.mail> Ben Gamari pushed to branch wip/T23554 at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - afa12496 by Ben Gamari at 2023-07-21T11:52:41-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 12 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7136ec6b08c745460da3a04db03476792d5f8d54...afa124964e176db1d547d28f952bc86c63214395 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7136ec6b08c745460da3a04db03476792d5f8d54...afa124964e176db1d547d28f952bc86c63214395 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 15:57:38 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 21 Jul 2023 11:57:38 -0400 Subject: [Git][ghc/ghc][wip/T22404] More performance tuning Message-ID: <64baaaf22f915_19cb1a1afa660c35151d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 92f05b6c by Simon Peyton Jones at 2023-07-21T16:57:14+01:00 More performance tuning - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -cpp -Wno-incomplete-record-updates #-} +{-# OPTIONS_GHC -cpp -Wno-incomplete-record-updates -fmax-worker-args=12 #-} {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -34,7 +34,7 @@ import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) -import GHC.Data.Maybe( isJust, isNothing, orElse ) +import GHC.Data.Maybe( isJust, orElse ) import GHC.Data.Graph.Directed ( SCC(..), Node(..) , stronglyConnCompFromEdgedVerticesUniq , stronglyConnCompFromEdgedVerticesUniqR ) @@ -59,8 +59,6 @@ import GHC.Builtin.Names( runRWKey ) import GHC.Unit.Module( Module ) import Data.List (mapAccumL) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE {- ************************************************************************ @@ -964,14 +962,14 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- Now analyse the body, adding the join point -- into the environment with addJoinPoint - !(WUD body_uds (tagged_bndr, body)) - = occAnalNonRecBody env NotTopLevel bndr' $ \env -> - thing_inside (addJoinPoint env bndr' rhs_uds) + !(WUD body_uds (occ, body)) = occAnalNonRecBody env bndr' $ \env -> + thing_inside (addJoinPoint env bndr' rhs_uds) in - if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] + if isDeadOcc occ -- Drop dead code; see Note [Dead code] then WUD body_uds body else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` - (combine [NonRec tagged_bndr rhs'] body) + (combine [NonRec (tagNonRecBinder lvl occ bndr') rhs'] + body) {- -- Fast path for top level, non-recursive bindings, with no rules @@ -983,7 +981,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- * No rules so no faffing with them | TopLevel <- lvl , not (idHasRules bndr || (bndr `elemVarEnv` ire)) - = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside + = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env bndr thing_inside in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] then WUD body_uds body else let @@ -1003,14 +1001,15 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- The normal case, including newly-discovered join points -- Analyse the body and /then/ the RHS | otherwise - = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env lvl bndr thing_inside - in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] + = let !(WUD body_uds (occ,body)) = occAnalNonRecBody env bndr thing_inside + in if isDeadOcc occ -- Drop dead code; see Note [Dead code] then WUD body_uds body else let -- Get the join info from the *new* decision; NB: bndr is not already a JoinId -- See Note [Join points and unfoldings/rules] -- => join arity O of Note [Join arity prediction based on joinRhsArity] - mb_join = case tailCallInfo (idOccInfo tagged_bndr) of + tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join = case tailCallInfo occ of AlwaysTailCalled arity -> Just arity _ -> Nothing @@ -1019,16 +1018,14 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine (combine [NonRec final_bndr rhs'] body) ----------------- -occAnalNonRecBody :: OccEnv -> TopLevelFlag -> Id +occAnalNonRecBody :: OccEnv -> Id -> (OccEnv -> WithUsageDetails r) -- Scope of the bind - -> (WithUsageDetails (Id, r)) -{-# INLINE occAnalNonRecBody #-} --- INLINE: it's small and higher order, just a macro really -occAnalNonRecBody env lvl bndr thing_inside + -> (WithUsageDetails (OccInfo, r)) +occAnalNonRecBody env bndr thing_inside = addInScope env [bndr] $ \env -> let !(WUD inner_uds res) = thing_inside env - tagged_bndr = tagNonRecBinder lvl inner_uds bndr - in WUD inner_uds (tagged_bndr, res) + !occ = lookupLetDetails inner_uds bndr + in WUD inner_uds (occ, res) ----------------- occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity @@ -1114,54 +1111,55 @@ occAnalRecBind !rhs_env lvl imp_rule_edges pairs body_usage = foldr (occAnalRec rhs_env lvl) (WUD body_usage []) sccs where sccs :: [SCC NodeDetails] - sccs = {-# SCC "occAnalBind.scc" #-} - stronglyConnCompFromEdgedVerticesUniq nodes + sccs = stronglyConnCompFromEdgedVerticesUniq nodes nodes :: [LetrecNode] - nodes = {-# SCC "occAnalBind.assoc" #-} - map (makeNode rhs_env imp_rule_edges bndr_set) pairs + nodes = map (makeNode rhs_env imp_rule_edges bndr_set) pairs bndrs = map fst pairs bndr_set = mkVarSet bndrs -bindersOfSCC :: SCC NodeDetails -> [Var] -bindersOfSCC (AcyclicSCC nd) = [nd_bndr nd] -bindersOfSCC (CyclicSCC ds) = map nd_bndr ds - ----------------------------- occAnalRec :: OccEnv -> TopLevelFlag -> SCC NodeDetails -> WithUsageDetails [CoreBind] -> WithUsageDetails [CoreBind] --- Check for Note [Dead code] --- NB: Only look at body_uds, ignoring uses in the SCC -occAnalRec !_ _ scc (WUD body_uds binds) - | not (any (`usedIn` body_uds) (bindersOfSCC scc)) - = WUD body_uds binds - -- The NonRec case is just like a Let (NonRec ...) above occAnalRec !_ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds })) (WUD body_uds binds) - = WUD (body_uds `andUDs` rhs_uds') - (NonRec bndr' rhs' : binds) + | isDeadOcc occ -- Check for dead code: see Note [Dead code] + = WUD body_uds binds + | otherwise + = let tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join_arity = willBeJoinId_maybe tagged_bndr + !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join_arity wtuds + !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) + !bndr' = tagged_bndr `setIdUnfolding` unf' + in WUD (body_uds `andUDs` rhs_uds') + (NonRec bndr' rhs' : binds) where - tagged_bndr = tagNonRecBinder lvl body_uds bndr - mb_join_arity = willBeJoinId_maybe tagged_bndr - WUD rhs_uds' rhs' = adjustNonRecRhs mb_join_arity wtuds - !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) - !bndr' = tagged_bndr `setIdUnfolding` unf' + occ = lookupLetDetails body_uds bndr -- The Rec case is the interesting one -- See Note [Recursive bindings: the grand plan] -- See Note [Loop breaking] occAnalRec env lvl (CyclicSCC details_s) (WUD body_uds binds) - = -- pprTrace "occAnalRec" (ppr loop_breaker_nodes) - WUD final_uds (Rec pairs : binds) + | not (any needed details_s) + = -- Check for dead code: see Note [Dead code] + -- NB: Only look at body_uds, ignoring uses in the SCC + WUD body_uds binds + + | otherwise + = WUD final_uds (Rec pairs : binds) where all_simple = all nd_simple details_s + needed :: NodeDetails -> Bool + needed (ND { nd_bndr = bndr }) = isExportedId bndr || bndr `elemVarEnv` body_env + body_env = ud_env body_uds + ------------------------------ -- Make the nodes for the loop-breaker analysis -- See Note [Choosing loop breakers] for loop_breaker_nodes @@ -2807,10 +2805,11 @@ data OccEnv -- Usage details of the RHS of in-scope non-recursive join points -- See Note [Occurrence analysis for join points] - , occ_join_points :: !(IdEnv OccInfoEnv) + , occ_join_points :: !JoinPointInfo -- Invariant: no Id maps to emptyDetails } +type JoinPointInfo = IdEnv OccInfoEnv ----------------------------- -- OccEncl is used to control whether to inline into constructor arguments @@ -2918,30 +2917,34 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a --- Needed for all Vars not just Ids; a TyVar might have a CoVars in its kind -addInScope env@(OccEnv { occ_join_points = join_points }) - bndrs thing_inside - | not bad_joins - = -- No shadowing here; fast path for this common case - del_bndrs_from_uds $ - thing_inside $ - drop_shadowed_swaps $ - env - - | otherwise -- Shadowing! Lots of things to do - = add_bad_joins $ - del_bndrs_from_uds $ - thing_inside $ - drop_shadowed_swaps $ - drop_shadowed_joins $ - env - +{-# INLINE addInScope #-} +-- This function is called a lot, so we want to inline the fast path +addInScope env bndrs thing_inside + = WUD uds' res where - bndr_set :: UniqSet Var - bndr_set = mkVarSet bndrs + bndr_set = mkVarSet bndrs + !(env', bad_joins) = preprocess_env env bndr_set + !(WUD uds res) = thing_inside env' + uds' = postprocess_uds bndr_set bad_joins uds + +preprocess_env :: OccEnv -> VarSet -> (OccEnv, JoinPointInfo) +preprocess_env env@(OccEnv { occ_join_points = join_points + , occ_bs_rng = bs_rng_vars }) + bndr_set + | bad_joins = (drop_shadowed_swaps (drop_shadowed_joins env), join_points) + | otherwise = (drop_shadowed_swaps env, emptyVarEnv) + where + drop_shadowed_swaps :: OccEnv -> OccEnv + -- See Note [The binder-swap substitution] (BS3) + drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env }) + | bs_rng_vars `intersectsVarSet` bndr_set + = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } + | otherwise + = env { occ_bs_env = swap_env `minusUFM` bndr_fm } - bndr_fm :: UniqFM Var Var - bndr_fm = getUniqSet bndr_set + drop_shadowed_joins :: OccEnv -> OccEnv + -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) + drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } -- bad_joins is true if it would be wrong to push occ_join_points inwards -- (a) `bndrs` includes any of the occ_join_points @@ -2949,48 +2952,35 @@ addInScope env@(OccEnv { occ_join_points = join_points }) bad_joins :: Bool bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set + is_bad :: Unique -> OccInfoEnv -> Bool -> Bool is_bad uniq join_uds rest = uniq `elemUniqSet_Directly` bndr_set || not (bndr_fm `disjointUFM` join_uds) || rest - drop_shadowed_swaps :: OccEnv -> OccEnv - -- See Note [The binder-swap substitution] (BS3) - drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = bs_rng_vars }) - | bs_rng_vars `disjointUniqSets` bndr_set - = env { occ_bs_env = swap_env `minusUFM` bndr_fm } - | otherwise - = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - - drop_shadowed_joins :: OccEnv -> OccEnv - -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) - drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } - - del_bndrs_from_uds :: WithUsageDetails a -> WithUsageDetails a - -- Remove usage for bndrs - -- Add usage info for CoVars used in the types of bndrs - del_bndrs_from_uds (WUD uds res) = WUD (uds `delDetails` bndr_fm) res - - add_bad_joins :: WithUsageDetails a -> WithUsageDetails a +postprocess_uds :: VarSet -> JoinPointInfo -> UsageDetails -> UsageDetails +postprocess_uds bndr_set bad_joins uds + = add_bad_joins (delBndrsFromUDs bndr_set uds) + where + add_bad_joins :: UsageDetails -> UsageDetails -- Add usage info for occ_join_points that we cannot push inwardsa -- because of shadowing -- See Note [Occurrence analysis for join points] wrinkle (W2) - add_bad_joins wuds@(WUD body_uds res) - | isEmptyVarEnv bad_joins = wuds -- Fast path for common case - | otherwise = WUD (modifyUDEnv extend_with_bad_joins body_uds) res - where - bad_joins :: IdEnv OccInfoEnv - bad_joins = join_points -- All of them, for simplicity - - extend_with_bad_joins :: OccInfoEnv -> OccInfoEnv - extend_with_bad_joins env - = nonDetStrictFoldUFM_Directly add_bad_join env bad_joins - - add_bad_join :: Unique -> OccInfoEnv -> OccInfoEnv -> OccInfoEnv - add_bad_join uniq join_env env - | uniq `elemVarEnvByKey` env = env `plusVarEnv` join_env - | otherwise = env + add_bad_joins uds + | isEmptyVarEnv bad_joins = uds + | otherwise = modifyUDEnv extend_with_bad_joins uds + + extend_with_bad_joins :: OccInfoEnv -> OccInfoEnv + extend_with_bad_joins env + = nonDetStrictFoldUFM_Directly add_bad_join env bad_joins + + add_bad_join :: Unique -> OccInfoEnv -> OccInfoEnv -> OccInfoEnv + add_bad_join uniq join_env env + | uniq `elemVarEnvByKey` env = env `plusVarEnv` join_env + | otherwise = env addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv addJoinPoint env bndr rhs_uds @@ -3557,16 +3547,17 @@ emptyDetails = UD { ud_env = emptyVarEnv isEmptyDetails :: UsageDetails -> Bool isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env -delDetails :: UsageDetails -> UniqFM Var a -> UsageDetails +delBndrsFromUDs :: VarSet -> UsageDetails -> UsageDetails -- Delete these binders from the UsageDetails -delDetails (UD { ud_env = env - , ud_z_many = z_many - , ud_z_in_lam = z_in_lam - , ud_z_tail = z_tail }) bndr_fm +delBndrsFromUDs bndr_set (UD { ud_env = env, ud_z_many = z_many + , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail }) = UD { ud_env = env `minusUFM` bndr_fm , ud_z_many = z_many `minusUFM` bndr_fm , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm , ud_z_tail = z_tail `minusUFM` bndr_fm } + where + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails @@ -3583,9 +3574,6 @@ markAllInsideLamIf False ud = ud markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud -lookupLocalDetails :: UsageDetails -> Id -> Maybe LocalOcc -lookupLocalDetails (UD { ud_env = env }) id = lookupVarEnv env id - lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo lookupTailCallInfo uds id | UD { ud_z_tail = z_tail, ud_env = env } <- uds @@ -3595,14 +3583,6 @@ lookupTailCallInfo uds id | otherwise = NoTailCallInfo -lookupDetails :: UsageDetails -> Id -> OccInfo -lookupDetails ud id = mkOccInfoByUnique ud (idUnique id) - -usedIn :: Id -> UsageDetails -> Bool -v `usedIn` uds - | isExportedId v = True - | otherwise = v `elemVarEnv` ud_env uds - udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds udFreeVars bndrs (UD { ud_env = env }) = restrictFreeVars bndrs env @@ -3627,6 +3607,18 @@ combineUsageDetailsWith plus_occ_info , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 , ud_z_tail = plusVarEnv z_tail1 z_tail2 } +lookupLetDetails :: UsageDetails -> Id -> OccInfo +-- Don't use locally-generated occ_info for exported (visible-elsewhere) +-- things. Instead just give noOccInfo. +-- NB: setBinderOcc will (rightly) erase any LoopBreaker info; +-- we are about to re-generate it and it shouldn't be "sticky" +lookupLetDetails ud id + | isExportedId id = noOccInfo + | otherwise = mkOccInfoByUnique ud (idUnique id) + +lookupDetails :: UsageDetails -> Id -> OccInfo +lookupDetails ud id = mkOccInfoByUnique ud (idUnique id) + mkOccInfoByUnique :: UsageDetails -> Unique -> OccInfo mkOccInfoByUnique (UD { ud_env = env , ud_z_many = z_many @@ -3740,19 +3732,18 @@ tagLamBinder usage bndr occ = lookupDetails usage bndr tagNonRecBinder :: TopLevelFlag -- At top level? - -> UsageDetails -- Of scope + -> OccInfo -- Of scope -> CoreBndr -- Binder -> IdWithOccInfo -- Tagged binder -- No-op on TyVars - -tagNonRecBinder lvl usage binder - = setBinderOcc occ' binder +-- Precondition: OccInfo is not IAmDead +tagNonRecBinder lvl occ bndr + = setBinderOcc occ' bndr where - occ = lookupDetails usage binder - will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) + will_be_join = okForJoinPoint lvl bndr (tailCallInfo occ) occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless -- it was a join point before but is now dead - assert (isAlwaysTailCalled occ || isDeadOcc occ) occ + warnPprTrace (not (isAlwaysTailCalled occ)) "tagNonRecBinder" (ppr bndr <+> ppr occ) occ | otherwise = markNonTail occ tagRecBinders :: TopLevelFlag -- At top level? @@ -3775,8 +3766,7 @@ tagRecBinders lvl body_uds details_s test_manifest_arity ND{nd_rhs = WTUD tuds rhs} = adjustTailArity (Just (joinRhsArity rhs)) tuds - bndr_ne = expectNonEmpty "List of binders is never empty" bndrs - will_be_joins = decideJoinPointHood lvl unadj_uds bndr_ne + will_be_joins = decideRecJoinPointHood lvl unadj_uds bndrs mb_join_arity :: Id -> Maybe JoinArity -- mb_join_arity: See Note [Join arity prediction based on joinRhsArity] @@ -3801,7 +3791,7 @@ tagRecBinders lvl body_uds details_s adj_uds = foldr andUDs body_uds rhs_udss' -- 4. Tag each binder with its adjusted details - bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr + bndrs' = [ setBinderOcc (lookupLetDetails adj_uds bndr) bndr | bndr <- bndrs ] in @@ -3809,18 +3799,9 @@ tagRecBinders lvl body_uds details_s setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr setBinderOcc occ_info bndr - | isTyVar bndr = bndr - | isNoOccInfo occ_info = zap_it - | isExportedId bndr = zap_it - -- Don't use occ_info (locally-generated) for visible-elsewhere things - -- BUT *do* erase any IAmALoopBreaker annotation, because we're - -- about to re-generate it and it shouldn't be "sticky" - | otherwise = setIdOccInfo bndr occ_info - - where - bndr_info = idOccInfo bndr - zap_it | isNoOccInfo bndr_info = bndr - | otherwise = setIdOccInfo bndr noOccInfo + | isTyVar bndr = bndr + | occ_info == idOccInfo bndr = bndr + | otherwise = setIdOccInfo bndr occ_info -- | Decide whether some bindings should be made into join points or not, based -- on its occurrences. This is @@ -3834,48 +3815,47 @@ setBinderOcc occ_info bndr -- 'f' tail-calls 'g'. -- -- See Note [Invariants on join points] in "GHC.Core". -decideJoinPointHood :: TopLevelFlag -> UsageDetails - -> NonEmpty CoreBndr - -> Bool -decideJoinPointHood TopLevel _ _ - = False - -decideJoinPointHood NotTopLevel usage bndrs - | isJoinId bndr1 - = warnPprTrace lost_join_point - "OccurAnal failed to rediscover join point(s)" - lost_join_doc - all_ok --- = assertPpr (not lost_join_point) (ppr bndrs) --- True - - | otherwise - = all_ok +decideRecJoinPointHood :: TopLevelFlag -> UsageDetails + -> [CoreBndr] -> Bool +decideRecJoinPointHood lvl usage bndrs + = all ok bndrs -- Invariant 3: Either all are join points or none are where - bndr1 = NE.head bndrs + ok bndr = okForJoinPoint lvl bndr (lookupTailCallInfo usage bndr) +okForJoinPoint :: TopLevelFlag -> Id -> TailCallInfo -> Bool -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. - all_ok = -- Invariant 3: Either all are join points or none are - all ok bndrs - - ok bndr - | -- Invariant 1: Only tail calls, all same join arity - AlwaysTailCalled arity <- lookupTailCallInfo usage bndr +okForJoinPoint lvl bndr tail_call_info + | isJoinId bndr -- A current join point should still be one! + = warnPprTrace lost_join "Lost join point" lost_join_doc $ + True + | valid_join + = True + | otherwise + = False + where + valid_join | NotTopLevel <- lvl + , AlwaysTailCalled arity <- tail_call_info - , -- Invariant 1 as applied to LHSes of rules - all (ok_rule arity) (idCoreRules bndr) + , -- Invariant 1 as applied to LHSes of rules + all (ok_rule arity) (idCoreRules bndr) - -- Invariant 2a: stable unfoldings - -- See Note [Join points and INLINE pragmas] - , ok_unfolding arity (realIdUnfolding bndr) + -- Invariant 2a: stable unfoldings + -- See Note [Join points and INLINE pragmas] + , ok_unfolding arity (realIdUnfolding bndr) - -- Invariant 4: Satisfies polymorphism rule - , isValidJoinPointType arity (idType bndr) - = True + -- Invariant 4: Satisfies polymorphism rule + , isValidJoinPointType arity (idType bndr) + = True + | otherwise + = False - | otherwise - = False + lost_join | Just ja <- isJoinId_maybe bndr + = not valid_join || + (case tail_call_info of -- Valid join but arity differs + AlwaysTailCalled ja' -> ja /= ja' + _ -> False) + | otherwise = False ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans ok_rule join_arity (Rule { ru_args = args }) @@ -3891,23 +3871,15 @@ decideJoinPointHood NotTopLevel usage bndrs ok_unfolding _ _ = True - lost_join_point :: Bool - lost_join_point - | isNothing (lookupLocalDetails usage bndr1) = False -- Dead - | all_ok = False - | otherwise = True - lost_join_doc - = vcat [ text "bndrs:" <+> ppr bndrs - , text "occ:" <+> ppr (lookupDetails usage bndr1) - , text "arity:" <+> ppr arity - , text "rules:" <+> ppr (idCoreRules bndr1) - , text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr1)) - , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr1)) ] - where - arity = case lookupTailCallInfo usage bndr1 of - AlwaysTailCalled ar -> ar - NoTailCallInfo -> 0 + = vcat [ text "bndr:" <+> ppr bndr + , text "tc:" <+> ppr tail_call_info + , text "rules:" <+> ppr (idCoreRules bndr) + , case tail_call_info of + AlwaysTailCalled arity -> + vcat [ text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr)) + , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr)) ] + _ -> empty ] willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity willBeJoinId_maybe bndr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92f05b6c47300c1c9a30c517d187b4200849ee6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92f05b6c47300c1c9a30c517d187b4200849ee6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 16:19:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 21 Jul 2023 12:19:20 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] Further docs from Simon Message-ID: <64bab008c5d1b_19cb1a1af744683520d4@gitlab.mail> Simon Peyton Jones pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 0f660202 by Simon Peyton Jones at 2023-07-21T17:18:54+01:00 Further docs from Simon - - - - - 5 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -955,48 +955,46 @@ Syntax of types Syntax of applications in HsExpr -------------------------------- -* We represent applications like this (ignoring parameterisation) - data HsExpr = HsApp HsExpr HsExpr -- (f True) plain function application) - | HsTyApp HsExpr HsType -- (f @True) function application with `@`) - | HsEmbType HsType -- (type ty) embed a type into an expression with `type`) +* We represent type applications in HsExpr like this (ignoring parameterisation) + data HsExpr = HsApp HsExpr HsExpr -- (f True) plain function application) + | HsAppType HsExpr HsType -- (f @True) function application with `@`) + | HsEmbType HsType -- (type ty) embed a type into an expression with `type`) + | ... -* The HsAppType constructor is only used for Specified type variables - f @True -- only valid for f :: forall a. t +* So (f @ty) is represented, just as you might expect: + HsAppType f ty -* The HsApp constructor without HsEmbTy is used with ordinary function application - and with Required type variables - f True -- valid for f :: Bool -> t - -- and f :: forall (a :: Bool) -> t (NB. not implemented) +* But (f (type ty)) is represented by: + HsApp f (HsEmbType ty) -* The HsApp constructor with an HsEmbTy argument is only used - with Required type variables - f (type True) -- valid for f :: forall (a :: Bool) -> t + Why the difference? Because we /also/ need to express these /nested/ uses of `type`: - The HsEmbTy node can occur nested inside a larger type argument, - or even multiple times g (Maybe (type Int)) -- valid for g :: forall (a :: Type) -> t (NB. not implemented) g (Either (type Int) (type Bool)) -- valid for g :: forall (a :: Type) -> t (NB. not implemented) - This nesting makes `type` rather different from `@`. - The HsEmbTy mainly just switches name-space, and affects the term-to-type transformation. + This nesting makes `type` rather different from `@`. Remember, the HsEmbTy mainly just + switches name-space, and affects the term-to-type transformation. Syntax of abstractions in Pat ----------------------------- -similary... +* Type patterns are represented in HsPat roughly like this + data HsPat = ConPat ConLike [HsTyPat] [HsPat] + | EmbPat HsTyPat + | ... + data HsTyPat = HsTP LHsType + (In ConPat, the type and term arguments are actually inside HsConPatDetails.) + * Similar to HsTypeApp in HsExpr, the [HsTyPat] in ConPat is used just for @ty arguments + * Similar to HsEmbType in HsSxpr, EmbPat lets you embed a type in a pattern -data HsPat = ConPat [HsTyPat] [HsPat] - - | EmbPat HsTyPat - -* Type abstractions are represented with the following constructors +* Examples: \ (MkT @a (x :: a)) -> rhs -- ConPat (c.o. Pat) and HsConPatTyArg (c.o. HsConPatTyArg) \ (type a) (x :: a) -> rhs -- EmbTyPat (c.o. Pat) \ a (x :: a) -> rhs -- VarPat (c.o. Pat) (NB. not implemented) \ @a (x :: a) -> rhs -- to be decided (NB. not implemented) -* The type pattern itself is not necessarily a plain variable. At the very least, - we support kind signatures and wildcards: +* A HsTyPat is not necessarily a plain variable. At the very least, +l we support kind signatures and wildcards: \ (type _) -> rhs \ (type (b :: Bool)) -> rhs \ (type (_ :: Bool)) -> rhs @@ -1004,8 +1002,6 @@ data HsPat = ConPat [HsTyPat] [HsPat] \ (P @(a -> Either b c)) -> rhs All these forms are represented with HsTP (c.o. HsTyPat). - - Renaming type applications -------------------------- rnExpr delegates renaming of type arguments to rnHsWcType if possible: @@ -1014,13 +1010,11 @@ rnExpr delegates renaming of type arguments to rnHsWcType if possible: But what about: f t -- HsApp, no HsEmbTy (NB. not implemented) -Is `t` a term argument or a type argument? This depends on f's type - f :: A -> B -- t is a term argument - f :: forall (a :: A) -> B -- t is a type argument -But we don't want types to affect name resolution (Lexical Scoping Principle). -So we always rename `t` as a term using a recursive call to rnExpr. -The idea is to convert it to a type argument later. The details are spelled out -in the "Resolved Syntax Tree" and "T2T-Mapping" sections of GHC Proposal #281. +We simply rename `t` as a term using a recursive call to rnExpr; in particular, +the type of `f` does not affect name resolution (Lexical Scoping Principle). We +will later convert `t` from a `HsExpr` to a `Type` --- see "Typechecking type +applications" later in this Note. The details are spelled out in the "Resolved +Syntax Tree" and "T2T-Mapping" sections of GHC Proposal #281. Renaming type abstractions -------------------------- @@ -1032,8 +1026,9 @@ But what about: f t = rhs -- VarPat The solution is as before (see previous section), mutatis mutandis. Rename `t` as a pattern using a recursive call to `rnPat`, convert it -to a type pattern later. One particularly prickly issue is that of -implicit quantification. Consider: +to a type pattern later. + +One particularly prickly issue is that of implicit quantification. Consider: f :: forall a -> ... f t = ... -- binding site of `t` @@ -1042,12 +1037,13 @@ implicit quantification. Consider: g = ... Does the signature of `g` refer to `t` bound in `f`, or is it a fresh, -implicitly quantified variable? This is normally controlled by ScopedTypeVariables, -but in this example the renamer can't tell `t` from a term variable. -Only later (in the type checker) will we find out that it stands -for the forall-bound type variable `a`. -So when RequiredTypeArguments is in effect, we change implicit quantification -to take term variables into account. (NB. not implemented) +implicitly quantified variable? This is normally controlled by +ScopedTypeVariables, but in this example the renamer can't tell `t` from a term +variable. Only later (in the type checker) will we find out that it stands for +the forall-bound type variable `a`. So when RequiredTypeArguments is in effect, +we change implicit quantification to take term variables into account; that is, +we do not implicitly quantify the signature of `g` to `g :: forall t. t->t` +because of the term-level `t` that is in scope. (NB. not implemented) See Note [Term variable capture and implicit quantification]. Typechecking type applications @@ -1070,36 +1066,42 @@ If the type signature is removed, the error is: Illegal type pattern. A type pattern must be checked against a visible forall. -When the type of the function is known and contains a `forall`, -all we need to do is instantiate the forall-bound variable with -the supplied type argument. +When the type of the function is known and contains a `forall`, all we need to +do is instantiate the forall-bound variable with the supplied type argument. This is done by tcVTA (if Specified) and tcVDQ (if Required). -tcVDQ unwraps the HsEmbTy and uses the type contained within it. -Crucially, in tcVDQ we know that we are expecting a type argument. -This means that we can support +tcVDQ unwraps the HsEmbTy and uses the type contained within it. Crucially, in +tcVDQ we know that we are expecting a type argument. This means that we can +support f (Maybe Int) -- HsApp, no HsEmbTy (NB. not implemented) -The type argument (Maybe Int) is represented as an HsExpr, -but tcVDQ can easily convert it to HsType. -This conversion is called the "T2T-Mapping" in GHC Proposal #281. +The type argument (Maybe Int) is represented as an HsExpr, but tcVDQ can easily +convert it to HsType. This conversion is called the "T2T-Mapping" in GHC +Proposal #281. Typechecking type abstractions ------------------------------ -Type abstractions are checked alongside ordinary patterns in tcPats. +Type abstractions are checked alongside ordinary patterns in GHC.Tc.Gen.Pat.tcPats. One of its inputs is a list of ExpPatType that has two constructors * ExpFunPatTy ... -- the type A of a function A -> B - * ExpForallPatTy ... -- the binder (a::A) of forall (a::A) -> B + * ExpForAllPatTy ... -- the binder (a::A) of forall (a::A) -> B so when we are checking f :: forall a b -> a -> b -> ... f (type a) (type b) (x :: a) (y :: b) = ... our expected pattern types are - [ ExpForallPatTy ... -- forall a -> - , ExpForallPatTy ... -- forall b -> + [ ExpForAllPatTy ... -- forall a -> + , ExpForAllPatTy ... -- forall b -> , ExpFunPatTy ... -- a -> , ExpFunPatTy ... -- b -> ] -This allows us to use different code paths for type abstractions +The [ExpPatType] is initially constructed by GHC.Tc.Utils.Unify.matchExpectedFunTys, +by decomposing the type signature for `f` in our example. If we are given a +definition + g (type a) = ... +we never /infer/ a type g :: forall a -> blah. We can only /check/ +explicit type abstractions in terms. + +Teh [ExpPatType] allows us to use different code paths for type abstractions and ordinary patterns: * tc_pat :: Scaled ExpSigmaTypeFRR -> Checker (Pat GhcRn) (Pat GhcTc) * tc_forall_pat :: Checker (Pat GhcRn, TcTyVar) (Pat GhcTc) @@ -1111,10 +1113,9 @@ This would allow us to support Type patterns in constructor patterns are handled in with tcConTyArg. Both tc_forall_pat and tcConTyArg delegate most of the work to tcHsTyPat. --} -{- Note [VTA for out-of-scope functions] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [VTA for out-of-scope functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose 'wurble' is not in scope, and we have (wurble @Int @Bool True 'x') ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -246,7 +246,7 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches filter_out_forall_pat_tys = mapMaybe match_fun_pat_ty where match_fun_pat_ty (ExpFunPatTy t) = Just t - match_fun_pat_ty ExpForallPatTy{} = Nothing + match_fun_pat_ty ExpForAllPatTy{} = Nothing ------------- tcMatch :: (AnnoBody body) => TcMatchCtxt body @@ -281,7 +281,7 @@ tcMatch ctxt pat_tys rhs_ty match filter_out_type_pats = filterByList (map is_fun_pat_ty pat_tys) where is_fun_pat_ty ExpFunPatTy{} = True - is_fun_pat_ty ExpForallPatTy{} = False + is_fun_pat_ty ExpForAllPatTy{} = False ------------- tcGRHSs :: AnnoBody body ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -387,7 +387,7 @@ tc_tt_pat pat_ty penv (ParPat x lpar pat rpar) thing_inside = do { (pat', res) <- tc_tt_lpat pat_ty penv pat thing_inside ; return (ParPat x lpar pat' rpar, res) } tc_tt_pat (ExpFunPatTy pat_ty) penv pat thing_inside = tc_pat pat_ty penv pat thing_inside -tc_tt_pat (ExpForallPatTy tv) penv pat thing_inside = tc_forall_pat penv (pat, tv) thing_inside +tc_tt_pat (ExpForAllPatTy tv) penv pat thing_inside = tc_forall_pat penv (pat, tv) thing_inside tc_forall_pat :: Checker (Pat GhcRn, TcTyVar) (Pat GhcTc) tc_forall_pat _ (EmbTyPat _ toktype tp, tv) thing_inside ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -463,11 +463,11 @@ checkingExpType err et = pprPanic "checkingExpType" (text err $$ ppr et) -- Expected type of a pattern in a lambda or a function left-hand side. data ExpPatType = ExpFunPatTy (Scaled ExpSigmaTypeFRR) -- the type A of a function A -> B - | ExpForallPatTy TcTyVar -- the binder (a::A) of forall (a::A) -> B + | ExpForAllPatTy TcTyVar -- the binder (a::A) of forall (a::A) -> B instance Outputable ExpPatType where ppr (ExpFunPatTy t) = ppr t - ppr (ExpForallPatTy tv) = text "forall" <+> ppr tv + ppr (ExpForAllPatTy tv) = text "forall" <+> ppr tv {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -386,11 +386,11 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside Check ty -> go [] arity ty _ -> defer [] arity orig_ty where - -- Skolemise any foralls /before/ the zero-arg case + -- Skolemise any /invisible/ foralls /before/ the zero-arg case -- so that we guarantee to return a rho-type go acc_arg_tys n ty - | (tvs, theta, _) <- tcSplitSigmaTy ty - , not (null tvs && null theta) + | (tvs, theta, _) <- tcSplitSigmaTy ty -- Invisible binders only! + , not (null tvs && null theta) -- Visible ones handled below = do { (wrap_gen, (wrap_res, result)) <- tcTopSkolemise ctx ty $ \ty' -> go acc_arg_tys n ty' ; return (wrap_gen <.> wrap_res, result) } @@ -404,8 +404,14 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside go acc_arg_tys n ty | Just ty' <- coreView ty = go acc_arg_tys n ty' + -- Decompose /visible/ (forall a -> blah), to give an ExpForAllPat + -- NB: invisible binders are handled by tcSplitSigmaTy/tcTopSkolemise above + -- NB: visible foralls "count" for the Arity argument; they correspond + -- to syntactically visible patterns in the source program + -- See Note [Visible type application and abstraction] in GHC.Tc.Gen.App go acc_arg_tys n ty - | Just (Bndr tv Required, ty') <- splitForAllForAllTyBinder_maybe ty + | Just (Bndr tv vis, ty') <- splitForAllForAllTyBinder_maybe ty + , Required <- vis = let init_subst = mkEmptySubst (mkInScopeSet (tyCoVarsOfType ty)) in goVdq init_subst acc_arg_tys n ty tv ty' @@ -451,7 +457,7 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside ; let ty' = substTy subst' ty ; (ev_binds, (wrap_res, result)) <- checkConstraints (getSkolemInfo skol_info) [tv'] [] $ - go (ExpForallPatTy tv' : acc_arg_tys) (n - 1) ty' + go (ExpForAllPatTy tv' : acc_arg_tys) (n - 1) ty' ; let wrap_gen = mkWpVisTyLam tv' ty' <.> mkWpLet ev_binds ; return (wrap_gen <.> wrap_res, result) } @@ -481,7 +487,7 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside where arg_tys' = map prepare_arg_ty (reverse arg_tys) prepare_arg_ty (ExpFunPatTy (Scaled u v)) = Anon (Scaled u (checkingExpType "matchExpectedFunTys" v)) visArgTypeLike - prepare_arg_ty (ExpForallPatTy tv) = Named (Bndr tv Required) + prepare_arg_ty (ExpForAllPatTy tv) = Named (Bndr tv Required) -- this is safe b/c we're called from "go" mkFunTysMsg :: TidyEnv View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f6602026512b62a8a571a1fa662e850ab07669c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f6602026512b62a8a571a1fa662e850ab07669c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 16:21:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 12:21:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-warning Message-ID: <64bab081b536b_19cb1a1af7446835675e@gitlab.mail> Ben Gamari pushed new branch wip/fix-warning at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-warning You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 17:01:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 13:01:06 -0400 Subject: [Git][ghc/ghc][ghc-9.8] 4 commits: gitlab-ci: Don't run nonmoving bootstrap release job Message-ID: <64bab9d2c1ba5_19cb1a1afa660c3714a0@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 1f3d83b5 by Ben Gamari at 2023-07-21T13:00:51-04:00 gitlab-ci: Don't run nonmoving bootstrap release job This was only intended for validation. - - - - - df2e5c24 by Ben Gamari at 2023-07-21T13:00:54-04:00 fetch-gitlab: Update job mapping - - - - - 25179c81 by Ben Gamari at 2023-07-21T13:00:54-04:00 nofib: Bump submodule - - - - - e5615af4 by Ben Gamari at 2023-07-21T13:00:54-04:00 configure: Add trailing zero to version number - - - - - 5 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - configure.ac - nofib Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -930,7 +930,7 @@ job_groups = make_wasm_jobs wasm_build_config {bignumBackend = Native} , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} - , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , addValidateRule NonmovingGc (validateBuilds Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) , modifyNightlyJobs (addJobRule Disable) $ addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] ===================================== .gitlab/jobs.yaml ===================================== @@ -2916,68 +2916,6 @@ "XZ_OPT": "-9" } }, - "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { - "after_script": [ - ".gitlab/ci.sh save_cache", - ".gitlab/ci.sh clean", - "cat ci_timings" - ], - "allow_failure": false, - "artifacts": { - "expire_in": "1 year", - "paths": [ - "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" - ], - "reports": { - "junit": "junit.xml" - }, - "when": "always" - }, - "cache": { - "key": "x86_64-linux-deb11-$CACHE_REV", - "paths": [ - "cabal-cache", - "toolchain" - ] - }, - "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], - "rules": [ - { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", - "when": "on_success" - } - ], - "script": [ - "sudo chown ghc:ghc -R .", - ".gitlab/ci.sh setup", - ".gitlab/ci.sh configure", - ".gitlab/ci.sh build_hadrian", - ".gitlab/ci.sh test_hadrian" - ], - "stage": "full-build", - "tags": [ - "x86_64-linux" - ], - "variables": { - "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc", - "BUILD_FLAVOUR": "release+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", - "HADRIAN_ARGS": "--hash-unit-ids", - "IGNORE_PERF_FAILURES": "all", - "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", - "TEST_ENV": "x86_64-linux-deb11-release+boot_nonmoving_gc", - "XZ_OPT": "-9" - } - }, "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -18,7 +18,7 @@ def job_triple(job_name): bindists = { 'release-x86_64-windows-release': 'x86_64-unknown-mingw32', 'release-x86_64-windows-int_native-release': 'x86_64-unknown-mingw32-int_native', - 'release-x86_64-rocky8-release': 'x86_64-rocky8-linux', + 'release-x86_64-linux-rocky8-release': 'x86_64-rocky8-linux', 'release-x86_64-linux-ubuntu20_04-release': 'x86_64-ubuntu20_04-linux', 'release-x86_64-linux-ubuntu18_04-release': 'x86_64-ubuntu18_04-linux', 'release-x86_64-linux-fedora33-release+debug_info': 'x86_64-fedora33-linux-dwarf', @@ -29,15 +29,16 @@ def job_triple(job_name): 'release-x86_64-linux-deb10-release': 'x86_64-deb10-linux', 'release-x86_64-linux-deb9-release': 'x86_64-deb9-linux', 'release-x86_64-linux-centos7-release': 'x86_64-centos7-linux', + 'release-x86_64-linux-alpine3_12-release+no_split_sections': 'x86_64-alpine3_12-linux', 'release-x86_64-linux-alpine3_12-release+fully_static': 'x86_64-alpine3_12-linux-static', - 'release-x86_64-linux-alpine3_12-release': 'x86_64-alpine3_12-linux', 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', + 'release-i386-linux-deb10-release+no_split_sections': 'i386-deb10-linux', 'release-i386-linux-deb9-release': 'i386-deb9-linux', - 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', + 'release-x86_64-linux-deb11-release+boot_nonmoving_gc': 'unused', 'source-tarball': 'src', 'package-hadrian-bootstrap-sources': 'hadrian-bootstrap-sources', ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.8.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are ===================================== nofib ===================================== @@ -1 +1 @@ -Subproject commit 2cee92861c43ac74154bbd155a83f9f4ad0b9f2f +Subproject commit 274cc3f7479431e3a52c78840b3daee887e0414f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae88ed9a73d52ab103df491ef2e43c483f1d548d...e5615af43fc74699a3e9f5b81bc57482bf94d1b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae88ed9a73d52ab103df491ef2e43c483f1d548d...e5615af43fc74699a3e9f5b81bc57482bf94d1b2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 17:14:31 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 13:14:31 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 9 commits: gitlab-ci: Don't run nonmoving bootstrap release job Message-ID: <64babcf7cd8d0_19cb1a1af74440438331@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 1f3d83b5 by Ben Gamari at 2023-07-21T13:00:51-04:00 gitlab-ci: Don't run nonmoving bootstrap release job This was only intended for validation. - - - - - df2e5c24 by Ben Gamari at 2023-07-21T13:00:54-04:00 fetch-gitlab: Update job mapping - - - - - 25179c81 by Ben Gamari at 2023-07-21T13:00:54-04:00 nofib: Bump submodule - - - - - e5615af4 by Ben Gamari at 2023-07-21T13:00:54-04:00 configure: Add trailing zero to version number - - - - - b0b88c24 by Sylvain Henry at 2023-07-21T13:09:52-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b (cherry picked from commit 8d6574bc68cbbcabbf7c0e5700571c4746127fb8) - - - - - e39e8fae by Arnaud Spiwack at 2023-07-21T13:10:17-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 (cherry picked from commit 522bd584f71ddeda21efdf0917606ce3d81ec6cc) - - - - - f0b9bfa1 by Torsten Schmits at 2023-07-21T13:10:24-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall (cherry picked from commit 459dee1b671958bcd5857a676afaf92f944a0af4) - - - - - 3cac14d2 by Ben Gamari at 2023-07-21T13:11:43-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. (cherry picked from commit 3ece9856d157c85511d59f9f862ab351bbd9b38b) - - - - - f9ef5a44 by Ben Gamari at 2023-07-21T13:11:47-04:00 nativeGen: Set explicit section types on all platforms (cherry picked from commit db7f7240b53c01447e44d2790ee37eacaabfbcf3) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Types/Unique/DFM.hs - configure.ac - rts/js/rts.js - rts/js/verify.js - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/ghci/should_run/T16096.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c5386d29626759a8cca561811acc514e57c603e...f9ef5a44e54073854571a8b421e64e63706e4572 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c5386d29626759a8cca561811acc514e57c603e...f9ef5a44e54073854571a8b421e64e63706e4572 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 17:17:27 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 13:17:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-9.8-forward-ports Message-ID: <64babda771f94_19cb1a1f428014441188@gitlab.mail> Ben Gamari pushed new branch wip/ghc-9.8-forward-ports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-9.8-forward-ports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 17:21:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 13:21:46 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8-forward-ports] 11 commits: Bump deepseq submodule to 1.5. Message-ID: <64babeaa7a365_17b24eb804c72445@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8-forward-ports at Glasgow Haskell Compiler / GHC Commits: 24c34319 by Ben Gamari at 2023-07-21T13:18:34-04:00 Bump deepseq submodule to 1.5. And bump bounds (cherry picked from commit 1228d3a4a08d30eaf0138a52d1be25b38339ef0b) - - - - - 91874cd8 by Ben Gamari at 2023-07-21T13:18:54-04:00 configure: Bump minimal boot GHC version to 9.4 (cherry picked from commit d3ffdaf9137705894d15ccc3feff569d64163e8e) - - - - - 50d8976a by Ben Gamari at 2023-07-21T13:18:54-04:00 template-haskell: Bump version to 2.21.0.0 (cherry picked from commit bf57fc9aea1196f97f5adb72c8b56434ca4b87cb) - - - - - 42dc81ab by Ben Gamari at 2023-07-21T13:18:54-04:00 base: Bump version to 4.19 Updates all boot library submodules. (cherry picked from commit 433d99a3c24a55b14ec09099395e9b9641430143) - - - - - 1a953ada by Ben Gamari at 2023-07-21T13:18:54-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. (cherry picked from commit 024861af51aee807d800e01e122897166a65ea93) - - - - - 69a87637 by Ben Gamari at 2023-07-21T13:18:54-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. (cherry picked from commit c046a2382420f2be2c4a657c56f8d95f914ea47b) - - - - - a78af3ab by Ben Gamari at 2023-07-21T13:18:54-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. (cherry picked from commit f356a7e8ec8ec3d6b2b30fd175598b9b80065d87) - - - - - dab897a2 by Ben Gamari at 2023-07-21T13:18:54-04:00 Update generate_bootstrap_plans (cherry picked from commit c86a40553b37ba24d53586b3fe1f081ee32fae90) - - - - - 2598a881 by Ben Gamari at 2023-07-21T13:18:55-04:00 hadrian/bootstrap: Drop GHC 9.2 plans (cherry picked from commit d58049efefd632e668b276357d6469b270587209) - - - - - 71b45a0e by Ben Gamari at 2023-07-21T13:18:55-04:00 hadrian/bootstrap: Add 9.6.2 plans (cherry picked from commit a79d1806ed887a64f79fea25921711caef2ae108) - - - - - 365660fb by Ben Gamari at 2023-07-21T13:18:55-04:00 hadrian/bootstrap: Regenerate existing plans (cherry picked from commit 4f142ee9ab0cca0274c33df6c49972cb40744a6c) - - - - - 14 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/ghc.cabal.in - configure.ac - ghc/ghc-bin.cabal.in - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/903eea801283cca9c837dd224e1c9ee671e50cc7...365660fba9660933924215c541913218b687a003 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/903eea801283cca9c837dd224e1c9ee671e50cc7...365660fba9660933924215c541913218b687a003 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 18:16:14 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 21 Jul 2023 14:16:14 -0400 Subject: [Git][ghc/ghc][wip/expand-do] some more changes, fixing simpl017 test case Message-ID: <64bacb6e85b93_17b24eb809c8178b@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: d15b8800 by Apoorv Ingle at 2023-07-21T13:15:59-05:00 some more changes, fixing simpl017 test case - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Expr.hs - testsuite/tests/simplCore/should_compile/simpl017.stderr Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -238,7 +238,7 @@ tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty -- to get better error messages -- eg. T18324b.hs -tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty +tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty | LetStmt{} <- s , HsLet x tkLet binds tkIn e <- expd_expr = do { traceTc "tcDoStmts let" (vcat [ text "stmt:" <+> ppr stmt @@ -248,7 +248,9 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty ]) ; (binds', e') <- setSrcSpanA loc $ addStmtCtxt (text "tcExpr let") stmt $ - tcLocalBinds binds $ popErrCtxt $ tcMonoExpr e res_ty + tcLocalBinds binds $ + do { traceTc "tcExpr let popErrCtxt" empty + ; popErrCtxt $ tcMonoExpr e res_ty } ; return $ HsLet x tkLet binds' tkIn e' } | BindStmt{} <- s @@ -258,8 +260,8 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty , text "loc" <+> ppr loc ]) ; setSrcSpanA loc $ - addStmtCtxt (text "tcExpr bind") stmt $ - tcExpr expd_expr res_ty + -- addStmtCtxt (text "tcExpr bind") stmt $ + tcApp e res_ty } | otherwise = do { traceTc "tcDoStmts other" (vcat [ text "stmt:" <+> ppr stmt ===================================== testsuite/tests/simplCore/should_compile/simpl017.stderr ===================================== @@ -23,24 +23,3 @@ simpl017.hs:55:5: error: [GHC-83865] a :: arr i a (bound at simpl017.hs:50:11) liftArray :: arr i a -> E m (forall v. [E m i] -> E' v m a) (bound at simpl017.hs:50:1) - -simpl017.hs:71:10: error: [GHC-83865] - • Couldn't match type: forall v. [E (ST s) Int] -> E' v (ST s) Int - with: [E (ST t0) Int] -> E (ST s) Int - Expected: E' RValue (ST s) ([E (ST t0) Int] -> E (ST s) Int) - Actual: E (ST s) (forall v. [E (ST s) Int] -> E' v (ST s) Int) - • In a stmt of a 'do' block: a <- liftArray ma - In the second argument of ‘($)’, namely - ‘do a <- liftArray ma - let one :: E (ST t) Int - one = return 1 - a [one] `plus` a [one]’ - In the expression: - runE - $ do a <- liftArray ma - let one :: E (ST t) Int - one = return 1 - a [one] `plus` a [one] - • Relevant bindings include - ma :: STArray s Int Int (bound at simpl017.hs:70:5) - foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:70:1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d15b8800fd7788a02559cbb8c7de30b15d9649ad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d15b8800fd7788a02559cbb8c7de30b15d9649ad You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 18:24:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 14:24:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64bacd6222c70_17b24eb809c1000fa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1f0fe120 by Ben Gamari at 2023-07-21T14:23:18-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 27738c1a by Ben Gamari at 2023-07-21T14:23:19-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - 3ddd0316 by Matthew Pickering at 2023-07-21T14:23:20-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - c83b802b by Ilias Tsitsimpis at 2023-07-21T14:23:21-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 18c8cacf by Matthew Pickering at 2023-07-21T14:23:22-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 50b383de by Krzysztof Gogolewski at 2023-07-21T14:23:23-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - abd85930 by sheaf at 2023-07-21T14:23:29-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 5967ba9a by Matthew Pickering at 2023-07-21T14:23:29-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 1e38e282 by Jens Petersen at 2023-07-21T14:23:34-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - 7e91cbb0 by Matthew Pickering at 2023-07-21T14:23:35-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Rules.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/flags.py - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Default.hs-boot - hadrian/src/Settings/Flavours/Benchmark.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Performance.hs - hadrian/src/Settings/Flavours/Validate.hs - libraries/ghc-prim/changelog.md - libraries/ghc-prim/ghc-prim.cabal → libraries/ghc-prim/ghc-prim.cabal.in - testsuite/tests/dependent/should_fail/BadTelescope.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46c04c0c5d69d03651eaa4645b3b5a29a66aebf3...7e91cbb05ff4850e7d349577c066525a8bf60316 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46c04c0c5d69d03651eaa4645b3b5a29a66aebf3...7e91cbb05ff4850e7d349577c066525a8bf60316 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 18:33:21 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Fri, 21 Jul 2023 14:33:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/misc-cleanup7 Message-ID: <64bacf7199c8c_17b24eb804c10022e@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/misc-cleanup7 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/misc-cleanup7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 18:45:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 14:45:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/template-haskell-stability Message-ID: <64bad23a1148e_17b24eb804c1022ef@gitlab.mail> Ben Gamari pushed new branch wip/template-haskell-stability at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/template-haskell-stability You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 19:58:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 15:58:24 -0400 Subject: [Git][ghc/ghc][wip/split-ghc-base] 375 commits: testsuite: fix predicate on rdynamic test Message-ID: <64bae36017141_17b24eb804c1066b@gitlab.mail> Ben Gamari pushed to branch wip/split-ghc-base at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - f7ce8a63 by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Introduce Data.Enum - - - - - e2c6430d by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Num.Integer - - - - - d03cd0ce by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Num - - - - - d31b53ef by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Num.Natural - - - - - 85b7225c by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Float - - - - - 22d1f46c by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Add export list to GHC.Real - - - - - dd16a902 by Ben Gamari at 2023-07-21T11:49:00-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T13386 Metric Decrease: T13386 T8095 - - - - - 93e400a9 by Ben Gamari at 2023-07-21T15:56:08-04:00 Break up GHC.Base - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - − .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b10ccb35e7ca4960df13fd4b4e703b795ab39a6b...93e400a97dd80a3ab07518c92151668ea3c69a76 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b10ccb35e7ca4960df13fd4b4e703b795ab39a6b...93e400a97dd80a3ab07518c92151668ea3c69a76 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 20:06:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 21 Jul 2023 16:06:16 -0400 Subject: [Git][ghc/ghc][wip/base-stability] base: Eliminate module reexport in GHC.Exception Message-ID: <64bae538dac16_17b24eb7ffc10687a@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 3be05e23 by Ben Gamari at 2023-07-21T16:05:32-04:00 base: Eliminate module reexport in GHC.Exception The metric increase here isn't strictly due to this commit but it's a rather small, incidental change. Metric Increase: T13386 Metric Decrease: T8095 T13386 T18304 - - - - - 1 changed file: - libraries/base/GHC/Exception.hs Changes: ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3be05e23af41be826db2a738bd281b63d9cc4079 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3be05e23af41be826db2a738bd281b63d9cc4079 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 21 23:47:20 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 21 Jul 2023 19:47:20 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack Message-ID: <64bb1908a3936_17b24eb8088125182@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 9237c77f by Finley McIlwaine at 2023-07-21T17:44:48-06:00 Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack The -finfo-table-map-omit-stack flag omits STACK info tables from the info table map, and the -finfo-table-map-omit-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase, the build results were about 7% smaller when both of those tables were omitted. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. Fixes #23702 - - - - - 12 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst Changes: ===================================== compiler/GHC/Cmm.hs ===================================== @@ -229,16 +229,15 @@ data CmmInfoTable -- place to convey this information from the code generator to -- where we build the static closures in -- GHC.Cmm.Info.Build.doSRTs. - } deriving Eq + } deriving (Eq, Ord) instance OutputableP Platform CmmInfoTable where pdoc = pprInfoTable - data ProfilingInfo = NoProfilingInfo | ProfilingInfo ByteString ByteString -- closure_type, closure_desc - deriving Eq + deriving (Eq, Ord) ----------------------------------------------------------------------------- -- Static Data ----------------------------------------------------------------------------- ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -43,6 +43,8 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmEagerBlackHole = gopt Opt_EagerBlackHoling dflags , stgToCmmOrigThunkInfo = gopt Opt_OrigThunkInfo dflags , stgToCmmInfoTableMap = gopt Opt_InfoTableMap dflags + , stgToCmmInfoTableMapOmitFallback = gopt Opt_InfoTableMapOmitFallback dflags + , stgToCmmInfoTableMapOmitStack = gopt Opt_InfoTableMapOmitStack dflags , stgToCmmOmitYields = gopt Opt_OmitYields dflags , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas dflags , stgToCmmPIC = gopt Opt_PIC dflags ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -224,6 +224,8 @@ data GeneralFlag | Opt_DistinctConstructorTables | Opt_InfoTableMap + | Opt_InfoTableMapOmitFallback + | Opt_InfoTableMapOmitStack | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_ShowWarnGroups -- Show the group a warning belongs to ===================================== compiler/GHC/Driver/GenerateCgIPEStub.hs ===================================== @@ -1,15 +1,18 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TupleSections #-} module GHC.Driver.GenerateCgIPEStub (generateCgIPEStub) where +import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (mapMaybe, listToMaybe) +import Data.Semigroup ((<>)) import GHC.Cmm import GHC.Cmm.CLabel (CLabel) import GHC.Cmm.Dataflow (Block, C, O) import GHC.Cmm.Dataflow.Block (blockSplit, blockToList) -import GHC.Cmm.Dataflow.Collections (mapToList) -import GHC.Cmm.Dataflow.Label (Label) +import GHC.Cmm.Dataflow.Collections +import GHC.Cmm.Dataflow.Label (Label, LabelMap) import GHC.Cmm.Info.Build (emptySRT) import GHC.Cmm.Pipeline (cmmPipeline) import GHC.Data.Maybe (firstJusts) @@ -17,7 +20,7 @@ import GHC.Data.Stream (Stream, liftIO) import qualified GHC.Data.Stream as Stream import GHC.Driver.Env (hsc_dflags, hsc_logger) import GHC.Driver.Env.Types (HscEnv) -import GHC.Driver.Flags (GeneralFlag (Opt_InfoTableMap), DumpFlag(Opt_D_ipe_stats)) +import GHC.Driver.Flags (GeneralFlag (..), DumpFlag(Opt_D_ipe_stats)) import GHC.Driver.DynFlags (gopt, targetPlatform) import GHC.Driver.Config.StgToCmm import GHC.Driver.Config.Cmm @@ -27,14 +30,14 @@ import GHC.Settings (Platform, platformTablesNextToCode) import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState) import GHC.StgToCmm.Prof (initInfoTableProv) import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos) +import GHC.StgToCmm.Utils import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation) import GHC.Types.Name.Set (NonCaffySet) import GHC.Types.Tickish (GenTickish (SourceNote)) import GHC.Unit.Types (Module, moduleName) import GHC.Unit.Module (moduleNameString) -import GHC.Utils.Misc import qualified GHC.Utils.Logger as Logger -import GHC.Utils.Outputable +import GHC.Utils.Outputable (ppr) {- Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] @@ -190,60 +193,107 @@ generateCgIPEStub hsc_env this_mod denv s = do cmm_cfg = initCmmConfig dflags cgState <- liftIO initC - -- Collect info tables, but only if -finfo-table-map is enabled, otherwise labeledInfoTablesWithTickishes is empty. - let collectFun = if gopt Opt_InfoTableMap dflags then collect platform else collectNothing - (labeledInfoTablesWithTickishes, (nonCaffySet, moduleLFInfos)) <- Stream.mapAccumL_ collectFun [] s + -- Collect info tables from the Cmm if -finfo-table-map is enabled. If + -- -finfo-table-map is not enabled, infoTablesWithTickishes will be empty. If + -- -finfo-table-map-with-stack is enabled, any STACK info tables will be + -- mapped to their source locations (See Note [Stacktraces from Info Table + -- Provenance Entries (IPE based stack unwinding)]). If + -- -finfo-table-map-with-stack is not enabled, we need to track how many STACK + -- info tables we have skipped (in case -dipe-stats is enabled). Note that + -- this is the only stats tracking we do at this stage, so initStats here + -- should only ever contain stats about skipped STACK info tables. + let + collectFun = + if gopt Opt_InfoTableMap dflags then + collect platform + else + collectNothing platform + + ((infoTablesWithTickishes, initStats), (nonCaffySet, moduleLFInfos)) <- Stream.mapAccumL_ collectFun (mempty, mempty) s -- Yield Cmm for Info Table Provenance Entries (IPEs) - let denv' = denv {provInfoTables = Map.fromList (map (\(_, i, t) -> (cit_lbl i, t)) labeledInfoTablesWithTickishes)} - ((mIpeStub, ipeCmmGroup), _) = runC (initStgToCmmConfig dflags this_mod) fstate cgState $ getCmm (initInfoTableProv (map sndOf3 labeledInfoTablesWithTickishes) denv') + let denv' = denv {provInfoTables = Map.mapKeys cit_lbl infoTablesWithTickishes} + ((mIpeStub, ipeCmmGroup), _) = runC (initStgToCmmConfig dflags this_mod) fstate cgState $ getCmm (initInfoTableProv initStats (Map.keys infoTablesWithTickishes) denv') (_, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) ipeCmmGroup Stream.yield ipeCmmGroupSRTs - ipeStub <- case mIpeStub of - Just (stats, stub) -> do - -- Print ipe stats if requested - liftIO $ - Logger.putDumpFileMaybe logger - Opt_D_ipe_stats - ("IPE Stats for module " ++ (moduleNameString $ moduleName this_mod)) - Logger.FormatText - (ppr stats) - return stub - Nothing -> return mempty + ipeStub <- + case mIpeStub of + Just (stats, stub) -> do + -- Print ipe stats if requested + liftIO $ + Logger.putDumpFileMaybe logger + Opt_D_ipe_stats + ("IPE Stats for module " ++ (moduleNameString $ moduleName this_mod)) + Logger.FormatText + (ppr stats) + return stub + Nothing -> return mempty return CmmCgInfos {cgNonCafs = nonCaffySet, cgLFInfos = moduleLFInfos, cgIPEStub = ipeStub} where - collect :: Platform -> [(Label, CmmInfoTable, Maybe IpeSourceLocation)] -> CmmGroupSRTs -> IO ([(Label, CmmInfoTable, Maybe IpeSourceLocation)], CmmGroupSRTs) - collect platform acc cmmGroupSRTs = do - let labelsToInfoTables = collectInfoTables cmmGroupSRTs - labelsToInfoTablesToTickishes = map (\(l, i) -> (l, i, lookupEstimatedTick platform cmmGroupSRTs l i)) labelsToInfoTables - return (acc ++ labelsToInfoTablesToTickishes, cmmGroupSRTs) - - collectNothing :: [a] -> CmmGroupSRTs -> IO ([a], CmmGroupSRTs) - collectNothing _ cmmGroupSRTs = pure ([], cmmGroupSRTs) - - collectInfoTables :: CmmGroupSRTs -> [(Label, CmmInfoTable)] - collectInfoTables cmmGroup = concat $ mapMaybe extractInfoTables cmmGroup - - extractInfoTables :: GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> Maybe [(Label, CmmInfoTable)] - extractInfoTables (CmmProc h _ _ _) = Just $ mapToList (info_tbls h) - extractInfoTables _ = Nothing - - lookupEstimatedTick :: Platform -> CmmGroupSRTs -> Label -> CmmInfoTable -> Maybe IpeSourceLocation - lookupEstimatedTick platform cmmGroup infoTableLabel infoTable = do + -- These functions are applied to the elements of the stream of + -- CmmGroupSRTs. 'collect' populates a map from info table to potential + -- source location, and is used when -finfo-table-map is supplied. + -- 'collectNothing' does nothing and just throws out the stream elements. + collect, collectNothing + :: Platform + -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) + -> CmmGroupSRTs + -> IO ((Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats), CmmGroupSRTs) + collect platform (!acc, !stats) cmmGroupSRTs = do + let + blocks = concatMap toBlockList (graphs cmmGroupSRTs) + labelsToInfoTables = collectInfoTables cmmGroupSRTs + (tablesToTickishes, stats') = mapFoldlWithKey (lookupEstimatedTick platform blocks) (acc, stats) labelsToInfoTables + return ((tablesToTickishes, stats'), cmmGroupSRTs) + collectNothing _ _ cmmGroupSRTs = pure ((Map.empty, mempty), cmmGroupSRTs) + + collectInfoTables :: CmmGroupSRTs -> LabelMap CmmInfoTable + collectInfoTables cmmGroup = foldl' extractInfoTables mapEmpty cmmGroup + + extractInfoTables :: LabelMap CmmInfoTable -> GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph -> LabelMap CmmInfoTable + extractInfoTables acc (CmmProc h _ _ _) = acc `mapUnion` info_tbls h + extractInfoTables acc _ = acc + + lookupEstimatedTick + :: Platform + -> [CmmBlock] + -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) + -> Label + -> CmmInfoTable + -> (Map CmmInfoTable (Maybe IpeSourceLocation), IPEStats) + lookupEstimatedTick platform blocks (!acc, !stats) infoTableLabel infoTable = do -- All return frame info tables are stack represented, though not all stack represented info -- tables have to be return frames. - if (isStackRep . cit_rep) infoTable - then do - let findFun = - if platformTablesNextToCode platform - then findCmmTickishWithTNTC infoTableLabel - else findCmmTickishSansTNTC (cit_lbl infoTable) - blocks = concatMap toBlockList (graphs cmmGroup) - firstJusts $ map findFun blocks - else Nothing + if (isStackRep . cit_rep) infoTable then + if gopt Opt_InfoTableMapOmitStack (hsc_dflags hsc_env) then + -- This is a STACK info table but we DO NOT want to put it in the info + -- table map (-finfo-table-map-omit-stack was given), track it as + -- skipped + (acc, stats <> skippedIpeStats) + else + -- This is a STACK info table and we DO want to put it in the info + -- table map + let + findFun = + if platformTablesNextToCode platform + then findCmmTickishWithTNTC infoTableLabel + else findCmmTickishSansTNTC (cit_lbl infoTable) + -- Avoid retaining the blocks + !srcloc = + case firstJusts $ map findFun blocks of + Just !srcloc -> Just srcloc + Nothing -> Nothing + in + (Map.insert infoTable srcloc acc, stats) + + else + -- This is not a STACK info table, so put it in the map with no source + -- location (for now) + (Map.insert infoTable Nothing acc, stats) + graphs :: CmmGroupSRTs -> [CmmGraph] graphs = foldl' go [] where ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1781,10 +1781,6 @@ dynamic_flags_deps = [ -- Caller-CC , make_ord_flag defGhcFlag "fprof-callers" (HasArg setCallerCcFilters) - , make_ord_flag defGhcFlag "fdistinct-constructor-tables" - (NoArg (setGeneralFlag Opt_DistinctConstructorTables)) - , make_ord_flag defGhcFlag "finfo-table-map" - (NoArg (setGeneralFlag Opt_InfoTableMap)) ------ Compiler flags ----------------------------------------------- , make_ord_flag defGhcFlag "fasm" (NoArg (setObjBackend ncgBackend)) @@ -2462,7 +2458,11 @@ fFlagsDeps = [ flagSpec "show-error-context" Opt_ShowErrorContext, flagSpec "cmm-thread-sanitizer" Opt_CmmThreadSanitizer, flagSpec "split-sections" Opt_SplitSections, - flagSpec "break-points" Opt_InsertBreakpoints + flagSpec "break-points" Opt_InsertBreakpoints, + flagSpec "distinct-constructor-tables" Opt_DistinctConstructorTables, + flagSpec "info-table-map" Opt_InfoTableMap, + flagSpec "info-table-map-omit-stack" Opt_InfoTableMapOmitStack, + flagSpec "info-table-map-omit-fallback" Opt_InfoTableMapOmitFallback ] ++ fHoleFlags @@ -2756,6 +2756,8 @@ impliedGFlags = [(Opt_DeferTypeErrors, turnOn, Opt_DeferTypedHoles) ,(Opt_Strictness, turnOn, Opt_WorkerWrapper) ,(Opt_WriteIfSimplifiedCore, turnOn, Opt_WriteInterface) ,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteIfSimplifiedCore) + ,(Opt_InfoTableMapOmitStack, turnOn, Opt_InfoTableMap) + ,(Opt_InfoTableMapOmitFallback, turnOn, Opt_InfoTableMap) ] ++ validHoleFitsImpliedGFlags -- General flags that are switched on/off when other general flags are switched ===================================== compiler/GHC/Runtime/Heap/Layout.hs ===================================== @@ -175,7 +175,7 @@ data SMRep | RTSRep -- The RTS needs to declare info tables with specific Int -- type tags, so this form lets us override the default SMRep -- tag for an SMRep. - deriving Eq + deriving (Eq, Ord) -- | True \<=> This is a static closure. Affects how we garbage-collect it. -- Static closure have an extra static link field at the end. @@ -193,7 +193,7 @@ data ClosureTypeInfo | ThunkSelector SelectorOffset | BlackHole | IndStatic - deriving Eq + deriving (Eq, Ord) type ConstrDescription = ByteString -- result of dataConIdentity type FunArity = Int @@ -223,7 +223,7 @@ data ArgDescr | ArgUnknown -- For imported binds. -- Invariant: Never Unknown for binds of the module -- we are compiling. - deriving (Eq) + deriving (Eq, Ord) instance Outputable ArgDescr where ppr (ArgSpec n) = text "ArgSpec" <+> ppr n ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -52,6 +52,8 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmEagerBlackHole :: !Bool -- ^ , stgToCmmOrigThunkInfo :: !Bool -- ^ Push @stg_orig_thunk_info@ frames during thunk update. , stgToCmmInfoTableMap :: !Bool -- ^ true means generate C Stub for IPE map, See note [Mapping + , stgToCmmInfoTableMapOmitFallback :: !Bool + , stgToCmmInfoTableMapOmitStack :: !Bool -- Info Tables to Source Positions] , stgToCmmOmitYields :: !Bool -- ^ true means omit heap checks when no allocation is performed , stgToCmmOmitIfPragmas :: !Bool -- ^ true means don't generate interface programs (implied by -O0) ===================================== compiler/GHC/StgToCmm/Prof.hs ===================================== @@ -275,11 +275,11 @@ sizeof_ccs_words platform (ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform -- | Emit info-table provenance declarations and track IPE stats -initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode (Maybe (IPEStats, CStub)) -initInfoTableProv infos itmap +initInfoTableProv :: IPEStats -> [CmmInfoTable] -> InfoTableProvMap -> FCode (Maybe (IPEStats, CStub)) +initInfoTableProv stats infos itmap = do cfg <- getStgToCmmConfig - let (stats, ents) = convertInfoProvMap infos this_mod itmap + let (stats', ents) = foldl' (convertInfoProvMap cfg this_mod itmap) (stats, []) infos info_table = stgToCmmInfoTableMap cfg platform = stgToCmmPlatform cfg this_mod = stgToCmmThisModule cfg @@ -290,7 +290,7 @@ initInfoTableProv infos itmap emitIpeBufferListNode this_mod ents -- Create the C stub which initialises the IPE map - return (Just (stats, ipInitCode info_table platform this_mod)) + return (Just (stats', ipInitCode info_table platform this_mod)) -- --------------------------------------------------------------------------- -- Set the current cost centre stack ===================================== compiler/GHC/StgToCmm/Utils.hs ===================================== @@ -8,6 +8,7 @@ -- ----------------------------------------------------------------------------- {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} module GHC.StgToCmm.Utils ( emitDataLits, emitRODataLits, @@ -44,7 +45,8 @@ module GHC.StgToCmm.Utils ( emitUpdRemSetPush, emitUpdRemSetPushThunk, - convertInfoProvMap, cmmInfoTableToInfoProvEnt, IPEStats(..) + convertInfoProvMap, cmmInfoTableToInfoProvEnt, IPEStats(..), + closureIpeStats, fallbackIpeStats, skippedIpeStats, ) where import GHC.Prelude hiding ( head, init, last, tail ) @@ -612,18 +614,23 @@ cmmInfoTableToInfoProvEnt this_mod cmit = data IPEStats = IPEStats { ipe_total :: !Int , ipe_closure_types :: !(I.IntMap Int) - , ipe_default :: !Int } + , ipe_fallback :: !Int + , ipe_skipped :: !Int } instance Semigroup IPEStats where - (IPEStats a1 a2 a3) <> (IPEStats b1 b2 b3) = IPEStats (a1 + b1) (I.unionWith (+) a2 b2) (a3 + b3) + (IPEStats a1 a2 a3 a4) <> (IPEStats b1 b2 b3 b4) = IPEStats (a1 + b1) (I.unionWith (+) a2 b2) (a3 + b3) (a4 + b4) instance Monoid IPEStats where - mempty = IPEStats 0 I.empty 0 + mempty = IPEStats 0 I.empty 0 0 + +fallbackIpeStats :: IPEStats +fallbackIpeStats = mempty { ipe_total = 1, ipe_fallback = 1 } -defaultIpeStats :: IPEStats -defaultIpeStats = IPEStats { ipe_total = 0, ipe_closure_types = I.empty, ipe_default = 1} closureIpeStats :: Int -> IPEStats -closureIpeStats t = IPEStats { ipe_total = 1, ipe_closure_types = I.singleton t 1, ipe_default = 0} +closureIpeStats t = mempty { ipe_total = 1, ipe_closure_types = I.singleton t 1 } + +skippedIpeStats :: IPEStats +skippedIpeStats = mempty { ipe_skipped = 1 } instance Outputable IPEStats where ppr = pprIPEStats @@ -631,14 +638,14 @@ instance Outputable IPEStats where pprIPEStats :: IPEStats -> SDoc pprIPEStats (IPEStats{..}) = vcat $ [ text "Tables with info:" <+> ppr ipe_total - , text "Tables with fallback:" <+> ppr ipe_default + , text "Tables with fallback:" <+> ppr ipe_fallback + , text "Tables skipped:" <+> ppr ipe_skipped ] ++ [ text "Info(" <> ppr k <> text "):" <+> ppr n | (k, n) <- I.assocs ipe_closure_types ] -- | Convert source information collected about identifiers in 'GHC.STG.Debug' -- to entries suitable for placing into the info table provenance table. -convertInfoProvMap :: [CmmInfoTable] -> Module -> InfoTableProvMap -> (IPEStats, [InfoProvEnt]) -convertInfoProvMap defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) = - traverse (\cmit -> +convertInfoProvMap :: StgToCmmConfig -> Module -> InfoTableProvMap -> (IPEStats, [InfoProvEnt]) -> CmmInfoTable -> (IPEStats, [InfoProvEnt]) +convertInfoProvMap cfg this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) (!stats, acc) cmit = let cl = cit_lbl cmit cn = rtsClosureType (cit_rep cmit) @@ -650,23 +657,42 @@ convertInfoProvMap defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTab Just (ty, mbspan) -> Just (closureIpeStats cn, (InfoProvEnt cl cn (tyString ty) this_mod mbspan)) Nothing -> Nothing - lookupDataConMap = do + lookupDataConMap :: Maybe (IPEStats, InfoProvEnt) + lookupDataConMap = (closureIpeStats cn,) <$> do UsageSite _ n <- hasIdLabelInfo cl >>= getConInfoTableLocation -- This is a bit grimy, relies on the DataCon and Name having the same Unique, which they do (dc, ns) <- hasHaskellName cl >>= lookupUFM_Directly dcenv . getUnique -- Lookup is linear but lists will be small (< 100) - return $ (closureIpeStats cn, InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns))) + return $ (InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns))) + lookupInfoTableToSourceLocation :: Maybe (IPEStats, InfoProvEnt) lookupInfoTableToSourceLocation = do sourceNote <- Map.lookup (cit_lbl cmit) infoTableToSourceLocationMap - return $ (closureIpeStats cn, InfoProvEnt cl cn "" this_mod sourceNote) + return $ (closureIpeStats cn, (InfoProvEnt cl cn "" this_mod sourceNote)) -- This catches things like prim closure types and anything else which doesn't have a -- source location - simpleFallback = (defaultIpeStats, cmmInfoTableToInfoProvEnt this_mod cmit) + simpleFallback = + if stgToCmmInfoTableMapOmitFallback cfg then + -- If we are omitting tables with fallback info, do not create an + -- entry + Nothing + else + -- Create a default entry with fallback IPE data + Just (fallbackIpeStats, cmmInfoTableToInfoProvEnt this_mod cmit) + + trackSkipped :: Maybe (IPEStats, InfoProvEnt) -> (IPEStats, [InfoProvEnt]) + trackSkipped Nothing = + (stats Data.Semigroup.<> skippedIpeStats, acc) + trackSkipped (Just (s, !c)) = + (stats Data.Semigroup.<> s, c:acc) in - if (isStackRep . cit_rep) cmit then - fromMaybe simpleFallback lookupInfoTableToSourceLocation - else - fromMaybe simpleFallback (lookupDataConMap `firstJust` lookupClosureMap)) defns + trackSkipped $ + if (isStackRep . cit_rep) cmit then + -- Note that we should have already skipped STACK info tables if + -- necessary in 'generateCgIPEStub', so we should not need to worry + -- about doing that here. + fromMaybe simpleFallback (Just <$> lookupInfoTableToSourceLocation) + else + fromMaybe simpleFallback (Just <$> firstJust lookupDataConMap lookupClosureMap) ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -161,7 +161,7 @@ Compiler `libzstd `_ version 1.4.0 or greater installed. The compression library `libzstd` may optionally be statically linked in the resulting compiler (on non-darwin machines) using the - `--enable-static-libzstd` configure flag. + ``--enable-static-libzstd`` configure flag. In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. ===================================== docs/users_guide/debug-info.rst ===================================== @@ -391,6 +391,37 @@ to a source location. This lookup table is generated by using the ``-finfo-table In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. +.. ghc-flag:: -finfo-table-map-omit-stack + :shortdesc: Omit info tables for ``STACK`` closures from the info table + map. + :type: dynamic + :category: debugging + + :since: 9.9 + :implies: :ghc-flag:`-finfo-table-map` + + ``STACK`` info tables are often the majority of entries in the info table + map. However, despite their contribution to the executable size, they are + rarely useful unless debugging with a tool such as `ghc-debug + `_. Use this flag to omit + ``STACK`` info tables from the info table map and decrease the executable + size. + +.. ghc-flag:: -finfo-table-map-omit-fallback + :shortdesc: Omit info tables with no source location information from the + info table map. + :type: dynamic + :category: debugging + + :since: 9.9 + :implies: :ghc-flag:`-finfo-table-map` + + Some info tables, such as those for primitive closure types, will have no + provenance location in the program source. With + :ghc-flag:`-finfo-table-map`, those info tables are given default source + locations and included in the info table map. Use this flag to omit them + from the info table map and decrease the executable size. + .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage of a data constructor. @@ -406,7 +437,6 @@ to a source location. This lookup table is generated by using the ``-finfo-table than the data constructor itself. - Querying the Info Table Map --------------------------- ===================================== docs/users_guide/debugging.rst ===================================== @@ -83,7 +83,8 @@ Dumping out compiler intermediate structures For each module, show some simple statistics about which info tables have IPE information, and how many info tables with IPE information each closure - type has. + type has. This is useful, for example, for verifying that ``STACK`` info + tables are being appropriately omitted or included from the info table map. .. ghc-flag:: -dfaststring-stats :shortdesc: Show statistics for fast string usage when finished View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9237c77fb7a177aa176e9bb600864ee6679fc4a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9237c77fb7a177aa176e9bb600864ee6679fc4a4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:24:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:24:22 -0400 Subject: [Git][ghc/ghc][master] 2 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64bb4be6dbaa3_17b24eb808813905a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/ghc-prim/changelog.md - testsuite/tests/interface-stability/README.mkd - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - + testsuite/tests/primops/should_run/T22710.hs - + testsuite/tests/primops/should_run/T22710.stdout - testsuite/tests/primops/should_run/all.T Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1929,6 +1929,14 @@ primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp with has_side_effects = True +primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp + ByteArray# -> State# s -> (# State# s, MutableByteArray# s #) + {Make an immutable byte array mutable, without copying. + + @since 0.12.0.0} + with + has_side_effects = True + primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp ByteArray# -> Int# {Return the size of the array in bytes.} ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -371,6 +371,10 @@ emitPrimOp cfg primop = UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> emitAssign (CmmLocal res) arg +-- #define unsafeThawByteArrayzh(r,a) r=(a) + UnsafeThawByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> + emitAssign (CmmLocal res) arg + -- Reading/writing pointer arrays ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -652,6 +652,7 @@ genPrim prof bound ty op = case op of ShrinkMutableByteArrayOp_Char -> \[] [a,n] -> PrimInline $ appS "h$shrinkMutableByteArray" [a,n] ResizeMutableByteArrayOp_Char -> \[r] [a,n] -> PrimInline $ r |= app "h$resizeMutableByteArray" [a,n] UnsafeFreezeByteArrayOp -> \[a] [b] -> PrimInline $ a |= b + UnsafeThawByteArrayOp -> \[a] [b] -> PrimInline $ a |= b SizeofByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" SizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" GetSizeofMutableByteArrayOp -> \[r] [a] -> PrimInline $ r |= a .^ "len" ===================================== libraries/ghc-prim/changelog.md ===================================== @@ -1,3 +1,10 @@ +## 0.12.0 + +- Shipped with GHC 9.10.1 + +- The `unsafeThawByteArray#` primop was added, serving as a inverse to the existing + `unsafeFreezeByteArray#` primop (see #22710). + ## 0.11.0 - Shipped with GHC 9.8.1 ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -5,7 +5,31 @@ core libraries do not inadvertently change. They use the `utils/dump-decls` utility to dump all exported declarations of all exposed modules for the following packages: - * base + * `base` These are compared against the expected exports in the test's corresponding `.stdout` file. + + +## Updating expected output + +The `base-exports` test in particular has rather platform-dependent output. +Consequently, updating its output can be a bit tricky. There are two ways by +which one can do this: + + * Extrapolation: The various platforms' `base-exports.stdout` files are + similar enough that one can often apply the same patch of one file to the + others. For instance: + ``` + for f in testsuite/tests/interface-stability/base-exports.stdout-*; do + git show | sed -e "s/base-exports.stdout/$(basename $f)/" | patch -p1 + done + ``` + In the case of conflicts, increasing the fuzz factor (using `-F`) can be + quite effective. + + * Using CI: Each CI job produces a tarball, `unexpected-test-output.tar.gz`, + which contains the output produced by the job's failing tests. Simply + download this tarball and extracting the appropriate `base-exports.stdout-*` + files into this directory. + ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -4650,6 +4650,7 @@ module GHC.Base where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) until :: forall a. (a -> Bool) -> (a -> a) -> a -> a vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a @@ -6703,6 +6704,7 @@ module GHC.Exts where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) void# :: (# #) waitRead# :: forall d. Int# -> State# d -> State# d ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -4650,6 +4650,7 @@ module GHC.Base where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) until :: forall a. (a -> Bool) -> (a -> a) -> a -> a vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a @@ -6672,6 +6673,7 @@ module GHC.Exts where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) void# :: (# #) waitRead# :: forall d. Int# -> State# d -> State# d ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -4653,6 +4653,7 @@ module GHC.Base where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) until :: forall a. (a -> Bool) -> (a -> a) -> a -> a vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a @@ -6852,6 +6853,7 @@ module GHC.Exts where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) void# :: (# #) waitRead# :: forall d. Int# -> State# d -> State# d ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -4650,6 +4650,7 @@ module GHC.Base where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) until :: forall a. (a -> Bool) -> (a -> a) -> a -> a vacuous :: forall (f :: * -> *) a. Functor f => f Void -> f a @@ -6703,6 +6704,7 @@ module GHC.Exts where unsafeFreezeSmallArray# :: forall {l :: Levity} d (a :: TYPE (BoxedRep l)). SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #) unsafePtrEquality# :: forall (a :: UnliftedType) (b :: UnliftedType). a -> b -> Int# unsafeThawArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. Array# a -> State# d -> (# State# d, MutableArray# d a #) + unsafeThawByteArray# :: forall d. ByteArray# -> State# d -> (# State# d, MutableByteArray# d #) unsafeThawSmallArray# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) d. SmallArray# a -> State# d -> (# State# d, SmallMutableArray# d a #) void# :: (# #) waitRead# :: forall d. Int# -> State# d -> State# d ===================================== testsuite/tests/primops/should_run/T22710.hs ===================================== @@ -0,0 +1,55 @@ +-- | Test 'unsafeThawByteArray#'. + +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Exts (newByteArray#, indexWord8Array#, writeWord8Array#, + unsafeFreezeByteArray#, unsafeThawByteArray#, + ByteArray#, MutableByteArray#, Int(I#)) +import GHC.Word +import GHC.ST +import Prelude hiding (toList) + +main :: IO () +main = do + res <- return $ runST $ do + let n = 32 :: Int + marr <- newByteArray n + mapM_ (\i -> writeWord8Array marr i (fromIntegral i)) [0..n-1] + arr <- unsafeFreezeByteArray marr + marr' <- unsafeThawByteArray arr + arr' <- unsafeFreezeByteArray marr' + return $ toList arr' 5 + + print res + +data ByteArray = ByteArray { unBA :: ByteArray# } +data MByteArray s = MByteArray { unMBA :: MutableByteArray# s } + +newByteArray :: Int -> ST s (MByteArray s) +newByteArray (I# n#) = ST $ \s# -> case newByteArray# n# s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +indexWord8Array :: ByteArray -> Int -> Word8 +indexWord8Array arr (I# i#) = case indexWord8Array# (unBA arr) i# of + a -> W8# a + +writeWord8Array :: MByteArray s -> Int -> Word8 -> ST s () +writeWord8Array marr (I# i#) (W8# a) = ST $ \ s# -> + case writeWord8Array# (unMBA marr) i# a s# of + s2# -> (# s2#, () #) + +unsafeFreezeByteArray :: MByteArray s -> ST s ByteArray +unsafeFreezeByteArray marr = ST $ \ s# -> + case unsafeFreezeByteArray# (unMBA marr) s# of + (# s2#, arr# #) -> (# s2#, ByteArray arr# #) + +unsafeThawByteArray :: ByteArray -> ST s (MByteArray s) +unsafeThawByteArray arr = ST $ \ s# -> + case unsafeThawByteArray# (unBA arr) s# of + (# s2#, marr# #) -> (# s2#, MByteArray marr# #) + +toList :: ByteArray -> Int -> [Word8] +toList arr n = go 0 + where + go i | i >= n = [] + | otherwise = indexWord8Array arr i : go (i+1) ===================================== testsuite/tests/primops/should_run/T22710.stdout ===================================== @@ -0,0 +1 @@ +[0,1,2,3,4] ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -71,3 +71,4 @@ test('FMA_ConstantFold' test('T21624', normal, compile_and_run, ['']) test('T23071', ignore_stdout, compile_and_run, ['']) +test('T22710', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b444c16f4ff64938a8bec9587bd90209bda682b9...87f9bd47780eb06b0953fee1fb445306d29db882 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b444c16f4ff64938a8bec9587bd90209bda682b9...87f9bd47780eb06b0953fee1fb445306d29db882 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:24:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:24:47 -0400 Subject: [Git][ghc/ghc][master] Allow users to override non-essential haddock options in a Flavour Message-ID: <64bb4bff8e34e_17b24eb809c143887@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - 7 changed files: - hadrian/src/Settings/Builders/Haddock.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Default.hs-boot - hadrian/src/Settings/Flavours/Benchmark.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/Performance.hs - hadrian/src/Settings/Flavours/Validate.hs Changes: ===================================== hadrian/src/Settings/Builders/Haddock.hs ===================================== @@ -50,6 +50,10 @@ haddockBuilderArgs = mconcat baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs) let baseUrl p = substituteTemplate baseUrlTemplate p ghcOpts <- haddockGhcArgs + -- These are the options which are necessary to perform the build. Additional + -- options such as `--hyperlinked-source`, `--hoogle`, `--quickjump` are + -- added by the `extraArgs` field in the flavour. The defaults are provided + -- by `defaultHaddockExtraArgs`. mconcat [ arg "--verbosity=0" , arg $ "-B" ++ root -/- stageString Stage1 -/- "lib" @@ -57,9 +61,6 @@ haddockBuilderArgs = mconcat , arg $ "--odir=" ++ takeDirectory output , arg $ "--dump-interface=" ++ output , arg "--html" - , arg "--hyperlinked-source" - , arg "--hoogle" - , arg "--quickjump" , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version ++ ": " ++ synopsis , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -7,7 +7,7 @@ module Settings.Default ( -- * Default command line arguments for various builders SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, - defaultExtraArgs, + defaultExtraArgs, defaultHaddockExtraArgs, -- * Default build flavour and BigNum backend defaultFlavour, defaultBignumBackend @@ -219,7 +219,13 @@ sourceArgs SourceArgs {..} = builder Ghc ? mconcat -- | All default command line arguments. defaultExtraArgs :: Args -defaultExtraArgs = sourceArgs defaultSourceArgs +defaultExtraArgs = + mconcat [ sourceArgs defaultSourceArgs, defaultHaddockExtraArgs ] + +defaultHaddockExtraArgs :: Args +defaultHaddockExtraArgs = builder (Haddock BuildPackage) ? + mconcat [ arg "--hyperlinked-source", arg "--hoogle", arg "--quickjump" ] + -- | Default source arguments, e.g. optimisation settings. defaultSourceArgs :: SourceArgs ===================================== hadrian/src/Settings/Default.hs-boot ===================================== @@ -1,6 +1,6 @@ module Settings.Default ( SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, - defaultExtraArgs, defaultLibraryWays, defaultRtsWays, + defaultExtraArgs, defaultHaddockExtraArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultBignumBackend ) where @@ -15,7 +15,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args -defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs :: Args +defaultBuilderArgs, defaultPackageArgs, defaultExtraArgs, defaultHaddockExtraArgs :: Args defaultLibraryWays, defaultRtsWays :: Ways defaultFlavour :: Flavour defaultBignumBackend :: String ===================================== hadrian/src/Settings/Flavours/Benchmark.hs ===================================== @@ -10,7 +10,7 @@ import {-# SOURCE #-} Settings.Default benchmarkFlavour :: Flavour benchmarkFlavour = defaultFlavour { name = "bench" - , extraArgs = benchmarkArgs + , extraArgs = benchmarkArgs <> defaultHaddockExtraArgs , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = Set.fromList <$> mconcat [pure [vanilla], targetSupportsThreadedRts ? pure [threaded]] } ===================================== hadrian/src/Settings/Flavours/Development.hs ===================================== @@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default developmentFlavour :: Stage -> Flavour developmentFlavour ghcStage = defaultFlavour { name = "devel" ++ stageString ghcStage - , extraArgs = developmentArgs ghcStage + , extraArgs = developmentArgs ghcStage <> defaultHaddockExtraArgs , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = Set.fromList <$> mconcat [pure [vanilla, debug], targetSupportsThreadedRts ? pure [threaded, threadedDebug]] , dynamicGhcPrograms = return False ===================================== hadrian/src/Settings/Flavours/Performance.hs ===================================== @@ -8,7 +8,7 @@ import {-# SOURCE #-} Settings.Default performanceFlavour :: Flavour performanceFlavour = splitSections $ defaultFlavour { name = "perf" - , extraArgs = performanceArgs } + , extraArgs = performanceArgs <> defaultHaddockExtraArgs } performanceArgs :: Args performanceArgs = sourceArgs SourceArgs ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -12,7 +12,7 @@ import {-# SOURCE #-} Settings.Default validateFlavour :: Flavour validateFlavour = enableLinting $ werror $ defaultFlavour { name = "validate" - , extraArgs = validateArgs + , extraArgs = validateArgs <> defaultHaddockExtraArgs , libraryWays = Set.fromList <$> mconcat [ pure [vanilla] , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4350b41b54c604e222fe3b0c4edb80beee2c0b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4350b41b54c604e222fe3b0c4edb80beee2c0b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:25:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:25:24 -0400 Subject: [Git][ghc/ghc][master] ghc-prim: Link against libatomic Message-ID: <64bb4c24b225c_17b24eb80b014732@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 2 changed files: - hadrian/src/Rules/Generate.hs - libraries/ghc-prim/ghc-prim.cabal → libraries/ghc-prim/ghc-prim.cabal.in Changes: ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -327,6 +327,9 @@ rtsCabalFlags = mconcat where flag = interpolateCabalFlag +ghcPrimCabalFlags :: Interpolations +ghcPrimCabalFlags = interpolateCabalFlag "CabalNeedLibatomic" NeedLibatomic + packageVersions :: Interpolations packageVersions = foldMap f [ base, ghcPrim, compiler, ghc, cabal, templateHaskell, ghcCompact, array ] where @@ -346,6 +349,7 @@ templateRules :: Rules () templateRules = do templateRule "compiler/ghc.cabal" $ projectVersion templateRule "rts/rts.cabal" $ rtsCabalFlags + templateRule "libraries/ghc-prim/ghc-prim.cabal" $ ghcPrimCabalFlags templateRule "driver/ghci/ghci-wrapper.cabal" $ projectVersion templateRule "ghc/ghc-bin.cabal" $ projectVersion templateRule "utils/iserv/iserv.cabal" $ projectVersion ===================================== libraries/ghc-prim/ghc-prim.cabal → libraries/ghc-prim/ghc-prim.cabal.in ===================================== @@ -27,6 +27,9 @@ source-repository head custom-setup setup-depends: base >= 4 && < 5, process, filepath, directory, Cabal >= 1.23 && < 3.9 +flag need-atomic + default: @CabalNeedLibatomic@ + Library default-language: Haskell2010 other-extensions: @@ -81,6 +84,10 @@ Library -- is just an empty shell. extra-libraries: c, m + if flag(need-atomic) + -- for 64-bit atomic ops on armel (#20549) + extra-libraries: atomic + if !os(ghcjs) c-sources: cbits/atomic.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc186b0c0ac56d6ff6225d3f6607be37770fcb52 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc186b0c0ac56d6ff6225d3f6607be37770fcb52 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:25:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:25:57 -0400 Subject: [Git][ghc/ghc][master] simplifier: Correct InScopeSet in rule matching Message-ID: <64bb4c45151b9_17b24eb807415229c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 3 changed files: - compiler/GHC/Core/Rules.hs - + testsuite/tests/simplCore/should_compile/T23630.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -888,9 +888,6 @@ So we must add the template vars to the in-scope set before starting; see `init_menv` in `matchN`. -} -rvInScopeEnv :: RuleMatchEnv -> InScopeEnv -rvInScopeEnv renv = ISE (rnInScopeSet (rv_lcl renv)) (rv_unf renv) - -- * The domain of the TvSubstEnv and IdSubstEnv are the template -- variables passed into the match. -- @@ -1271,7 +1268,16 @@ match renv subst e1 (Let bind e2) mco ------------------------ Lambdas --------------------- match renv subst (Lam x1 e1) e2 mco - | Just (x2, e2', ts) <- exprIsLambda_maybe (rvInScopeEnv renv) (mkCastMCo e2 mco) + | let casted_e2 = mkCastMCo e2 mco + in_scope = extendInScopeSetSet (rnInScopeSet (rv_lcl renv)) + (exprFreeVars casted_e2) + in_scope_env = ISE in_scope (rv_unf renv) + -- extendInScopeSetSet: The InScopeSet of rn_env is not necessarily + -- a superset of the free vars of e2; it is only guaranteed a superset of + -- applyng the (rnEnvR rn_env) substitution to e2. But exprIsLambda_maybe + -- wants an in-scope set that includes all the free vars of its argument. + -- Hence adding adding (exprFreeVars casted_e2) to the in-scope set (#23630) + , Just (x2, e2', ts) <- exprIsLambda_maybe in_scope_env casted_e2 -- See Note [Lambdas in the template] = let renv' = rnMatchBndr2 renv x1 x2 subst' = subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts } ===================================== testsuite/tests/simplCore/should_compile/T23630.hs ===================================== @@ -0,0 +1,17 @@ +module T23630 where + +data HOLType = UTypeIn !HOLType deriving Eq + +tyVars :: HOLType -> [HOLType] +tyVars (UTypeIn tv) = [undefined] + +union :: Eq a => [a] -> [a] -> [a] +union l1 l2 = foldr insert l2 l1 + +insert :: Eq a => a -> [a] -> [a] +insert x l + | x `elem` l = l + | otherwise = x : l + +catTyVars :: [HOLType] -> [HOLType] +catTyVars = foldr (union . tyVars) [] ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -472,6 +472,7 @@ test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-agg test('T22802', normal, compile, ['-O']) test('T15205', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppress-uniques']) test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) +test('T23630', normal, compile, ['-O']) test('T23012', normal, compile, ['-O']) test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f5538a8e2a8b9bc490bcd098fa38f6f7e9f4d73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f5538a8e2a8b9bc490bcd098fa38f6f7e9f4d73 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:26:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:26:34 -0400 Subject: [Git][ghc/ghc][master] Add a test for #23413 Message-ID: <64bb4c6a75122_17b24eb7ffc15555@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 2 changed files: - + testsuite/tests/typecheck/should_compile/T23413.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== testsuite/tests/typecheck/should_compile/T23413.hs ===================================== @@ -0,0 +1,13 @@ +module T23413 where + +f :: (Int ~ Bool) => Int -> Bool +f x = f x + +g1 :: (Int ~ Bool) => Int -> Bool +g1 x = f x + +g2 :: (Bool ~ Int) => Int -> Bool +g2 x = f x + +h :: (Int ~ Bool) => Int -> Bool +h x = x ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -888,3 +888,4 @@ test('T23514c', normal, compile, ['']) test('T22537', normal, compile, ['']) test('T18986a', normal, compile, ['']) test('T18986b', normal, compile, ['']) +test('T23413', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ad8d59769a873a54d594b2b45205f8f10d3d813 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ad8d59769a873a54d594b2b45205f8f10d3d813 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:27:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:27:22 -0400 Subject: [Git][ghc/ghc][master] Finish migration of diagnostics in GHC.Tc.Validity Message-ID: <64bb4c9a761ea_17b24eb80601588a5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 30 changed files: - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - testsuite/tests/dependent/should_fail/BadTelescope.stderr - testsuite/tests/dependent/should_fail/BadTelescope3.stderr - testsuite/tests/dependent/should_fail/BadTelescope4.stderr - testsuite/tests/dependent/should_fail/T14066f.stderr - testsuite/tests/dependent/should_fail/T14066g.stderr - testsuite/tests/dependent/should_fail/T15591b.stderr - testsuite/tests/dependent/should_fail/T15591c.stderr - testsuite/tests/dependent/should_fail/T15743c.stderr - testsuite/tests/dependent/should_fail/T15743d.stderr - testsuite/tests/deriving/should_fail/T23522.stderr - testsuite/tests/indexed-types/should_compile/T11361a.stderr - testsuite/tests/indexed-types/should_fail/ExplicitForAllFams4a.stderr - testsuite/tests/indexed-types/should_fail/ExplicitForAllFams4b.stderr - testsuite/tests/indexed-types/should_fail/Overlap4.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail3a.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e05f6df938c62d265212abe97ac80c56154ba72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e05f6df938c62d265212abe97ac80c56154ba72 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:27:53 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:27:53 -0400 Subject: [Git][ghc/ghc][master] ci: Enable some more jobs to run in a marge batch Message-ID: <64bb4cb9e7d70_17b24eb80101620b2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -433,6 +433,7 @@ hadrian-multi: - cabal-cache rules: - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' ############################################################ # stack-hadrian-build @@ -831,6 +832,7 @@ perf-nofib: - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' tags: - x86_64-linux before_script: @@ -898,6 +900,7 @@ perf: - out rules: - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' ############################################################ # ABI testing @@ -938,6 +941,7 @@ abi-test: - out rules: - if: '$CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/' + - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' ############################################################ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4876fddcadf7cd01e565acb4befb247bd8accc29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4876fddcadf7cd01e565acb4befb247bd8accc29 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:28:32 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:28:32 -0400 Subject: [Git][ghc/ghc][master] user_guide/flags.py: python-3.12 no longer includes distutils Message-ID: <64bb4ce07334f_17b24eb80b0165547@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - 1 changed file: - docs/users_guide/flags.py Changes: ===================================== docs/users_guide/flags.py ===================================== @@ -50,7 +50,7 @@ import sphinx from sphinx import addnodes from sphinx.domains.std import GenericObject from sphinx.errors import SphinxError -from distutils.version import LooseVersion +from packaging.version import parse from utils import build_table_from_list import os.path @@ -628,8 +628,8 @@ def purge_flags(app, env, docname): def setup(app): # The override argument to add_directive_to_domain is only supported by >= 1.8 - sphinx_version = LooseVersion(sphinx.__version__) - override_arg = {'override': True} if sphinx_version >= LooseVersion('1.8') else {} + sphinx_version = parse(sphinx.__version__) + override_arg = {'override': True} if sphinx_version >= parse('1.8') else {} # Add ghc-flag directive, and override the class with our own app.add_object_type('ghc-flag', 'ghc-flag') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/026991d7fcf9e3ce013081ab6d1e3d2200b694bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/026991d7fcf9e3ce013081ab6d1e3d2200b694bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:29:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 21 Jul 2023 23:29:10 -0400 Subject: [Git][ghc/ghc][master] ci: Mention ~full-ci label in MR template Message-ID: <64bb4d06e6db2_17b24eb80101690da@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 1 changed file: - .gitlab/merge_request_templates/Default.md Changes: ===================================== .gitlab/merge_request_templates/Default.md ===================================== @@ -25,6 +25,10 @@ If you have any questions don't hesitate to open your merge request and inquire in a comment. If your patch isn't quite done yet please do add prefix your MR title with `WIP:`. +By default a minimal validation pipeline is run on each merge request, the ~full-ci +label can be applied to perform additional validation checks if your MR affects a more +unusual configuration. + Once your change is ready please remove the `WIP:` tag and wait for review. If no one has offerred review in a few days then please leave a comment mentioning @triagers and apply the ~"Blocked on Review" label. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b91bbc2bc9a736d8d41f9cc14f0a95b9c595a01b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b91bbc2bc9a736d8d41f9cc14f0a95b9c595a01b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 03:54:10 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 21 Jul 2023 23:54:10 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack Message-ID: <64bb52e2c559b_17b24eb807417361c@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 5d6137c6 by Finley McIlwaine at 2023-07-21T21:53:11-06:00 Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack The -finfo-table-map-omit-stack flag omits STACK info tables from the info table map, and the -finfo-table-map-omit-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase, the build results were about 7% smaller when both of those tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. Fixes #23702 - - - - - 12 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d6137c683d2e793295826b11b058cf4d3ed85cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d6137c683d2e793295826b11b058cf4d3ed85cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 08:17:46 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sat, 22 Jul 2023 04:17:46 -0400 Subject: [Git][ghc/ghc][wip/misc-cleanup7] 14 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64bb90aa492b_17b24eb808818791b@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/misc-cleanup7 at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 509860a7 by Krzysztof Gogolewski at 2023-07-22T10:17:18+02:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b52478de8513b7f81ce3b1cf0a1033cf770b6ff...509860a7fcc02352982b65d714fed9ed2253809d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7b52478de8513b7f81ce3b1cf0a1033cf770b6ff...509860a7fcc02352982b65d714fed9ed2253809d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 14:05:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 22 Jul 2023 10:05:52 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64bbe2406eb84_17b24eb80882156f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 638ff4e3 by sheaf at 2023-07-22T10:05:48-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - 770f6a8e by sheaf at 2023-07-22T10:05:48-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - 720a100d by sheaf at 2023-07-22T10:05:48-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - 7dab92f8 by Krzysztof Gogolewski at 2023-07-22T10:05:48-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/flags.py The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e91cbb05ff4850e7d349577c066525a8bf60316...7dab92f87dddcafc396cd434f09d7c4d22e1f5a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e91cbb05ff4850e7d349577c066525a8bf60316...7dab92f87dddcafc396cd434f09d7c4d22e1f5a2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 15:46:14 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 22 Jul 2023 11:46:14 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] 18 commits: Remove unused files in .gitlab Message-ID: <64bbf9c67f395_17b24eb8060227450@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 023b15b3 by Vladislav Zavialov at 2023-07-22T17:11:59+02:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 30 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/StgToCmm/Prim.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f6602026512b62a8a571a1fa662e850ab07669c...023b15b354ed0e669e8eefc1dd829d344e8d9306 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f6602026512b62a8a571a1fa662e850ab07669c...023b15b354ed0e669e8eefc1dd829d344e8d9306 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 16:06:35 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Sat, 22 Jul 2023 12:06:35 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack Message-ID: <64bbfe8bda505_17b24eb8088232064@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 8f9554b8 by Finley McIlwaine at 2023-07-22T10:05:58-06:00 Add -finfo-table-map-omit-fallback -finfo-table-map-omit-stack The -finfo-table-map-omit-stack flag omits STACK info tables from the info table map, and the -finfo-table-map-omit-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase, the build results were about 7% smaller when both of those tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. Fixes #23702 - - - - - 12 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f9554b810c96f08e9b1c2e1089581671fa41fd2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f9554b810c96f08e9b1c2e1089581671fa41fd2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 16:08:23 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 22 Jul 2023 12:08:23 -0400 Subject: [Git][ghc/ghc][wip/testsuite-no-cusks] 217 commits: Update documentation for `<**>` Message-ID: <64bbfef756a73_17b24eb804c232494@gitlab.mail> Vladislav Zavialov pushed to branch wip/testsuite-no-cusks at Glasgow Haskell Compiler / GHC Commits: 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 4faeff14 by Vladislav Zavialov at 2023-07-22T19:04:07+03:00 Deprecate and disable CUSKs - - - - - e38eb94b by Vladislav Zavialov at 2023-07-22T19:04:07+03:00 Update test: T11811 - - - - - a0879391 by Vladislav Zavialov at 2023-07-22T19:06:09+03:00 Update test: T18308 - - - - - 42b74972 by Vladislav Zavialov at 2023-07-22T19:06:09+03:00 Update test: T19564d - - - - - 7ce0eb11 by Vladislav Zavialov at 2023-07-22T19:06:09+03:00 Update test: T20916 - - - - - 1c315513 by Vladislav Zavialov at 2023-07-22T19:06:09+03:00 Update test: T22560d - - - - - e1e3a8f4 by Vladislav Zavialov at 2023-07-22T19:06:28+03:00 Update test: tcfail225 - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - − .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88506e7c294a5720b623778d4a9491a34e68e062...e1e3a8f45c58dd2cf40b9662a8bdb6ce4f8395ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88506e7c294a5720b623778d4a9491a34e68e062...e1e3a8f45c58dd2cf40b9662a8bdb6ce4f8395ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 16:36:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 22 Jul 2023 12:36:29 -0400 Subject: [Git][ghc/ghc][master] 3 commits: RTS: declare setKeepCAFs symbol Message-ID: <64bc058d9eb45_17b24eb7ffc238874@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - 4 changed files: - rts/RtsSymbols.c - testsuite/tests/ghci/should_run/all.T - testsuite/tests/plugins/all.T - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== rts/RtsSymbols.c ===================================== @@ -946,6 +946,7 @@ extern char **environ; SymI_HasProto(arenaAlloc) \ SymI_HasProto(arenaFree) \ SymI_HasProto(rts_clearMemory) \ + SymI_HasProto(setKeepCAFs) \ RTS_USER_SIGNALS_SYMBOLS \ RTS_INTCHAR_SYMBOLS ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -46,7 +46,7 @@ test('T15369', just_ghci, ghci_script, ['T15369.script']) test('T15633a', [extra_files(['tc-plugin-ghci/']), - when(opsys('mingw32'), [multi_cpu_race, fragile(16813)]), + when(opsys('mingw32'), [multi_cpu_race]), only_ways(['ghci']), pre_cmd('$MAKE -s --no-print-directory -C tc-plugin-ghci package.plugins01 TOP={top}'), extra_hc_opts("-package-db tc-plugin-ghci/pkg.plugins01/local.package.conf -fplugin TcPluginGHCi") @@ -55,7 +55,7 @@ test('T15633a', test('T15633b', [extra_files(['tc-plugin-ghci/']), - when(opsys('mingw32'), [multi_cpu_race, fragile(16813)]), + when(opsys('mingw32'), [multi_cpu_race]), only_ways(['ghci']), pre_cmd('$MAKE -s --no-print-directory -C tc-plugin-ghci package.plugins01 TOP={top}'), extra_hc_opts("-package-db tc-plugin-ghci/pkg.plugins01/local.package.conf") ===================================== testsuite/tests/plugins/all.T ===================================== @@ -9,11 +9,6 @@ setTestOpts([ # sequentially until this is fixed. This likely means that #13194 isn't fully # solved. See also #15313. when(opsys('mingw32'), multi_cpu_race), - # Unfortunately even with the above these tests are incredibly flaky on Windows. - # In any given testsuite run at least half a dozen fail for one reason of another - # (typically a cmmbination of timeouts, some missing static archive errors from ld, - # and a few plain crashes). - when(opsys('mingw32'), fragile(16405)) ]) @@ -103,13 +98,11 @@ test('plugins15', test('T10420', [extra_files(['rule-defining-plugin/']), - when(opsys('mingw32'), expect_broken(21322)), pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.T10420 TOP={top}')], makefile_test, []) test('T10294', [extra_files(['annotation-plugin/']), - pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294 TOP={top}')], makefile_test, []) @@ -262,13 +255,11 @@ test('T20218b', test('test-defaulting-plugin', [extra_files(['defaulting-plugin/']), - when(opsys('mingw32'), fragile(21293)), pre_cmd('$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}')], makefile_test, []) test('test-defaulting-plugin-fail', [extra_files(['defaulting-plugin/']), - when(opsys('mingw32'), fragile(21293)), pre_cmd('$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin-fail TOP={top}')], makefile_test, []) @@ -319,7 +310,7 @@ test('test-echo-in-line-many-args', test('plugins-external', [extra_files(['shared-plugin/']), pre_cmd('$MAKE -s --no-print-directory -C shared-plugin package.plugins01 TOP={top}'), - when(opsys('linux') and not ghc_dynamic(), expect_broken(20706))], + when(opsys('mingw32') or (opsys('linux') and not ghc_dynamic()), expect_broken(20706))], makefile_test, []) test('test-phase-hooks-plugin', ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -151,7 +151,7 @@ test('T7702', # a large effect on allocation which is hard to separate from the # allocation done by the plugin... but a regression allocates > 90mb collect_compiler_stats('peak_megabytes_allocated',70), - when(opsys('mingw32'), fragile_for(16799, ['normal'])), + when(opsys('mingw32'), [multi_cpu_race]), req_interp ], compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b91bbc2bc9a736d8d41f9cc14f0a95b9c595a01b...cb9c93d7b8db816ed4271b3703b863c1cfbbcc45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b91bbc2bc9a736d8d41f9cc14f0a95b9c595a01b...cb9c93d7b8db816ed4271b3703b863c1cfbbcc45 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 16:36:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 22 Jul 2023 12:36:58 -0400 Subject: [Git][ghc/ghc][master] Misc cleanup Message-ID: <64bc05aadabf8_17b24eb804c2442a7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 13 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Type.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Instance/FunDeps.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - libraries/base/GHC/Exts.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -716,14 +716,6 @@ ltTag_RDR = nameRdrName ordLTDataConName eqTag_RDR = nameRdrName ordEQDataConName gtTag_RDR = nameRdrName ordGTDataConName -eqClass_RDR, numClass_RDR, ordClass_RDR, enumClass_RDR, monadClass_RDR - :: RdrName -eqClass_RDR = nameRdrName eqClassName -numClass_RDR = nameRdrName numClassName -ordClass_RDR = nameRdrName ordClassName -enumClass_RDR = nameRdrName enumClassName -monadClass_RDR = nameRdrName monadClassName - map_RDR, append_RDR :: RdrName map_RDR = nameRdrName mapName append_RDR = nameRdrName appendName @@ -750,41 +742,10 @@ enumFromTo_RDR = nameRdrName enumFromToName enumFromThen_RDR = nameRdrName enumFromThenName enumFromThenTo_RDR = nameRdrName enumFromThenToName -ratioDataCon_RDR, integerAdd_RDR, integerMul_RDR :: RdrName -ratioDataCon_RDR = nameRdrName ratioDataConName -integerAdd_RDR = nameRdrName integerAddName -integerMul_RDR = nameRdrName integerMulName - -ioDataCon_RDR :: RdrName -ioDataCon_RDR = nameRdrName ioDataConName - -newStablePtr_RDR :: RdrName -newStablePtr_RDR = nameRdrName newStablePtrName - -bindIO_RDR, returnIO_RDR :: RdrName -bindIO_RDR = nameRdrName bindIOName -returnIO_RDR = nameRdrName returnIOName - -fromInteger_RDR, fromRational_RDR, minus_RDR, times_RDR, plus_RDR :: RdrName -fromInteger_RDR = nameRdrName fromIntegerName -fromRational_RDR = nameRdrName fromRationalName -minus_RDR = nameRdrName minusName +times_RDR, plus_RDR :: RdrName times_RDR = varQual_RDR gHC_NUM (fsLit "*") plus_RDR = varQual_RDR gHC_NUM (fsLit "+") -toInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName -toInteger_RDR = nameRdrName toIntegerName -toRational_RDR = nameRdrName toRationalName -fromIntegral_RDR = nameRdrName fromIntegralName - -fromString_RDR :: RdrName -fromString_RDR = nameRdrName fromStringName - -fromList_RDR, fromListN_RDR, toList_RDR :: RdrName -fromList_RDR = nameRdrName fromListName -fromListN_RDR = nameRdrName fromListNName -toList_RDR = nameRdrName toListName - compose_RDR :: RdrName compose_RDR = varQual_RDR gHC_BASE (fsLit ".") ===================================== compiler/GHC/Builtin/Names/TH.hs ===================================== @@ -1147,29 +1147,7 @@ bndrInvisKey = mkPreludeMiscIdUnique 801 ************************************************************************ -} -lift_RDR, liftTyped_RDR, mkNameG_dRDR, mkNameG_vRDR, mkNameG_fldRDR, - unsafeCodeCoerce_RDR :: RdrName +lift_RDR, liftTyped_RDR, unsafeCodeCoerce_RDR :: RdrName lift_RDR = nameRdrName liftName liftTyped_RDR = nameRdrName liftTypedName unsafeCodeCoerce_RDR = nameRdrName unsafeCodeCoerceName -mkNameG_dRDR = nameRdrName mkNameG_dName -mkNameG_vRDR = nameRdrName mkNameG_vName -mkNameG_fldRDR = nameRdrName mkNameG_fldName - --- data Exp = ... -conE_RDR, litE_RDR, appE_RDR, infixApp_RDR :: RdrName -conE_RDR = nameRdrName conEName -litE_RDR = nameRdrName litEName -appE_RDR = nameRdrName appEName -infixApp_RDR = nameRdrName infixAppName - --- data Lit = ... -stringL_RDR, intPrimL_RDR, wordPrimL_RDR, floatPrimL_RDR, - doublePrimL_RDR, stringPrimL_RDR, charPrimL_RDR :: RdrName -stringL_RDR = nameRdrName stringLName -intPrimL_RDR = nameRdrName intPrimLName -wordPrimL_RDR = nameRdrName wordPrimLName -floatPrimL_RDR = nameRdrName floatPrimLName -doublePrimL_RDR = nameRdrName doublePrimLName -stringPrimL_RDR = nameRdrName stringPrimLName -charPrimL_RDR = nameRdrName charPrimLName ===================================== compiler/GHC/Core.hs ===================================== @@ -451,7 +451,7 @@ TL;DR: we relaxed the let/app invariant to become the let-can-float invariant. Note [Core top-level string literals] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ As an exception to the usual rule that top-level binders must be lifted, -we allow binding primitive string literals (of type Addr#) of type Addr# at the +we allow binding primitive string literals (of type Addr#) at the top level. This allows us to share string literals earlier in the pipeline and crucially allows other optimizations in the Core2Core pipeline to fire. Consider, @@ -629,7 +629,7 @@ Note [Representation polymorphism invariants] GHC allows us to abstract over calling conventions using **representation polymorphism**. For example, we have: - ($) :: forall (r :: RuntimeRep) (a :: Type) (b :: TYPE r). a -> b -> b + ($) :: forall (r :: RuntimeRep) (a :: Type) (b :: TYPE r). (a -> b) -> a -> b In this example, the type `b` is representation-polymorphic: it has kind `TYPE r`, where the type variable `r :: RuntimeRep` abstracts over the runtime representation @@ -662,14 +662,14 @@ Note that these two invariants require us to check other types than just the types of bound variables and types of function arguments, due to transformations that GHC performs. For example, the definition - myCoerce :: forall {r1 r2} (a :: TYPE r1) (b :: TYPE r2). Coercible a b => a -> b + myCoerce :: forall {r} (a :: TYPE r) (b :: TYPE r). Coercible a b => a -> b myCoerce = coerce is invalid, because `coerce` has no binding (see GHC.Types.Id.Make.coerceId). So, before code-generation, GHC saturates the RHS of 'myCoerce' by performing an eta-expansion (see GHC.CoreToStg.Prep.maybeSaturate): - myCoerce = \ (x :: TYPE r1) -> coerce x + myCoerce = \ (x :: TYPE r) -> coerce x However, this transformation would be invalid, because now the binding of x in the lambda abstraction would violate I1. ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -828,7 +828,7 @@ runtimeRepLevity_maybe rep -- Splitting Levity -------------------------------------------- --- | `levity_maybe` takes a Type of kind Levity, and returns its levity +-- | `levityType_maybe` takes a Type of kind Levity, and returns its levity -- May not be possible for a type variable or type family application levityType_maybe :: LevityType -> Maybe Levity levityType_maybe lev ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -58,7 +58,6 @@ import GHC.Builtin.Types.Prim import GHC.Builtin.Names import GHC.Data.FastString -import GHC.Data.Pair import GHC.Data.Maybe import GHC.Utils.Outputable @@ -83,7 +82,7 @@ dsJsFExport dsJsFExport fn_id co ext_name cconv isDyn = do let - ty = pSnd $ coercionKind co + ty = coercionRKind co (_tvs,sans_foralls) = tcSplitForAllTyVars ty (fe_arg_tys', orig_res_ty) = tcSplitFunTys sans_foralls -- We must use tcSplits here, because we want to see @@ -242,7 +241,7 @@ dsJsImport -> Maybe Header -> DsM ([Binding], CHeader, CStub) dsJsImport id co (CLabel cid) cconv _ _ = do - let ty = pFst $ coercionKind co + let ty = coercionLKind co fod = case tyConAppTyCon_maybe (dropForAlls ty) of Just tycon | tyConUnique tycon == funPtrTyConKey -> @@ -272,7 +271,7 @@ dsJsFExportDynamic :: Id -> DsM ([Binding], CHeader, CStub) dsJsFExportDynamic id co0 cconv = do let - ty = pFst (coercionKind co0) + ty = coercionLKind co0 (tvs,sans_foralls) = tcSplitForAllTyVars ty ([Scaled arg_mult arg_ty], fn_res_ty) = tcSplitFunTys sans_foralls (io_tc, res_ty) = expectJust "dsJsFExportDynamic: IO type expected" @@ -342,7 +341,7 @@ dsJsCall :: Id -> Coercion -> ForeignCall -> Maybe Header -> DsM ([(Id, Expr TyVar)], CHeader, CStub) dsJsCall fn_id co (CCall (CCallSpec target cconv safety)) _mDeclHeader = do let - ty = pFst $ coercionKind co + ty = coercionLKind co (tv_bndrs, rho) = tcSplitForAllTyVarBinders ty (arg_tys, io_res_ty) = tcSplitFunTys rho ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -34,7 +34,7 @@ module GHC.Tc.Deriv.Generate ( gen_Newtype_fam_insts, mkCoerceClassMethEqn, genAuxBinds, - ordOpTbl, boxConTbl, litConTbl, + ordOpTbl, boxConTbl, mkRdrFunBind, mkRdrFunBindEC, mkRdrFunBindSE, error_Expr, getPossibleDataCons, @@ -2363,7 +2363,7 @@ box :: String -- The class involved -> Type -- The argument type -> LHsExpr GhcPs -- Boxed version of the arg -- See Note [Deriving and unboxed types] in GHC.Tc.Deriv.Infer -box cls_str arg arg_ty = assoc_ty_id cls_str boxConTbl arg_ty arg +box cls_str arg arg_ty = nlHsApp (assoc_ty_id cls_str boxConTbl arg_ty) arg --------------------- primOrdOps :: String -- The class involved @@ -2403,23 +2403,22 @@ ordOpTbl ,(doublePrimTy, (ltDouble_RDR, leDouble_RDR , eqDouble_RDR, geDouble_RDR, gtDouble_RDR)) ] --- A mapping from a primitive type to a function that constructs its boxed --- version. -boxConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] +-- A mapping from a primitive type to a DataCon of its boxed version. +boxConTbl :: [(Type, LHsExpr GhcPs)] boxConTbl = - [ (charPrimTy , nlHsApp (nlHsVar $ getRdrName charDataCon)) - , (intPrimTy , nlHsApp (nlHsVar $ getRdrName intDataCon)) - , (wordPrimTy , nlHsApp (nlHsVar $ getRdrName wordDataCon )) - , (floatPrimTy , nlHsApp (nlHsVar $ getRdrName floatDataCon )) - , (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon)) - , (int8PrimTy, nlHsApp (nlHsVar int8DataCon_RDR)) - , (word8PrimTy, nlHsApp (nlHsVar word8DataCon_RDR)) - , (int16PrimTy, nlHsApp (nlHsVar int16DataCon_RDR)) - , (word16PrimTy, nlHsApp (nlHsVar word16DataCon_RDR)) - , (int32PrimTy, nlHsApp (nlHsVar int32DataCon_RDR)) - , (word32PrimTy, nlHsApp (nlHsVar word32DataCon_RDR)) - , (int64PrimTy, nlHsApp (nlHsVar int64DataCon_RDR)) - , (word64PrimTy, nlHsApp (nlHsVar word64DataCon_RDR)) + [ (charPrimTy , nlHsVar $ getRdrName charDataCon) + , (intPrimTy , nlHsVar $ getRdrName intDataCon) + , (wordPrimTy , nlHsVar $ getRdrName wordDataCon) + , (floatPrimTy , nlHsVar $ getRdrName floatDataCon) + , (doublePrimTy, nlHsVar $ getRdrName doubleDataCon) + , (int8PrimTy, nlHsVar int8DataCon_RDR) + , (word8PrimTy, nlHsVar word8DataCon_RDR) + , (int16PrimTy, nlHsVar int16DataCon_RDR) + , (word16PrimTy, nlHsVar word16DataCon_RDR) + , (int32PrimTy, nlHsVar int32DataCon_RDR) + , (word32PrimTy, nlHsVar word32DataCon_RDR) + , (int64PrimTy, nlHsVar int64DataCon_RDR) + , (word64PrimTy, nlHsVar word64DataCon_RDR) ] @@ -2443,26 +2442,6 @@ postfixModTbl ,(word64PrimTy, "#Word64") ] -litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] -litConTbl - = [(charPrimTy , nlHsApp (nlHsVar charPrimL_RDR)) - ,(intPrimTy , nlHsApp (nlHsVar intPrimL_RDR) - . nlHsApp (nlHsVar toInteger_RDR)) - ,(wordPrimTy , nlHsApp (nlHsVar wordPrimL_RDR) - . nlHsApp (nlHsVar toInteger_RDR)) - ,(addrPrimTy , nlHsApp (nlHsVar stringPrimL_RDR) - . nlHsApp (nlHsApp - (nlHsVar map_RDR) - (compose_RDR `nlHsApps` - [ nlHsVar fromIntegral_RDR - , nlHsVar fromEnum_RDR - ]))) - ,(floatPrimTy , nlHsApp (nlHsVar floatPrimL_RDR) - . nlHsApp (nlHsVar toRational_RDR)) - ,(doublePrimTy, nlHsApp (nlHsVar doublePrimL_RDR) - . nlHsApp (nlHsVar toRational_RDR)) - ] - -- | Lookup `Type` in an association list. assoc_ty_id :: HasCallStack => String -- The class involved -> [(Type,a)] -- The table ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -3552,7 +3552,7 @@ filterConstrainedCandidates -> TcM CandidatesQTvs -- filterConstrainedCandidates removes any candidates that are free in -- 'wanted'; instead, it promotes them. This bit is very much like --- decideMonoTyVars in GHC.Tc.Solver, but constraints are so much +-- decidePromotedTyVars in GHC.Tc.Solver, but constraints are so much -- simpler in kinds, it is much easier here. (In particular, we never -- quantify over a constraint in a type.) filterConstrainedCandidates wanted dvs ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1058,7 +1058,7 @@ tcPatSynPat (L con_span con_name) pat_syn pat_ty penv arg_pats thing_inside -- 'tcDataConPat'.) ; let bad_arg_tys :: [(Int, Scaled Type)] - bad_arg_tys = filter (\ (_, Scaled _ arg_ty) -> typeLevity_maybe arg_ty == Nothing) + bad_arg_tys = filter (\ (_, Scaled _ arg_ty) -> not (typeHasFixedRuntimeRep arg_ty)) $ zip [0..] arg_tys' ; massertPpr (null bad_arg_tys) $ vcat [ text "tcPatSynPat: pattern arguments do not have a fixed RuntimeRep" ===================================== compiler/GHC/Tc/Instance/FunDeps.hs ===================================== @@ -527,7 +527,7 @@ also know `t2` and the other way. closeWrtFunDeps is used - when checking the coverage condition for an instance declaration - when determining which tyvars are unquantifiable during generalization, in - GHC.Tc.Solver.decideMonoTyVars. + GHC.Tc.Solver.decidePromotedTyVars. Note [Equality superclasses] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1717,7 +1717,7 @@ we leave it alone. Note that not *every* variable with a higher level will get generalised, either due to the monomorphism restriction or other -quirks. See, for example, the code in GHC.Tc.Solver.decideMonoTyVars +quirks. See, for example, the code in GHC.Tc.Solver.decidePromotedTyVars and in GHC.Tc.Gen.HsType.kindGeneralizeSome, both of which exclude certain otherwise-eligible variables from being generalised. ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -2001,8 +2001,8 @@ being the ) -} tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type) --- (tcSplitIOType_maybe t) returns Just (IO,t',co) --- if co : t ~ IO t' +-- (tcSplitIOType_maybe t) returns Just (IO,t') +-- if t = IO t' -- returns Nothing otherwise tcSplitIOType_maybe ty = case tcSplitTyConApp_maybe ty of ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1194,7 +1194,7 @@ zonk_cmd_top (HsCmdTop (CmdTopTc stack_tys ty ids) cmd) new_ty <- zonkTcTypeToTypeX ty new_ids <- mapSndM zonkExpr ids - massert (isLiftedTypeKind (typeKind new_stack_tys)) + massert (definitelyLiftedType new_stack_tys) -- desugarer assumes that this is not representation-polymorphic... -- but indeed it should always be lifted due to the typing -- rules for arrows ===================================== libraries/base/GHC/Exts.hs ===================================== View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7349217fb9a992ad1c0e0d6ce1ab78e29dbe144 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7349217fb9a992ad1c0e0d6ce1ab78e29dbe144 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 17:58:40 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Sat, 22 Jul 2023 13:58:40 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-with-fallback -finfo-table-map-with-stack Message-ID: <64bc18d068e2_17b24eb8038260493@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 8248bef4 by Finley McIlwaine at 2023-07-22T11:53:11-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 14 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/phases.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8248bef45cafe5dfdb9072cde3a459f1f1d03d8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8248bef45cafe5dfdb9072cde3a459f1f1d03d8f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 18:13:01 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Sat, 22 Jul 2023 14:13:01 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-with-fallback -finfo-table-map-with-stack Message-ID: <64bc1c2d67b3a_17b24eb8038262421@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 4cca7a11 by Finley McIlwaine at 2023-07-22T12:12:49-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 15 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/phases.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4cca7a11e67b24df5a31ab02c7fec249a19bcde6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4cca7a11e67b24df5a31ab02c7fec249a19bcde6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 19:04:10 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Sat, 22 Jul 2023 15:04:10 -0400 Subject: [Git][ghc/ghc][wip/t23702] 19 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64bc282a9ed7d_17b24eb809c26834b@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 202641b3 by Finley McIlwaine at 2023-07-22T12:33:46-06:00 Add -dipe-stats flag This is useful for seeing which info tables have information. - - - - - 56606da4 by Finley McIlwaine at 2023-07-22T12:33:46-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Module.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cca7a11e67b24df5a31ab02c7fec249a19bcde6...56606da45ce3f800fc84d21f2b5be7bc917d2d85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4cca7a11e67b24df5a31ab02c7fec249a19bcde6...56606da45ce3f800fc84d21f2b5be7bc917d2d85 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 19:47:54 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Sat, 22 Jul 2023 15:47:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/haddock-optimizations Message-ID: <64bc326a6d5b5_17b24eb80882717fa@gitlab.mail> Finley McIlwaine pushed new branch wip/haddock-optimizations at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/haddock-optimizations You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 22 22:38:04 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 22 Jul 2023 18:38:04 -0400 Subject: [Git][ghc/ghc][wip/T22404] Small improvement Message-ID: <64bc5a4c721ce_17b24eb804c2839a7@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 2d15bc68 by Simon Peyton Jones at 2023-07-22T23:37:43+01:00 Small improvement - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2181,12 +2181,10 @@ occ_anal_lam_tail env expr@(Lam {}) in go env1 (bndr1 : rev_bndrs) expr go env rev_bndrs expr - = let bndrs = reverse rev_bndrs in - addInScope env bndrs $ \env -> + = addInScope env rev_bndrs $ \env -> let !(WUD usage expr') = occ_anal_lam_tail env expr - bndrs' = tagLamBinders usage bndrs - in WUD (usage `addLamCoVarOccs` bndrs) - (mkLams bndrs' expr') + in WUD (usage `addLamCoVarOccs` rev_bndrs) + (foldl (\e b -> Lam (tagLamBinder usage b) e) expr' rev_bndrs) -- addLamCoVarOccs: see Note [Gather occurrences of coercion variables] -- For casts, keep going in the same lambda-group @@ -2918,7 +2916,10 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a {-# INLINE addInScope #-} --- This function is called a lot, so we want to inline the fast path +-- This function is called a lot, so we inline it so we don't +-- have to allocate and then call the thing_inside +-- +-- NB: the order of binders does not matter addInScope env bndrs thing_inside = WUD uds' res where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d15bc68a24a560c4f14778ab09df0f320c97ac0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d15bc68a24a560c4f14778ab09df0f320c97ac0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 23 12:17:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 23 Jul 2023 08:17:36 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: RTS: declare setKeepCAFs symbol Message-ID: <64bd1a60793ab_17b24eb8088320777@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - abfd87a5 by Vladislav Zavialov at 2023-07-23T08:17:25-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - d3b4d28b by sheaf at 2023-07-23T08:17:31-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7dab92f87dddcafc396cd434f09d7c4d22e1f5a2...d3b4d28be6074513cc954bbb8bb661bb00e74f96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7dab92f87dddcafc396cd434f09d7c4d22e1f5a2...d3b4d28be6074513cc954bbb8bb661bb00e74f96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 23 14:01:17 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 23 Jul 2023 10:01:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23490 Message-ID: <64bd32ad1801a_17b24eb804c3325b4@gitlab.mail> Matthew Craven pushed new branch wip/T23490 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23490 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 23 14:16:42 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 23 Jul 2023 10:16:42 -0400 Subject: [Git][ghc/ghc][wip/T23490] Kill off gen_bytearray_addr_access_ops.py Message-ID: <64bd364a96bc9_17b24eb80743346db@gitlab.mail> Matthew Craven pushed to branch wip/T23490 at Glasgow Haskell Compiler / GHC Commits: 0ed8a76d by Matthew Craven at 2023-07-23T10:16:05-04:00 Kill off gen_bytearray_addr_access_ops.py Fixes #23490. The relevant primop descriptions are now generated directly by genprimopcode. - - - - - 8 changed files: - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Generate.hs - + utils/genprimopcode/AccessOps.hs - utils/genprimopcode/Lexer.x - utils/genprimopcode/Parser.y - utils/genprimopcode/ParserM.hs - utils/genprimopcode/genprimopcode.cabal Changes: ===================================== compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py deleted ===================================== @@ -1,201 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -# This script generates the primop descriptions for many similar ByteArray# -# and Addr# access operations. Its output is #include-d into primops.txt.pp. - -from typing import Optional, NamedTuple -import textwrap -import argparse - -arg_parser = argparse.ArgumentParser() -arg_parser.add_argument('addr_or_bytearray', - choices = ["addr-access-ops", "bytearray-access-ops"], - ) -arg_parser.add_argument('output_file', - type=argparse.FileType('w'), - metavar='FILE', - ) -args = arg_parser.parse_args() -write = args.output_file.write - - - -write(''' --- Do not edit. --- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. --- (The build system should take care of this for you.) - -''') - -class ElementType(NamedTuple): - name: str - rep_ty: str - desc: str - width: Optional[int] - -MACH_WORD = None - -element_types = [ - # (name, representation type, human description, width) - # - # width in bytes. - # width == None denotes machine word - - ElementType("Char", "Char#", "8-bit character", 1), - ElementType("WideChar", "Char#", "32-bit character", 4), - ElementType("Int", "Int#", "word-sized integer", MACH_WORD), - ElementType("Word", "Word#", "word-sized unsigned integer", MACH_WORD), - ElementType("Addr", "Addr#", "machine address", MACH_WORD), - ElementType("Float", "Float#", "single-precision floating-point value", 4), - ElementType("Double", "Double#", "double-precision floating-point value", 8), - ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), -] - -for n in [8,16,32,64]: - element_types += [ - ElementType(f"Int{n}", f"Int{n}#", - f"{n}-bit signed integer", n // 8), - ElementType(f"Word{n}", f"Word{n}#", - f"{n}-bit unsigned integer", n // 8) - ] - -def pretty_offset(n: Optional[int]) -> str: - if n == MACH_WORD: - return 'machine words' - elif n == 1: - return 'bytes' - else: - return f'{n}-byte words' - -def get_align_warn(n: ElementType) -> str: - if n.width == 1: - return '' - return ''' - On some platforms, the access may fail - for an insufficiently aligned @Addr#@. - ''' - -def print_block(template: str, **kwargs) -> None: - write(textwrap.dedent(template.format(**kwargs)).lstrip()) - write('\n') - -def header(s: str): - write('\n') - print_block(''' - ------------------------------------ - -- {s} - ------------------------------------ - ''', s=s) - -if args.addr_or_bytearray == "bytearray-access-ops": - header("ByteArray# operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in {offset}.}} - with can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned index operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in bytes.}} - with can_fail = True - ''', **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned read operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned write operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - -else: # addr_or_bytearray == "addr-access-ops": - header("Addr# access operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} -> State# s -> State# s - {{ Write a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1956,7 +1956,11 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-access-ops.txt.pp" + +bytearray_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2259,7 +2263,11 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -#include "addr-access-ops.txt.pp" + +addr_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,17 +32,6 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" -accessOpsSource :: FilePath -accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" - -byteArrayAccessOpsTxt :: Stage -> FilePath -byteArrayAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" - -addrAccessOpsTxt :: Stage -> FilePath -addrAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" - isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -153,21 +142,8 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do - let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage - let addr_ops_txt = root -/- addrAccessOpsTxt stage - ba_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "bytearray-access-ops", file] - [] [] - addr_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "addr-access-ops", file] - [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] - -- ba_ops_txt and addr_ops_txt get #include-d + need $ [primopsSource] build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== utils/genprimopcode/AccessOps.hs ===================================== @@ -0,0 +1,250 @@ +module AccessOps (byteArrayAccessOps, addrAccessOps) where + +import Syntax + +data ElementType = MkElementType + { elt_name :: String + , elt_rep_ty :: Ty + , elt_desc :: String + , elt_width :: Maybe Int + } + +machWord :: Maybe Int +machWord = Nothing + +strToTy :: String -> Ty +strToTy s = TyApp (TyCon s) [] + +elementTypes :: [ElementType] +elementTypes = + [ MkElementType "Char" (strToTy "Char#" ) "an 8-bit character" (Just 1) + , MkElementType "WideChar" (strToTy "Char#" ) "a 32-bit character" (Just 4) + , MkElementType "Int" (strToTy "Int#" ) "a word-sized integer" machWord + , MkElementType "Word" (strToTy "Word#" ) "a word-sized unsigned integer" machWord + , MkElementType "Addr" (strToTy "Addr#" ) "a machine address" machWord + , MkElementType "Float" (strToTy "Float#" ) "a single-precision floating-point value" (Just 4) + , MkElementType "Double" (strToTy "Double#") "a double-precision floating-point value" (Just 8) + , MkElementType "StablePtr" (TyApp (TyCon "StablePtr#") [TyVar "a"]) + "a 'StablePtr#' value" machWord + ] ++ do + n <- [8, 16, 32, 64] + let mkDesc suff = (if n == 8 then "an " else "a ") ++ shows n suff + [ MkElementType + { elt_name = "Int" ++ show n + , elt_rep_ty = strToTy $ "Int" ++ shows n "#" + , elt_desc = mkDesc "-bit signed integer" + , elt_width = Just (n `quot` 8) + }, + MkElementType + { elt_name = "Word" ++ show n + , elt_rep_ty = strToTy $ "Word" ++ shows n "#" + , elt_desc = mkDesc "-bit unsigned integer" + , elt_width = Just (n `quot` 8) + } + ] + +unalignedElementTypes :: [ElementType] +unalignedElementTypes + = filter (\e -> elt_name e `notElem` ["Int8", "Word8"]) elementTypes +--unalignedElementTypes = filter (\e -> elt_width e /= Just 1) elementTypes + +prettyOffset :: ElementType -> String +prettyOffset e = case elt_width e of + Nothing -> "machine words" + Just 1 -> "bytes" + Just n -> shows n "-byte words" + +getAlignWarn :: ElementType -> String +getAlignWarn e = case elt_width e of + Just 1 -> "" + _ -> "On some platforms, the access may fail\n" + ++ "for an insufficiently aligned @Addr#@." + +mutableByteArrayS :: Ty +mutableByteArrayS = TyApp (TyCon "MutableByteArray#") [TyVar "s"] + +stateS :: Ty +stateS = TyApp (TyCon "State#") [TyVar "s"] + +readResTy :: ElementType -> Ty +readResTy e = TyF stateS (TyUTup [stateS, elt_rep_ty e]) + +writeResTy :: ElementType -> Ty +writeResTy e = TyF (elt_rep_ty e) (TyF stateS stateS) + + + +mkIndexByteArrayOp :: ElementType -> Entry +mkIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "Array#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail"] + } + +mkUnalignedIndexByteArrayOp :: ElementType -> Entry +mkUnalignedIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_Word8As" ++ elt_name e + , name = "indexWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } + +mkReadByteArrayOp :: ElementType -> Entry +mkReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedReadByteArrayOp :: ElementType -> Entry +mkUnalignedReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_Word8As" ++ elt_name e + , name = "readWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkWriteByteArrayOp :: ElementType -> Entry +mkWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedWriteByteArrayOp :: ElementType -> Entry +mkUnalignedWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_Word8As" ++ elt_name e + , name = "writeWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + + +byteArrayAccessOps :: [Entry] +byteArrayAccessOps + = map mkIndexByteArrayOp elementTypes + ++ map mkUnalignedIndexByteArrayOp unalignedElementTypes + ++ map mkReadByteArrayOp elementTypes + ++ map mkUnalignedReadByteArrayOp unalignedElementTypes + ++ map mkWriteByteArrayOp elementTypes + ++ map mkUnalignedWriteByteArrayOp unalignedElementTypes + + + +mkIndexOffAddrOp :: ElementType -> Entry +mkIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail"] + } + +{- +mkUnalignedIndexOffAddrOp :: ElementType -> Entry +mkUnalignedIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_Word8As" ++ elt_name e + , name = "indexWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } +-} + +mkReadOffAddrOp :: ElementType -> Entry +mkReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedReadOffAddrOp :: ElementType -> Entry +mkUnalignedReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_Word8As" ++ elt_name e + , name = "readWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + +mkWriteOffAddrOp :: ElementType -> Entry +mkWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedWriteOffAddrOp :: ElementType -> Entry +mkUnalignedWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_Word8As" ++ elt_name e + , name = "writeWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + + +addrAccessOps :: [Entry] +addrAccessOps + = map mkIndexOffAddrOp elementTypes +-- ++ map mkUnalignedIndexOffAddrOp unalignedElementTypes + ++ map mkReadOffAddrOp elementTypes +-- ++ map mkUnalignedReadOffAddrOp unalignedElementTypes + ++ map mkWriteOffAddrOp elementTypes +-- ++ map mkUnalignedWriteOffAddrOp unalignedElementTypes ===================================== utils/genprimopcode/Lexer.x ===================================== @@ -52,6 +52,8 @@ words :- <0> "infixr" { mkT TInfixR } <0> "Nothing" { mkT TNothing } <0> "vector" { mkT TVector } + <0> "bytearray_access_ops" { mkT TByteArrayAccessOps } + <0> "addr_access_ops" { mkT TAddrAccessOps } <0> "thats_all_folks" { mkT TThatsAllFolks } <0> "SCALAR" { mkT TSCALAR } <0> "VECTOR" { mkT TVECTOR } ===================================== utils/genprimopcode/Parser.y ===================================== @@ -5,6 +5,8 @@ import Lexer (lex_tok) import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos, happyError) import Syntax + +import AccessOps } %name parsex @@ -47,6 +49,8 @@ import Syntax SCALAR { TSCALAR } VECTOR { TVECTOR } VECTUPLE { TVECTUPLE } + bytearray_access_ops { TByteArrayAccessOps } + addr_access_ops { TAddrAccessOps } thats_all_folks { TThatsAllFolks } lowerName { TLowerName $$ } upperName { TUpperName $$ } @@ -83,8 +87,13 @@ pInfix : infix integer { Just $ Fixity NoSourceText $2 InfixN } pEntries :: { [Entry] } pEntries : pEntry pEntries { $1 : $2 } + | pAccessOps pEntries { $1 ++ $2 } | {- empty -} { [] } +pAccessOps :: { [Entry] } +pAccessOps : bytearray_access_ops { byteArrayAccessOps } + | addr_access_ops { addrAccessOps } + pEntry :: { Entry } pEntry : pPrimOpSpec { $1 } | pPrimTypeSpec { $1 } @@ -148,7 +157,7 @@ pVectors : pVector ',' pVectors { [$1] ++ $3 } pVector :: { (String, String, Int) } pVector : '<' upperName ',' upperName ',' integer '>' { ($2, $4, $6) } - + pType :: { Ty } pType : paT '->' pType { TyF $1 $3 } | paT '=>' pType { TyC $1 $3 } ===================================== utils/genprimopcode/ParserM.hs ===================================== @@ -98,6 +98,8 @@ data Token = TEOF | TFalse | TCompare | TGenPrimOp + | TByteArrayAccessOps + | TAddrAccessOps | TThatsAllFolks | TLowerName String | TUpperName String ===================================== utils/genprimopcode/genprimopcode.cabal ===================================== @@ -28,6 +28,7 @@ Executable genprimopcode Parser ParserM Syntax + AccessOps Build-Depends: base >= 4 && < 5, array if flag(build-tool-depends) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ed8a76ddb1ce196d39c6d2c903a5353dec55a9d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ed8a76ddb1ce196d39c6d2c903a5353dec55a9d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 23 14:27:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 23 Jul 2023 10:27:57 -0400 Subject: [Git][ghc/ghc][master] Visible forall in types of terms: Part 1 (#22326) Message-ID: <64bd38ed409ea_17b24eb8088338969@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33b6850aaaa4b3a4760d4b384cd15611b159045b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33b6850aaaa4b3a4760d4b384cd15611b159045b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 23 14:28:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 23 Jul 2023 10:28:38 -0400 Subject: [Git][ghc/ghc][master] Add test for #22424 Message-ID: <64bd3916a8907_17b24eb801034391c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 2 changed files: - + testsuite/tests/overloadedrecflds/should_compile/T22424.hs - testsuite/tests/overloadedrecflds/should_compile/all.T Changes: ===================================== testsuite/tests/overloadedrecflds/should_compile/T22424.hs ===================================== @@ -0,0 +1,40 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NoFieldSelectors #-} + +module T22424 where + +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +{- +data R1 = C1 { fld :: Bool } +data R2 = C2 { fld :: Bool } +fun x1 x2 = fld x1 && fld x2 -- referring to the two different 'fld's +-} + +$(do + let noBang = Bang NoSourceUnpackedness NoSourceStrictness + let mkData tn cn fn = (DataD [] tn [] Nothing [RecC cn [(fn, noBang, ConT ''Bool)]] [], fn) + (r1, fld1) <- mkData <$> newName "R1" <*> newName "C1" <*> newName "fld" + (r2, fld2) <- mkData <$> newName "R2" <*> newName "C2" <*> newName "fld" + fun <- newName "fun" + x1 <- newName "x1" + x2 <- newName "x2" + let expr = UInfixE (VarE fld1 `AppE` VarE x1) (VarE '(&&)) (VarE fld2 `AppE` VarE x2) + fun_decl = FunD fun [Clause [VarP x1, VarP x2] (NormalB expr) []] + pure [r1,r2,fun_decl] + ) + +$(do + let noBang = Bang NoSourceUnpackedness NoSourceStrictness + let mkData tn cn fn = (DataD [] tn [] Nothing [RecC cn [(fn, noBang, ConT ''Bool)]] [], fn) + (r1, fld1) <- mkData <$> newName "R1'" <*> newName "C1'" <*> pure (mkNameG_fld "me" "T22424" "C1'" "fld'") + (r2, fld2) <- mkData <$> newName "R2'" <*> newName "C2'" <*> pure (mkNameG_fld "me" "T22424" "C2'" "fld'") + fun <- newName "fun'" + x1 <- newName "x1" + x2 <- newName "x2" + let expr = UInfixE (VarE fld1 `AppE` VarE x1) (VarE '(&&)) (VarE fld2 `AppE` VarE x2) + fun_decl = FunD fun [Clause [VarP x1, VarP x2] (NormalB expr) []] + pure [r1,r2,fun_decl] + ) ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -54,5 +54,6 @@ test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A' test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) +test('T22424', req_th, compile, ['-this-unit-id="me"']) test('T23279', [extra_files(['T23279_aux.hs'])], multimod_compile, ['T23279', '-v0']) test('T23557', [extra_files(['T23557_aux.hs'])], multimod_compile, ['T23557', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73b5c7ce33929e1f7c9283ed7c2860aa40f6d0ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73b5c7ce33929e1f7c9283ed7c2860aa40f6d0ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 23 17:26:24 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sun, 23 Jul 2023 13:26:24 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 26 commits: Summary: Remove Location from WarningTxt source Message-ID: <64bd62c0a87df_17b24eb801036179@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: 5d5bed83 by Alan Zimmerman at 2023-07-22T12:12:41+01:00 Summary: Remove Location from WarningTxt source - - - - - a3e80d79 by Alan Zimmerman at 2023-07-23T09:41:22+01:00 EPA: Use Introduce [DeclTag] in AnnSortKey Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-23 09:40:15 +0100 Summary: Introduce AnnSortKey [DeclTag] info: patch template saved to `-` - - - - - 7e0aa5ed by Alan Zimmerman at 2023-07-23T10:03:42+01:00 EPA: Introduce HasAnnotation class - - - - - 4f940105 by Alan Zimmerman at 2023-07-23T11:40:31+01:00 EPA HasAnnotation 2 - - - - - f4c78069 by Alan Zimmerman at 2023-07-23T16:18:24+01:00 EPA: put noAnnSrcSpan in HasAnnotation - - - - - 71999d25 by Alan Zimmerman at 2023-07-23T16:18:33+01:00 EPA: Fix span for GRHS - - - - - ecba0735 by Alan Zimmerman at 2023-07-23T16:18:33+01:00 EPA: Capture full range for a CaseAlt Match - - - - - ad4fa166 by Alan Zimmerman at 2023-07-23T16:18:33+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 Summary: Patch: summary-epa-use-full-range-for Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:34:57 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] info: patch template saved to `-` - - - - - 37762890 by Alan Zimmerman at 2023-07-23T16:18:34+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - 9a422538 by Alan Zimmerman at 2023-07-23T16:18:34+01:00 EPA: Fix simple tests - - - - - f1050e8b by Alan Zimmerman at 2023-07-23T17:28:17+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 48858eca by Alan Zimmerman at 2023-07-23T17:28:21+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 341a465c by Alan Zimmerman at 2023-07-23T17:28:22+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 33158750 by Alan Zimmerman at 2023-07-23T17:28:22+01:00 Summary: Patch: use-anchor-end-as-prior-end Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-25 12:41:37 +0100 EPA: Use the current Anchor end as prior end Use the original anchor location end as the source of truth for calculating print deltas. This allows original spacing to apply in most cases, only changed AST items need initial delta positions. - - - - - a6a12ec2 by Alan Zimmerman at 2023-07-23T17:28:22+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - af98e6ff by Alan Zimmerman at 2023-07-23T17:28:22+01:00 Summary: HasTrailing instances - - - - - 9f2cb3de by Alan Zimmerman at 2023-07-23T17:28:22+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 40a68dff by Alan Zimmerman at 2023-07-23T17:28:22+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - e5639dbe by Alan Zimmerman at 2023-07-23T17:28:22+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 2a74e3e5 by Alan Zimmerman at 2023-07-23T17:28:22+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 258e1ce0 by Alan Zimmerman at 2023-07-23T17:28:22+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - fd4124bb by Alan Zimmerman at 2023-07-23T17:28:22+01:00 EPA: deal with fallout from getMonoBind - - - - - 8c2f9f6f by Alan Zimmerman at 2023-07-23T17:28:23+01:00 EPA fix captureLineSpacing - - - - - 389d464b by Alan Zimmerman at 2023-07-23T17:28:23+01:00 EPA print any comments in the span before exiting it - - - - - cfd7aba4 by Alan Zimmerman at 2023-07-23T17:28:23+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - b44105a5 by Alan Zimmerman at 2023-07-23T18:25:58+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 18 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e6f6e4fd88f19d641af16ea71cd1d164bf0814a...b44105a5210a18d1755abbdf37e6e51609604434 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e6f6e4fd88f19d641af16ea71cd1d164bf0814a...b44105a5210a18d1755abbdf37e6e51609604434 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 23 22:10:50 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 23 Jul 2023 18:10:50 -0400 Subject: [Git][ghc/ghc][wip/T22404] Dealing with lambdas again Message-ID: <64bda56aa7147_17b24eb801038667d@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 702dc152 by Simon Peyton Jones at 2023-07-23T23:09:38+01:00 Dealing with lambdas again - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -942,14 +942,14 @@ occAnalBind -> WithUsageDetails r -- Of the whole let(rec) occAnalBind env lvl ire (Rec pairs) thing_inside combine - = addInScope env (map fst pairs) $ \env -> + = addInScopeList env (map fst pairs) $ \env -> let WUD body_uds body' = thing_inside env WUD bind_uds binds' = occAnalRecBind env lvl ire pairs body_uds in WUD bind_uds (combine binds' body') occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine | isTyVar bndr -- A type let; we don't gather usage info - = let !(WUD body_uds res) = addInScope env [bndr] thing_inside + = let !(WUD body_uds res) = addInScopeOne env bndr thing_inside in WUD body_uds (combine [NonRec bndr rhs] res) -- /Existing/ non-recursive join points @@ -1022,7 +1022,7 @@ occAnalNonRecBody :: OccEnv -> Id -> (OccEnv -> WithUsageDetails r) -- Scope of the bind -> (WithUsageDetails (OccInfo, r)) occAnalNonRecBody env bndr thing_inside - = addInScope env [bndr] $ \env -> + = addInScopeOne env bndr $ \env -> let !(WUD inner_uds res) = thing_inside env !occ = lookupLetDetails inner_uds bndr in WUD inner_uds (occ, res) @@ -2157,19 +2157,19 @@ occAnalLamTail env expr occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Does not markInsidLam etc for the outmost batch of lambdas occ_anal_lam_tail env expr@(Lam {}) - = go env [] expr + = go env emptyVarSet [] expr where - go :: OccEnv -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr - go env rev_bndrs (Lam bndr expr) + go :: OccEnv -> IdSet -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env id_set rev_bndrs (Lam bndr body) | isTyVar bndr - = go env (bndr:rev_bndrs) expr - -- Important: Do not modify occ_encl, so that with a RHS like - -- \(@ x) -> K @x (f @x) - -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain - -- from inlining f. See the beginning of Note [Cascading inlines]. + = go env id_set (bndr:rev_bndrs) body + -- Important: Do not modify occ_encl, so that with a RHS like + -- \(@ x) -> K @x (f @x) + -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain + -- from inlining f. See the beginning of Note [Cascading inlines]. | otherwise - = let (env_one_shots', bndr1) + = let (env_one_shots', bndr') = case occ_one_shots env of [] -> ([], bndr) (os : oss) -> (oss, updOneShotInfo bndr os) @@ -2177,17 +2177,15 @@ occ_anal_lam_tail env expr@(Lam {}) -- one-shot info might be better than what we can infer, e.g. -- due to explicit use of the magic 'oneShot' function. -- See Note [The oneShot function] - env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - in go env1 (bndr1 : rev_bndrs) expr - - go env rev_bndrs expr - = let bndrs = reverse rev_bndrs in - addInScope env bndrs $ \env -> - let !(WUD usage expr') = occ_anal_lam_tail env expr - bndrs' = tagLamBinders usage bndrs - in WUD (usage `addLamCoVarOccs` bndrs) - (mkLams bndrs' expr') - -- addLamCoVarOccs: see Note [Gather occurrences of coercion variables] + env' = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } + in go env' (id_set `extendVarSet` bndr') (bndr':rev_bndrs) body + + go env id_set rev_bndrs body + = addInScope env id_set $ \env -> + let !(WUD usage body') = occ_anal_lam_tail env body + wrap_lam body bndr = Lam (tagLamBinder usage bndr) body + in WUD (usage `addLamCoVarOccs` rev_bndrs) + (foldl' wrap_lam body' rev_bndrs) -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] @@ -2266,7 +2264,7 @@ occAnalUnfolding !env unf -- scope remain in scope; there is no cloning etc. unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) - -> let WUD uds args' = addInScope env bndrs $ \ env -> + -> let WUD uds args' = addInScopeList env bndrs $ \ env -> occAnalList env args in WTUD (TUD 0 uds) (unf { df_args = args' }) -- No need to use tagLamBinders because we @@ -2287,11 +2285,11 @@ occAnalRules !env bndr where rule' = rule { ru_args = args', ru_rhs = rhs' } - WUD lhs_uds args' = addInScope env bndrs $ \env -> + WUD lhs_uds args' = addInScopeList env bndrs $ \env -> occAnalList env args lhs_uds' = markAllManyNonTail lhs_uds - WUD rhs_uds rhs' = addInScope env bndrs $ \env -> + WUD rhs_uds rhs' = addInScopeList env bndrs $ \env -> occAnal env rhs -- Note [Rules are extra RHSs] -- Note [Rule dependency info] @@ -2532,7 +2530,7 @@ occAnal env (Case scrut bndr ty alts) WUD scrut_usage scrut' = occAnal (setScrutCtxt env alts) scrut WUD alts_usage (tagged_bndr, alts') - = addInScope env [bndr] $ \env -> + = addInScopeOne env bndr $ \env -> let alt_env = addBndrSwap scrut' bndr $ setTailCtxt env -- Kill off OccRhs WUD alts_usage alts' = do_alts alt_env alts @@ -2552,7 +2550,7 @@ occAnal env (Case scrut bndr ty alts) WUD uds2 alts' = do_alts env alts do_alt !env (Alt con bndrs rhs) - = addInScope env bndrs $ \ env -> + = addInScopeList env bndrs $ \ env -> let WUD rhs_usage rhs' = occAnal env rhs tagged_bndrs = tagLamBinders rhs_usage bndrs in -- See Note [Binders in case alternatives] @@ -2915,14 +2913,23 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of OccRhs -> True _ -> False -addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) - -> WithUsageDetails a +addInScopeList :: OccEnv -> [Var] + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeList #-} +addInScopeList env bndrs = addInScope env (mkVarSet bndrs) + +addInScopeOne :: OccEnv -> Id + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeOne #-} +addInScopeOne env bndr = addInScope env (unitVarSet bndr) + +addInScope :: OccEnv -> IdSet + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a {-# INLINE addInScope #-} -- This function is called a lot, so we want to inline the fast path -addInScope env bndrs thing_inside +addInScope env bndr_set thing_inside = WUD uds' res where - bndr_set = mkVarSet bndrs !(env', bad_joins) = preprocess_env env bndr_set !(WUD uds res) = thing_inside env' uds' = postprocess_uds bndr_set bad_joins uds @@ -3523,7 +3530,9 @@ addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails -- Add any CoVars free in the type of a lambda-binder -- See Note [Gather occurrences of coercion variables] addLamCoVarOccs uds bndrs - = uds `addManyOccs` coVarsOfTypes [ idType id | id <- bndrs, isId id ] + = foldr add uds bndrs + where + add bndr uds = uds `addManyOccs` coVarsOfType (varType bndr) emptyDetails :: UsageDetails emptyDetails = mkSimpleDetails emptyVarEnv View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/702dc152cad9d894ce34ef2f398fabac6764de91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/702dc152cad9d894ce34ef2f398fabac6764de91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 00:35:34 2023 From: gitlab at gitlab.haskell.org (Richard Eisenberg (@rae)) Date: Sun, 23 Jul 2023 20:35:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23162 Message-ID: <64bdc756f20d6_17b24eb80384029f1@gitlab.mail> Richard Eisenberg pushed new branch wip/T23162 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23162 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 01:24:02 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Sun, 23 Jul 2023 21:24:02 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 30 commits: base: add COMPLETE pragma to BufferCodec PatSyn Message-ID: <64bdd2b29d381_17b24e289f3ad0407489@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - 37e3acb5 by Apoorv Ingle at 2023-07-23T20:23:46-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - Aligning expand stmt context pushing on error stack. - Pop error context while checking do expansion generated GRHSs inside HsLam so that we do not print the previous statement error context - makes template haskell happy - some fix for let expansions - - - - - 28 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d15b8800fd7788a02559cbb8c7de30b15d9649ad...37e3acb586f0549c727e857e282349a6f5ad3881 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d15b8800fd7788a02559cbb8c7de30b15d9649ad...37e3acb586f0549c727e857e282349a6f5ad3881 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 01:52:27 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Sun, 23 Jul 2023 21:52:27 -0400 Subject: [Git][ghc/ghc][wip/T23490] Kill off gen_bytearray_addr_access_ops.py Message-ID: <64bdd95b4a95a_17b24eb80b04137cd@gitlab.mail> Matthew Craven pushed to branch wip/T23490 at Glasgow Haskell Compiler / GHC Commits: c709cb45 by Matthew Craven at 2023-07-23T21:49:16-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 8 changed files: - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Generate.hs - + utils/genprimopcode/AccessOps.hs - utils/genprimopcode/Lexer.x - utils/genprimopcode/Parser.y - utils/genprimopcode/ParserM.hs - utils/genprimopcode/genprimopcode.cabal Changes: ===================================== compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py deleted ===================================== @@ -1,201 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -# This script generates the primop descriptions for many similar ByteArray# -# and Addr# access operations. Its output is #include-d into primops.txt.pp. - -from typing import Optional, NamedTuple -import textwrap -import argparse - -arg_parser = argparse.ArgumentParser() -arg_parser.add_argument('addr_or_bytearray', - choices = ["addr-access-ops", "bytearray-access-ops"], - ) -arg_parser.add_argument('output_file', - type=argparse.FileType('w'), - metavar='FILE', - ) -args = arg_parser.parse_args() -write = args.output_file.write - - - -write(''' --- Do not edit. --- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. --- (The build system should take care of this for you.) - -''') - -class ElementType(NamedTuple): - name: str - rep_ty: str - desc: str - width: Optional[int] - -MACH_WORD = None - -element_types = [ - # (name, representation type, human description, width) - # - # width in bytes. - # width == None denotes machine word - - ElementType("Char", "Char#", "8-bit character", 1), - ElementType("WideChar", "Char#", "32-bit character", 4), - ElementType("Int", "Int#", "word-sized integer", MACH_WORD), - ElementType("Word", "Word#", "word-sized unsigned integer", MACH_WORD), - ElementType("Addr", "Addr#", "machine address", MACH_WORD), - ElementType("Float", "Float#", "single-precision floating-point value", 4), - ElementType("Double", "Double#", "double-precision floating-point value", 8), - ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), -] - -for n in [8,16,32,64]: - element_types += [ - ElementType(f"Int{n}", f"Int{n}#", - f"{n}-bit signed integer", n // 8), - ElementType(f"Word{n}", f"Word{n}#", - f"{n}-bit unsigned integer", n // 8) - ] - -def pretty_offset(n: Optional[int]) -> str: - if n == MACH_WORD: - return 'machine words' - elif n == 1: - return 'bytes' - else: - return f'{n}-byte words' - -def get_align_warn(n: ElementType) -> str: - if n.width == 1: - return '' - return ''' - On some platforms, the access may fail - for an insufficiently aligned @Addr#@. - ''' - -def print_block(template: str, **kwargs) -> None: - write(textwrap.dedent(template.format(**kwargs)).lstrip()) - write('\n') - -def header(s: str): - write('\n') - print_block(''' - ------------------------------------ - -- {s} - ------------------------------------ - ''', s=s) - -if args.addr_or_bytearray == "bytearray-access-ops": - header("ByteArray# operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in {offset}.}} - with can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned index operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in bytes.}} - with can_fail = True - ''', **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned read operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned write operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - -else: # addr_or_bytearray == "addr-access-ops": - header("Addr# access operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} -> State# s -> State# s - {{ Write a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1956,7 +1956,11 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-access-ops.txt.pp" + +bytearray_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2259,7 +2263,11 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -#include "addr-access-ops.txt.pp" + +addr_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,17 +32,6 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" -accessOpsSource :: FilePath -accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" - -byteArrayAccessOpsTxt :: Stage -> FilePath -byteArrayAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" - -addrAccessOpsTxt :: Stage -> FilePath -addrAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" - isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -153,21 +142,8 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do - let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage - let addr_ops_txt = root -/- addrAccessOpsTxt stage - ba_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "bytearray-access-ops", file] - [] [] - addr_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "addr-access-ops", file] - [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] - -- ba_ops_txt and addr_ops_txt get #include-d + need $ [primopsSource] build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== utils/genprimopcode/AccessOps.hs ===================================== @@ -0,0 +1,250 @@ +module AccessOps (byteArrayAccessOps, addrAccessOps) where + +import Syntax + +data ElementType = MkElementType + { elt_name :: String + , elt_rep_ty :: Ty + , elt_desc :: String + , elt_width :: Maybe Int + } + +machWord :: Maybe Int +machWord = Nothing + +strToTy :: String -> Ty +strToTy s = TyApp (TyCon s) [] + +elementTypes :: [ElementType] +elementTypes = + [ MkElementType "Char" (strToTy "Char#" ) "an 8-bit character" (Just 1) + , MkElementType "WideChar" (strToTy "Char#" ) "a 32-bit character" (Just 4) + , MkElementType "Int" (strToTy "Int#" ) "a word-sized integer" machWord + , MkElementType "Word" (strToTy "Word#" ) "a word-sized unsigned integer" machWord + , MkElementType "Addr" (strToTy "Addr#" ) "a machine address" machWord + , MkElementType "Float" (strToTy "Float#" ) "a single-precision floating-point value" (Just 4) + , MkElementType "Double" (strToTy "Double#") "a double-precision floating-point value" (Just 8) + , MkElementType "StablePtr" (TyApp (TyCon "StablePtr#") [TyVar "a"]) + "a 'StablePtr#' value" machWord + ] ++ do + n <- [8, 16, 32, 64] + let mkDesc suff = (if n == 8 then "an " else "a ") ++ shows n suff + [ MkElementType + { elt_name = "Int" ++ show n + , elt_rep_ty = strToTy $ "Int" ++ shows n "#" + , elt_desc = mkDesc "-bit signed integer" + , elt_width = Just (n `quot` 8) + }, + MkElementType + { elt_name = "Word" ++ show n + , elt_rep_ty = strToTy $ "Word" ++ shows n "#" + , elt_desc = mkDesc "-bit unsigned integer" + , elt_width = Just (n `quot` 8) + } + ] + +unalignedElementTypes :: [ElementType] +unalignedElementTypes + = filter (\e -> elt_name e `notElem` ["Int8", "Word8"]) elementTypes +--unalignedElementTypes = filter (\e -> elt_width e /= Just 1) elementTypes + +prettyOffset :: ElementType -> String +prettyOffset e = case elt_width e of + Nothing -> "machine words" + Just 1 -> "bytes" + Just n -> shows n "-byte words" + +getAlignWarn :: ElementType -> String +getAlignWarn e = case elt_width e of + Just 1 -> "" + _ -> "On some platforms, the access may fail\n" + ++ "for an insufficiently aligned @Addr#@." + +mutableByteArrayS :: Ty +mutableByteArrayS = TyApp (TyCon "MutableByteArray#") [TyVar "s"] + +stateS :: Ty +stateS = TyApp (TyCon "State#") [TyVar "s"] + +readResTy :: ElementType -> Ty +readResTy e = TyF stateS (TyUTup [stateS, elt_rep_ty e]) + +writeResTy :: ElementType -> Ty +writeResTy e = TyF (elt_rep_ty e) (TyF stateS stateS) + + + +mkIndexByteArrayOp :: ElementType -> Entry +mkIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "Array#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail"] + } + +mkUnalignedIndexByteArrayOp :: ElementType -> Entry +mkUnalignedIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_Word8As" ++ elt_name e + , name = "indexWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } + +mkReadByteArrayOp :: ElementType -> Entry +mkReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedReadByteArrayOp :: ElementType -> Entry +mkUnalignedReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_Word8As" ++ elt_name e + , name = "readWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkWriteByteArrayOp :: ElementType -> Entry +mkWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedWriteByteArrayOp :: ElementType -> Entry +mkUnalignedWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_Word8As" ++ elt_name e + , name = "writeWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + + +byteArrayAccessOps :: [Entry] +byteArrayAccessOps + = map mkIndexByteArrayOp elementTypes + ++ map mkUnalignedIndexByteArrayOp unalignedElementTypes + ++ map mkReadByteArrayOp elementTypes + ++ map mkUnalignedReadByteArrayOp unalignedElementTypes + ++ map mkWriteByteArrayOp elementTypes + ++ map mkUnalignedWriteByteArrayOp unalignedElementTypes + + + +mkIndexOffAddrOp :: ElementType -> Entry +mkIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail"] + } + +{- +mkUnalignedIndexOffAddrOp :: ElementType -> Entry +mkUnalignedIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_Word8As" ++ elt_name e + , name = "indexWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } +-} + +mkReadOffAddrOp :: ElementType -> Entry +mkReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedReadOffAddrOp :: ElementType -> Entry +mkUnalignedReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_Word8As" ++ elt_name e + , name = "readWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + +mkWriteOffAddrOp :: ElementType -> Entry +mkWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedWriteOffAddrOp :: ElementType -> Entry +mkUnalignedWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_Word8As" ++ elt_name e + , name = "writeWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + + +addrAccessOps :: [Entry] +addrAccessOps + = map mkIndexOffAddrOp elementTypes +-- ++ map mkUnalignedIndexOffAddrOp unalignedElementTypes + ++ map mkReadOffAddrOp elementTypes +-- ++ map mkUnalignedReadOffAddrOp unalignedElementTypes + ++ map mkWriteOffAddrOp elementTypes +-- ++ map mkUnalignedWriteOffAddrOp unalignedElementTypes ===================================== utils/genprimopcode/Lexer.x ===================================== @@ -52,6 +52,8 @@ words :- <0> "infixr" { mkT TInfixR } <0> "Nothing" { mkT TNothing } <0> "vector" { mkT TVector } + <0> "bytearray_access_ops" { mkT TByteArrayAccessOps } + <0> "addr_access_ops" { mkT TAddrAccessOps } <0> "thats_all_folks" { mkT TThatsAllFolks } <0> "SCALAR" { mkT TSCALAR } <0> "VECTOR" { mkT TVECTOR } ===================================== utils/genprimopcode/Parser.y ===================================== @@ -5,6 +5,8 @@ import Lexer (lex_tok) import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos, happyError) import Syntax + +import AccessOps } %name parsex @@ -47,6 +49,8 @@ import Syntax SCALAR { TSCALAR } VECTOR { TVECTOR } VECTUPLE { TVECTUPLE } + bytearray_access_ops { TByteArrayAccessOps } + addr_access_ops { TAddrAccessOps } thats_all_folks { TThatsAllFolks } lowerName { TLowerName $$ } upperName { TUpperName $$ } @@ -83,8 +87,13 @@ pInfix : infix integer { Just $ Fixity NoSourceText $2 InfixN } pEntries :: { [Entry] } pEntries : pEntry pEntries { $1 : $2 } + | pAccessOps pEntries { $1 ++ $2 } | {- empty -} { [] } +pAccessOps :: { [Entry] } +pAccessOps : bytearray_access_ops { byteArrayAccessOps } + | addr_access_ops { addrAccessOps } + pEntry :: { Entry } pEntry : pPrimOpSpec { $1 } | pPrimTypeSpec { $1 } @@ -148,7 +157,7 @@ pVectors : pVector ',' pVectors { [$1] ++ $3 } pVector :: { (String, String, Int) } pVector : '<' upperName ',' upperName ',' integer '>' { ($2, $4, $6) } - + pType :: { Ty } pType : paT '->' pType { TyF $1 $3 } | paT '=>' pType { TyC $1 $3 } ===================================== utils/genprimopcode/ParserM.hs ===================================== @@ -98,6 +98,8 @@ data Token = TEOF | TFalse | TCompare | TGenPrimOp + | TByteArrayAccessOps + | TAddrAccessOps | TThatsAllFolks | TLowerName String | TUpperName String ===================================== utils/genprimopcode/genprimopcode.cabal ===================================== @@ -28,6 +28,7 @@ Executable genprimopcode Parser ParserM Syntax + AccessOps Build-Depends: base >= 4 && < 5, array if flag(build-tool-depends) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c709cb45131c235c6394b1e08c2f3e81eb39f5a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c709cb45131c235c6394b1e08c2f3e81eb39f5a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 04:14:42 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 24 Jul 2023 00:14:42 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - fixing tests for do expansion Message-ID: <64bdfab27a722_17b24eb80b041939e@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 9276c721 by Apoorv Ingle at 2023-07-23T23:14:05-05:00 - fixing tests for do expansion - - - - - 12 changed files: - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Types/Basic.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.hs - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail165.hs - − testsuite/tests/typecheck/should_fail/tcfail165.stderr Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -228,9 +228,9 @@ tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty , L l (LetStmt{}) <- stmt = do traceTc "tcExpr" (text "PopErrCtxt let stmt") popErrCtxt $ - setSrcSpanA l $ - addStmtCtxt (text "tcExpr last stmt") stmt $ - tcExpr expanded_expr res_ty + setSrcSpanA loc $ + -- addStmtCtxt (text "tcExpr let stmt") stmt $ + tcExpr e res_ty -- It is important that we call tcExpr and not tcApp here as -- `e` is just the last statement's body expression -- This improves error messages e.g. T18324b.hs ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1557,7 +1557,7 @@ addExprCtxt :: SDoc -> HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt doc e thing_inside = case e of HsUnboundVar {} -> thing_inside - XExpr (ExpandedStmt (HsExpanded stmt _)) -> addStmtCtxt doc stmt thing_inside + --- XExpr (ExpandedStmt (HsExpanded stmt _)) -> addStmtCtxt doc stmt thing_inside _ -> addErrCtxt (exprCtxt doc e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1447,8 +1447,8 @@ The expanded version (performed by expand_do_stmts) looks as follows: The points to consider are: 1. Generating appropriate type error messages that blame the correct source spans -2. Generate appropriate warnings for discarded results, eg. say g p :: m Int -3. Decorate an expression a fail block if the pattern match is irrefutable +2. Generate appropriate warnings for discarded results in a body statement eg. say g p :: m Int +3. Decorate an expression a fail block if the pattern match is not irrefutable TODO expand using examples ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -595,6 +595,9 @@ isGenerated :: Origin -> Bool isGenerated Generated {} = True isGenerated FromSource = False +-- | Why was the piece of code generated? +-- +-- See Note [Expanding HsDo with HsExpansion]. data GenReason = DoExpansion | OtherExpansion deriving (Eq, Data) ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr ===================================== @@ -4,7 +4,4 @@ RecordDotSyntaxFail9.hs:7:11: error: [GHC-18872] arising from selecting the field ‘foo’ • In the expression: a.foo :: String In a pattern binding: _ = a.foo :: String - In the expression: - do let a = ... - let _ = ... - undefined + In a stmt of a 'do' block: let _ = a.foo :: String ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr ===================================== @@ -14,7 +14,4 @@ SafeLang10.hs:9:13: error: [GHC-36705] instance Pos [a] -- Defined at SafeLang10_A.hs:14:10 • In the expression: res [(1 :: Int)] In an equation for ‘r’: r = res [(1 :: Int)] - In the expression: - do let r = res ... - putStrLn $ "Result: " ++ show r - putStrLn $ "Result: " ++ show function + In a stmt of a 'do' block: let r = res [(1 :: Int)] ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr ===================================== @@ -14,7 +14,4 @@ SafeLang17.hs:9:13: error: [GHC-36705] instance Pos [a] -- Defined at SafeLang17_A.hs:14:10 • In the expression: res [(1 :: Int)] In an equation for ‘r’: r = res [(1 :: Int)] - In the expression: - do let r = res ... - putStrLn $ "Result: " ++ show r - putStrLn $ "Result: " ++ show function + In a stmt of a 'do' block: let r = res [(1 :: Int)] ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.stderr ===================================== @@ -39,7 +39,8 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ • In the pattern: Just x In a stmt of a 'do' block: Just x <- getChar - In the expression: - do x <- getChar - Just x <- getChar - return x + In an equation for ‘ffff5’: + ffff5 + = do x <- getChar + Just x <- getChar + return x ===================================== testsuite/tests/typecheck/should_fail/DoExpansion3.hs ===================================== @@ -6,7 +6,7 @@ module DoExpansion3 where getVal :: Int -> IO String getVal _ = return "x" -gggg1, gggg2, gggg3, gggg4 :: IO Int +gggg1, gggg2, gggg3, gggg4, gggg5 :: IO Int gggg1 = do let x = 1 @@ -26,3 +26,8 @@ gggg3 = do x <- getChar gggg4 = do Just x <- getChar -- should error here return x + +gggg5 = do + let z :: Int = 3 + let a = 1 + putStrLn $ a + "" ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -146,7 +146,7 @@ test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) test('tcfail162', normal, compile_fail, ['']) test('tcfail164', normal, compile_fail, ['']) -test('tcfail165', normal, compile_fail, ['']) +test('tcfail165', normal, compile, ['']) test('tcfail166', normal, compile_fail, ['']) test('tcfail167', normal, compile_fail, ['-Werror']) test('tcfail168', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail165.hs ===================================== @@ -14,6 +14,8 @@ import Control.Concurrent -- With the Visible Type Application patch, this succeeds again. -- -- Sept 16: fails again as it should +-- +-- DoExpansion makes it pass again. RAE says this should be okay foo = do var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String)) putMVar var (show :: forall b. Show b => b -> String) ===================================== testsuite/tests/typecheck/should_fail/tcfail165.stderr deleted ===================================== @@ -1,17 +0,0 @@ - -tcfail165.hs:18:17: error: [GHC-83865] - • Couldn't match type: forall a. Show a => a -> String - with: b0 -> String - Expected: IO (MVar (b0 -> String)) - Actual: IO (MVar (forall a. Show a => a -> String)) - • In a stmt of a 'do' block: - var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String)) - In the expression: - do var <- newEmptyMVar :: - IO (MVar (forall a. Show a => a -> String)) - putMVar var (show :: forall b. Show b => b -> String) - In an equation for ‘foo’: - foo - = do var <- newEmptyMVar :: - IO (MVar (forall a. Show a => a -> String)) - putMVar var (show :: forall b. Show b => b -> String) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9276c72152e0c6c16686ca08f08d45dff477938e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9276c72152e0c6c16686ca08f08d45dff477938e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 04:40:22 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 24 Jul 2023 00:40:22 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - fixing tests for do expansion Message-ID: <64be00b6f36b4_17b24e289f3ad0420141@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 25fed7b3 by Apoorv Ingle at 2023-07-23T23:40:08-05:00 - fixing tests for do expansion - - - - - 12 changed files: - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Types/Basic.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.hs - testsuite/tests/typecheck/should_fail/all.T - testsuite/tests/typecheck/should_fail/tcfail165.hs - − testsuite/tests/typecheck/should_fail/tcfail165.stderr Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -224,13 +224,13 @@ tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty setSrcSpanA l $ addStmtCtxt (text "tcExpr last stmt") stmt $ tcExpr expanded_expr res_ty - | XExpr (ExpandedStmt (HsExpanded stmt expanded_expr)) <- e - , L l (LetStmt{}) <- stmt + | XExpr (ExpandedStmt (HsExpanded stmt _)) <- e + , L _ (LetStmt{}) <- stmt = do traceTc "tcExpr" (text "PopErrCtxt let stmt") popErrCtxt $ - setSrcSpanA l $ - addStmtCtxt (text "tcExpr last stmt") stmt $ - tcExpr expanded_expr res_ty + setSrcSpanA loc $ + -- addStmtCtxt (text "tcExpr let stmt") stmt $ + tcExpr e res_ty -- It is important that we call tcExpr and not tcApp here as -- `e` is just the last statement's body expression -- This improves error messages e.g. T18324b.hs ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1557,7 +1557,7 @@ addExprCtxt :: SDoc -> HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt doc e thing_inside = case e of HsUnboundVar {} -> thing_inside - XExpr (ExpandedStmt (HsExpanded stmt _)) -> addStmtCtxt doc stmt thing_inside + --- XExpr (ExpandedStmt (HsExpanded stmt _)) -> addStmtCtxt doc stmt thing_inside _ -> addErrCtxt (exprCtxt doc e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1447,8 +1447,8 @@ The expanded version (performed by expand_do_stmts) looks as follows: The points to consider are: 1. Generating appropriate type error messages that blame the correct source spans -2. Generate appropriate warnings for discarded results, eg. say g p :: m Int -3. Decorate an expression a fail block if the pattern match is irrefutable +2. Generate appropriate warnings for discarded results in a body statement eg. say g p :: m Int +3. Decorate an expression a fail block if the pattern match is not irrefutable TODO expand using examples ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -595,6 +595,9 @@ isGenerated :: Origin -> Bool isGenerated Generated {} = True isGenerated FromSource = False +-- | Why was the piece of code generated? +-- +-- See Note [Expanding HsDo with HsExpansion]. data GenReason = DoExpansion | OtherExpansion deriving (Eq, Data) ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr ===================================== @@ -4,7 +4,4 @@ RecordDotSyntaxFail9.hs:7:11: error: [GHC-18872] arising from selecting the field ‘foo’ • In the expression: a.foo :: String In a pattern binding: _ = a.foo :: String - In the expression: - do let a = ... - let _ = ... - undefined + In a stmt of a 'do' block: let _ = a.foo :: String ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr ===================================== @@ -14,7 +14,4 @@ SafeLang10.hs:9:13: error: [GHC-36705] instance Pos [a] -- Defined at SafeLang10_A.hs:14:10 • In the expression: res [(1 :: Int)] In an equation for ‘r’: r = res [(1 :: Int)] - In the expression: - do let r = res ... - putStrLn $ "Result: " ++ show r - putStrLn $ "Result: " ++ show function + In a stmt of a 'do' block: let r = res [(1 :: Int)] ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr ===================================== @@ -14,7 +14,4 @@ SafeLang17.hs:9:13: error: [GHC-36705] instance Pos [a] -- Defined at SafeLang17_A.hs:14:10 • In the expression: res [(1 :: Int)] In an equation for ‘r’: r = res [(1 :: Int)] - In the expression: - do let r = res ... - putStrLn $ "Result: " ++ show r - putStrLn $ "Result: " ++ show function + In a stmt of a 'do' block: let r = res [(1 :: Int)] ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.stderr ===================================== @@ -39,7 +39,8 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ • In the pattern: Just x In a stmt of a 'do' block: Just x <- getChar - In the expression: - do x <- getChar - Just x <- getChar - return x + In an equation for ‘ffff5’: + ffff5 + = do x <- getChar + Just x <- getChar + return x ===================================== testsuite/tests/typecheck/should_fail/DoExpansion3.hs ===================================== @@ -6,7 +6,7 @@ module DoExpansion3 where getVal :: Int -> IO String getVal _ = return "x" -gggg1, gggg2, gggg3, gggg4 :: IO Int +gggg1, gggg2, gggg3, gggg4, gggg5 :: IO Int gggg1 = do let x = 1 @@ -26,3 +26,8 @@ gggg3 = do x <- getChar gggg4 = do Just x <- getChar -- should error here return x + +gggg5 = do + let z :: Int = 3 + let a = 1 + putStrLn $ a + "" ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -146,7 +146,7 @@ test('tcfail160', normal, compile_fail, ['']) test('tcfail161', normal, compile_fail, ['']) test('tcfail162', normal, compile_fail, ['']) test('tcfail164', normal, compile_fail, ['']) -test('tcfail165', normal, compile_fail, ['']) +test('tcfail165', normal, compile, ['']) test('tcfail166', normal, compile_fail, ['']) test('tcfail167', normal, compile_fail, ['-Werror']) test('tcfail168', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/tcfail165.hs ===================================== @@ -14,6 +14,8 @@ import Control.Concurrent -- With the Visible Type Application patch, this succeeds again. -- -- Sept 16: fails again as it should +-- +-- DoExpansion makes it pass again. RAE says this should be okay foo = do var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String)) putMVar var (show :: forall b. Show b => b -> String) ===================================== testsuite/tests/typecheck/should_fail/tcfail165.stderr deleted ===================================== @@ -1,17 +0,0 @@ - -tcfail165.hs:18:17: error: [GHC-83865] - • Couldn't match type: forall a. Show a => a -> String - with: b0 -> String - Expected: IO (MVar (b0 -> String)) - Actual: IO (MVar (forall a. Show a => a -> String)) - • In a stmt of a 'do' block: - var <- newEmptyMVar :: IO (MVar (forall a. Show a => a -> String)) - In the expression: - do var <- newEmptyMVar :: - IO (MVar (forall a. Show a => a -> String)) - putMVar var (show :: forall b. Show b => b -> String) - In an equation for ‘foo’: - foo - = do var <- newEmptyMVar :: - IO (MVar (forall a. Show a => a -> String)) - putMVar var (show :: forall b. Show b => b -> String) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25fed7b3b5c9efb49e42ec57d5ade4e45cfe892a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25fed7b3b5c9efb49e42ec57d5ade4e45cfe892a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 06:04:50 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Mon, 24 Jul 2023 02:04:50 -0400 Subject: [Git][ghc/ghc][wip/js-mk_tup] JavaScript: update MK_TUP macros to use current tuple constructors (#23659) Message-ID: <64be14827abf7_17b24eb806042498f@gitlab.mail> Josh Meredith pushed to branch wip/js-mk_tup at Glasgow Haskell Compiler / GHC Commits: 69b8c332 by Josh Meredith at 2023-07-24T16:04:38+10:00 JavaScript: update MK_TUP macros to use current tuple constructors (#23659) - - - - - 7 changed files: - compiler/GHC/StgToJS/Linker/Utils.hs - testsuite/tests/javascript/all.T - testsuite/tests/javascript/js-ffi-string.hs - testsuite/tests/javascript/js-ffi-string.stdout - + testsuite/tests/javascript/js-mk_tup.hs - + testsuite/tests/javascript/js-mk_tup.stdout - + testsuite/tests/javascript/test-mk_tup.js Changes: ===================================== compiler/GHC/StgToJS/Linker/Utils.hs ===================================== @@ -47,6 +47,14 @@ import System.IO import Data.Char (isSpace) import qualified Control.Exception as Exception +import GHC.Builtin.Types +import Language.Haskell.Syntax.Basic +import GHC.Types.Name +import GHC.StgToJS.Ids +import GHC.Core.DataCon +import GHC.JS.Unsat.Syntax +import GHC.Data.FastString + -- | Retrieve library directories provided by the @UnitId@ in @UnitState@ getInstalledPackageLibDirs :: UnitState -> UnitId -> [ShortText] getInstalledPackageLibDirs us = maybe mempty unitLibraryDirs . lookupUnitId us @@ -71,6 +79,26 @@ commonCppDefs_vanilla, commonCppDefs_profiled :: ByteString commonCppDefs_vanilla = genCommonCppDefs False commonCppDefs_profiled = genCommonCppDefs True +genMkTup :: Bool -> Int -> ByteString +genMkTup profiling n = mconcat + [ "#define MK_TUP", sn -- #define MK_TUPn + , "(", B.intercalate "," xs, ")" -- (x1,x2,...) + , "(h$c", sn, "(" -- (h$cn( + , bytesFS symbol, "," -- h$ghczmprimZCGHCziTupleziPrimziZnT_con_e, -- , + , B.intercalate "," $ map (\x -> "(" <> x <> ")") xs -- (x1),(x2),(...) + , if profiling then ",h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM" else "" -- ,h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM + , "))\n" -- ))\n + ] + where + xs = take n $ map (("x" <>) . Char8.pack . show) ([1..] :: [Int]) + sn = Char8.pack $ show n + -- symbol = mkJsSymbolBS True mod (occNameMangledFS $ nameOccName name) + TxtI symbol = makeIdentForId (dataConWorkId $ tupleDataCon Boxed n) Nothing IdConEntry mod + name = tupleDataConName Boxed n + mod = case nameModule_maybe name of + Just m -> m + Nothing -> error "Tuple constructor is missing a module" + -- | Generate CPP Definitions depending on a profiled or normal build. This -- occurs at link time. genCommonCppDefs :: Bool -> ByteString @@ -87,29 +115,7 @@ genCommonCppDefs profiling = mconcat in mconcat (closure_defs ++ thread_defs) -- low-level heap object manipulation macros - , if profiling - then mconcat - [ "#define MK_TUP2(x1,x2) (h$c2(h$ghczmprimZCGHCziTupleziPrimziZLz2cUZR_con_e,(x1),(x2),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP3(x1,x2,x3) (h$c3(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUZR_con_e,(x1),(x2),(x3),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP4(x1,x2,x3,x4) (h$c4(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP5(x1,x2,x3,x4,x5) (h$c5(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP6(x1,x2,x3,x4,x5,x6) (h$c6(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP7(x1,x2,x3,x4,x5,x6,x7) (h$c7(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP8(x1,x2,x3,x4,x5,x6,x7,x8) (h$c8(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP9(x1,x2,x3,x4,x5,x6,x7,x8,x9) (h$c9(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - , "#define MK_TUP10(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) (h$c10(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9),(x10),h$currentThread?h$currentThread.ccs:h$CCS_SYSTEM))\n" - ] - else mconcat - [ "#define MK_TUP2(x1,x2) (h$c2(h$ghczmprimZCGHCziTupleziPrimziZLz2cUZR_con_e,(x1),(x2)))\n" - , "#define MK_TUP3(x1,x2,x3) (h$c3(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUZR_con_e,(x1),(x2),(x3)))\n" - , "#define MK_TUP4(x1,x2,x3,x4) (h$c4(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4)))\n" - , "#define MK_TUP5(x1,x2,x3,x4,x5) (h$c5(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5)))\n" - , "#define MK_TUP6(x1,x2,x3,x4,x5,x6) (h$c6(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6)))\n" - , "#define MK_TUP7(x1,x2,x3,x4,x5,x6,x7) (h$c7(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7)))\n" - , "#define MK_TUP8(x1,x2,x3,x4,x5,x6,x7,x8) (h$c8(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8)))\n" - , "#define MK_TUP9(x1,x2,x3,x4,x5,x6,x7,x8,x9) (h$c9(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9)))\n" - , "#define MK_TUP10(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) (h$c10(h$ghczmprimZCGHCziTupleziPrimziZLz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUz2cUZR_con_e,(x1),(x2),(x3),(x4),(x5),(x6),(x7),(x8),(x9),(x10)))\n" - ] + , mconcat (map (genMkTup profiling) [2..10]) , "#define TUP2_1(x) ((x).d1)\n" , "#define TUP2_2(x) ((x).d2)\n" ===================================== testsuite/tests/javascript/all.T ===================================== @@ -16,6 +16,8 @@ test('js-callback03', normal, compile_and_run, ['']) test('js-callback04', js_skip, compile_and_run, ['']) test('js-callback05', js_skip, compile_and_run, ['']) +test('js-mk_tup', extra_files(['test-mk_tup.js']), compile_and_run, ['test-mk_tup.js']) + test('T23346', normal, compile_and_run, ['']) test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) test('T23565', normal, compile_and_run, ['']) ===================================== testsuite/tests/javascript/js-ffi-string.hs ===================================== @@ -17,33 +17,38 @@ foreign import javascript "(() => { return 'abc' + String.fromCodePoint(128522); hsString :: String hsString = "abc" ++ "\128522" +emptyHsString :: String +emptyHsString = drop (length hsString) hsString + main :: IO () main = do - putStrLn "Does JS `String.fromCodePoint` decode to the expected UTF-16 values? " + putStr "Does JS `String.fromCodePoint` decode to the expected UTF-16 values? " print (eq_JSVal js_utf16_string js_codepoint_string) hFlush stdout log_js_string js_utf16_string log_js_string js_codepoint_string - putStrLn "\nDoes `GHC.JS.fromJSString` convert the JavaScript literal string correctly? " + putStr "\nDoes `GHC.JS.fromJSString` convert the JavaScript literal string correctly? " print (hsString == fromJSString js_utf16_string) putStrLn hsString putStrLn (fromJSString js_utf16_string) - putStrLn "\nDoes `GHC.JS.toJSString` convert the Haskell-defined string correctly? " + putStr "\nDoes `GHC.JS.toJSString` convert the Haskell-defined string correctly? " print (eq_JSVal js_utf16_string (toJSString hsString)) hFlush stdout log_js_string js_utf16_string log_js_string (toJSString hsString) - putStrLn "\nDo values survive the Haskell -> JavaScript -> Haskell round-trip? " + putStr "\nDo values survive the Haskell -> JavaScript -> Haskell round-trip? " print (hsString == fromJSString (toJSString hsString)) putStrLn hsString putStrLn (fromJSString js_utf16_string) - putStrLn "\nDo values survive the JavaScript -> Haskell -> JavaScript round-trip? " + putStr "\nDo values survive the JavaScript -> Haskell -> JavaScript round-trip? " print (eq_JSVal js_utf16_string (toJSString $ fromJSString js_utf16_string)) hFlush stdout log_js_string js_utf16_string log_js_string (toJSString $ fromJSString js_utf16_string) + putStr "\nDoes the empty string survive the Haskell -> JavaScript -> Haskell round-trip? " + print (emptyHsString == fromJSString (toJSString emptyHsString)) ===================================== testsuite/tests/javascript/js-ffi-string.stdout ===================================== @@ -1,25 +1,21 @@ -Does JS `String.fromCodePoint` decode to the expected UTF-16 values? -True +Does JS `String.fromCodePoint` decode to the expected UTF-16 values? True abc😊 abc😊 -Does `GHC.JS.fromJSString` convert the JavaScript literal string correctly? -True +Does `GHC.JS.fromJSString` convert the JavaScript literal string correctly? True abc😊 abc😊 -Does `GHC.JS.toJSString` convert the Haskell-defined string correctly? -True +Does `GHC.JS.toJSString` convert the Haskell-defined string correctly? True abc😊 abc😊 -Do values survive the Haskell -> JavaScript -> Haskell round-trip? -True +Do values survive the Haskell -> JavaScript -> Haskell round-trip? True abc😊 abc😊 -Do values survive the JavaScript -> Haskell -> JavaScript round-trip? -True +Do values survive the JavaScript -> Haskell -> JavaScript round-trip? True abc😊 abc😊 +Does the empty string survive the Haskell -> JavaScript -> Haskell round-trip? True ===================================== testsuite/tests/javascript/js-mk_tup.hs ===================================== @@ -0,0 +1,83 @@ +module Main where + +import qualified GHC.Exts as Exts +import Unsafe.Coerce + +foreign import javascript "test_mk_tup2" js_mk_tup2 :: Exts.Any -- (Int, Int) +foreign import javascript "test_mk_tup3" js_mk_tup3 :: Exts.Any -- (Int, Int, Int) +foreign import javascript "test_mk_tup4" js_mk_tup4 :: Exts.Any -- (Int, Int, Int, Int) +foreign import javascript "test_mk_tup5" js_mk_tup5 :: Exts.Any -- (Int, Int, Int, Int, ...) +foreign import javascript "test_mk_tup6" js_mk_tup6 :: Exts.Any -- (Int, Int, Int, Int, ...) +foreign import javascript "test_mk_tup7" js_mk_tup7 :: Exts.Any -- (Int, Int, Int, Int, ...) +foreign import javascript "test_mk_tup8" js_mk_tup8 :: Exts.Any -- (Int, Int, Int, Int, ...) +foreign import javascript "test_mk_tup9" js_mk_tup9 :: Exts.Any -- (Int, Int, Int, Int, ...) +foreign import javascript "test_mk_tup10" js_mk_tup10 :: Exts.Any -- (Int, Int, Int, Int, ...) + +mkTup2 :: (Int, Int) +mkTup2 = unsafeCoerce js_mk_tup2 + +mkTup3 :: (Int, Int, Int) +mkTup3 = unsafeCoerce js_mk_tup3 + +mkTup4 :: (Int, Int, Int, Int) +mkTup4 = unsafeCoerce js_mk_tup4 + +mkTup5 :: (Int, Int, Int, Int, Int) +mkTup5 = unsafeCoerce js_mk_tup5 + +mkTup6 :: (Int, Int, Int, Int, Int, Int) +mkTup6 = unsafeCoerce js_mk_tup6 + +mkTup7 :: (Int, Int, Int, Int, Int, Int, Int) +mkTup7 = unsafeCoerce js_mk_tup7 + +mkTup8 :: (Int, Int, Int, Int, Int, Int, Int, Int) +mkTup8 = unsafeCoerce js_mk_tup8 + +mkTup9 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int) +mkTup9 = unsafeCoerce js_mk_tup9 + +mkTup10 :: (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) +mkTup10 = unsafeCoerce js_mk_tup10 + +-- We have to use the Haskell tuple constructors here to make sure +-- that the linker includes them in the final output for us to use +-- in our JS code. +main :: IO () +main = do + putStr "mkTup2: " + print $ mkTup2 == (101, 102) + print mkTup2 + + putStr "mkTup3: " + print $ mkTup3 == (101, 102, 103) + print mkTup3 + + putStr "mkTup4: " + print $ mkTup4 == (101, 102, 103, 104) + print mkTup4 + + putStr "mkTup5: " + print $ mkTup5 == (101, 102, 103, 104, 105) + print mkTup5 + + putStr "mkTup6: " + print $ mkTup6 == (101, 102, 103, 104, 105, 106) + print mkTup6 + + putStr "mkTup7: " + print $ mkTup7 == (101, 102, 103, 104, 105, 106, 107) + print mkTup7 + + putStr "mkTup8: " + print $ mkTup8 == (101, 102, 103, 104, 105, 106, 107, 108) + print mkTup8 + + putStr "mkTup9: " + print $ mkTup9 == (101, 102, 103, 104, 105, 106, 107, 108, 109) + print mkTup9 + + putStr "mkTup10: " + print $ mkTup10 == (101, 102, 103, 104, 105, 106, 107, 108, 109, 110) + print mkTup10 + ===================================== testsuite/tests/javascript/js-mk_tup.stdout ===================================== @@ -0,0 +1,18 @@ +mkTup2: True +(101,102) +mkTup3: True +(101,102,103) +mkTup4: True +(101,102,103,104) +mkTup5: True +(101,102,103,104,105) +mkTup6: True +(101,102,103,104,105,106) +mkTup7: True +(101,102,103,104,105,106,107) +mkTup8: True +(101,102,103,104,105,106,107,108) +mkTup9: True +(101,102,103,104,105,106,107,108,109) +mkTup10: True +(101,102,103,104,105,106,107,108,109,110) ===================================== testsuite/tests/javascript/test-mk_tup.js ===================================== @@ -0,0 +1,37 @@ +//#OPTIONS: CPP + +function test_mk_tup2() { + return MK_TUP2(101,102); +} + +function test_mk_tup3() { + return MK_TUP3(101,102,103); +} + +function test_mk_tup4() { + return MK_TUP4(101,102,103,104); +} + +function test_mk_tup5() { + return MK_TUP5(101,102,103,104,105); +} + +function test_mk_tup6() { + return MK_TUP6(101,102,103,104,105,106); +} + +function test_mk_tup7() { + return MK_TUP7(101,102,103,104,105,106,107); +} + +function test_mk_tup8() { + return MK_TUP8(101,102,103,104,105,106,107,108); +} + +function test_mk_tup9() { + return MK_TUP9(101,102,103,104,105,106,107,108,109); +} + +function test_mk_tup10() { + return MK_TUP10(101,102,103,104,105,106,107,108,109,110); +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69b8c33254dc7bdf26cb20090aae8c6541383707 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69b8c33254dc7bdf26cb20090aae8c6541383707 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 07:40:54 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 24 Jul 2023 03:40:54 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 43 commits: Do primop rep-poly checks when instantiating Message-ID: <64be2b0684db1_17b24eb809c439644@gitlab.mail> Matthew Pickering pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 30 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee2810e264c396429706bf0883863e9286d15d23...38e795ffc1688d2a1c62dec1a5309c2ba7a8b2c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee2810e264c396429706bf0883863e9286d15d23...38e795ffc1688d2a1c62dec1a5309c2ba7a8b2c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 07:42:21 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 24 Jul 2023 03:42:21 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] 93 commits: Drop circle-ci-job.sh Message-ID: <64be2b5d59cb6_17b24eb8010440520@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - bbe7aa6d by David Knothe at 2023-07-24T09:31:44+02:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 15 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ba2542b876feb8b318f59f10b692eeaacc30e592...bbe7aa6d14f65eb5b53214f07ec6ec2af7bad62c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ba2542b876feb8b318f59f10b692eeaacc30e592...bbe7aa6d14f65eb5b53214f07ec6ec2af7bad62c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 08:21:20 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 24 Jul 2023 04:21:20 -0400 Subject: [Git][ghc/ghc][wip/haddock-optimizations] 4 commits: Visible forall in types of terms: Part 1 (#22326) Message-ID: <64be348043e2f_17b24eb80b04532fe@gitlab.mail> Matthew Pickering pushed to branch wip/haddock-optimizations at Glasgow Haskell Compiler / GHC Commits: 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - c52bcc84 by Finley McIlwaine at 2023-07-24T09:18:38+01:00 Update haddock and xhtml submodules Include latest optimizations for haddock, including adaptation to latest xhtml changes. Bumps haddock submodule Bumps xhtml submodule xhtml is added to the stage0 packages because we need a newer version to build stage1 haddock. In normal situations we shouldn't be building stage0 haddock but in case someone attempts to.. - - - - - 518e9a74 by Matthew Pickering at 2023-07-24T09:18:38+01:00 testsuite: Don't need haddock executable when testing stage1 compiler This causes some unecessary things to be built when testing stage1. Ideally we want to move to a place where a test properly declares if it depends on an executable so we only build the ones we actually need rather than everything. - - - - - 30 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/TcType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be9dec8f9cbb240a0458fdf0e323fd077b8c8733...518e9a7469fcaea6883bc31fd2f2471313e25386 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be9dec8f9cbb240a0458fdf0e323fd077b8c8733...518e9a7469fcaea6883bc31fd2f2471313e25386 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 08:34:32 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 24 Jul 2023 04:34:32 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/mo-touch Message-ID: <64be3798a671c_17b24eb80b0459211@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/mo-touch at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mo-touch You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 08:35:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 24 Jul 2023 04:35:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-llvm-touch Message-ID: <64be37dc11859_17b24eb80104612d8@gitlab.mail> Matthew Pickering pushed new branch wip/fix-llvm-touch at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-llvm-touch You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 08:39:38 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 24 Jul 2023 04:39:38 -0400 Subject: [Git][ghc/ghc][wip/mo-touch] 7 commits: RTS: declare setKeepCAFs symbol Message-ID: <64be38cabc0ef_17b24eb8074466363@gitlab.mail> Matthew Pickering pushed to branch wip/mo-touch at Glasgow Haskell Compiler / GHC Commits: 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 5e0166f9 by Krzysztof Gogolewski at 2023-07-24T08:39:36+00:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4d1e51067ed6754710349ea87fd8336724b2a88...5e0166f9ede913de23a127587b2ddb93920a4cca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4d1e51067ed6754710349ea87fd8336724b2a88...5e0166f9ede913de23a127587b2ddb93920a4cca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 09:02:00 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 24 Jul 2023 05:02:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/useless-includes Message-ID: <64be3e087c185_17b24eb809c471739@gitlab.mail> Matthew Pickering pushed new branch wip/useless-includes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/useless-includes You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 10:06:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 24 Jul 2023 06:06:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Visible forall in types of terms: Part 1 (#22326) Message-ID: <64be4d3a797ae_17b24eb804c49227b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 86cd1f6c by Matthew Pickering at 2023-07-24T06:06:46-04:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Platform.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3b4d28be6074513cc954bbb8bb661bb00e74f96...86cd1f6cdebcc8ef365b1d1289a176ee834e551e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d3b4d28be6074513cc954bbb8bb661bb00e74f96...86cd1f6cdebcc8ef365b1d1289a176ee834e551e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 10:50:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 24 Jul 2023 06:50:42 -0400 Subject: [Git][ghc/ghc][wip/romes/enable-ghc-toolchain] 3 commits: ghc-toolchain: Create CHANGELOG.md Message-ID: <64be5782f0f28_17b24eb804c5154a2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/enable-ghc-toolchain at Glasgow Haskell Compiler / GHC Commits: 05c6593c by Rodrigo Mesquita at 2023-07-24T11:49:51+01:00 ghc-toolchain: Create CHANGELOG.md - - - - - 4d41a8f5 by Rodrigo Mesquita at 2023-07-24T11:50:09+01:00 ghc-toolchain: Parse javascript as a valid architecture - - - - - 72cbbaf8 by Rodrigo Mesquita at 2023-07-24T11:50:34+01:00 ghc-toolchain: Try the C compiler as a fallback C++ compiler It's not uncommon for users to specify a particular C compiler but not the C++ compiler. An example of this is `configure` invoking ghc-toolchain for the HOST target configuration, but only configuring a CC_STAGE0, not a CXX_STAGE0 We instruct ghc-toolchain to be a bit cleverer here, by trying the C compiler as a fallback C++ compiler if none is otherwise found. It might be that the C compiler program is a collection of compilers that also support C++, such as gcc or clang. - - - - - 5 changed files: - + utils/ghc-toolchain/CHANGELOG.md - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs Changes: ===================================== utils/ghc-toolchain/CHANGELOG.md ===================================== @@ -0,0 +1,7 @@ +# Revision history for ghc-toolchain + +## Unreleased + +* Try the C compiler as a fallback C++ compiler +* Parse "javascript" as a valid architecture +* First version. See Note [ghc-toolchain overview] in GHC.Toolchain for an overview ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -314,7 +314,7 @@ mkTarget opts = do -- Use Llvm target if specified, otherwise use triple as llvm target let tgtLlvmTarget = fromMaybe (optTriple opts) (optLlvmTriple opts) cc0 <- findCc tgtLlvmTarget (optCc opts) - cxx <- findCxx tgtLlvmTarget (optCxx opts) + cxx <- findCxx tgtLlvmTarget (optCxx opts) cc0 cpp <- findCpp (optCpp opts) cc0 hsCpp <- findHsCpp (optHsCpp opts) cc0 (archOs, tgtVendor) <- parseTriple cc0 (optTriple opts) ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -7,6 +7,7 @@ bug-reports: https://gitlab.haskell.org/ghc/ghc/-/issues author: Ben Gamari maintainer: ben at well-typed.com copyright: (c) The GHC Developers +extra-source-files: CHANGELOG.md library exposed-modules: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -53,6 +53,7 @@ parseArch cc arch = "riscv64" -> pure ArchRISCV64 "hppa" -> pure ArchUnknown "wasm32" -> pure ArchWasm32 + "javascript" -> pure ArchJavaScript _ -> throwE $ "Unknown architecture " ++ arch parseOs :: String -> M OS ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs ===================================== @@ -11,6 +11,7 @@ import System.FilePath import GHC.Toolchain.Prelude import GHC.Toolchain.Program import GHC.Toolchain.Utils +import GHC.Toolchain.Tools.Cc newtype Cxx = Cxx { cxxProgram :: Program } @@ -20,10 +21,12 @@ _cxxProgram :: Lens Cxx Program _cxxProgram = Lens cxxProgram (\x o -> o{cxxProgram=x}) findCxx :: String -- ^ The llvm target to use if Cc supports --target - -> ProgOpt -> M Cxx -findCxx target progOpt = checking "for C++ compiler" $ do + -> ProgOpt -- ^ A user specified C++ compiler + -> Cc -- ^ The C compiler, to try as a fallback C++ compiler if we can't find one. + -> M Cxx +findCxx target progOpt cc = checking "for C++ compiler" $ do -- TODO: We use the search order in configure, but there could be a more optimal one - cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"] + cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"] <|> pure (ccProgram cc) cxx <- cxxSupportsTarget target Cxx{cxxProgram} checkCxxWorks cxx return cxx View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/695a74abbb0a6e55c4c2b01e7effff7c0ba5a768...72cbbaf89612ac87157051ff0ad9975a8d0ec54b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/695a74abbb0a6e55c4c2b01e7effff7c0ba5a768...72cbbaf89612ac87157051ff0ad9975a8d0ec54b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 11:01:55 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 24 Jul 2023 07:01:55 -0400 Subject: [Git][ghc/ghc][wip/romes/enable-ghc-toolchain] ghc-toolchain: Fix ranlib option Message-ID: <64be5a23ae098_17b24eb7ffc5172ce@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/enable-ghc-toolchain at Glasgow Haskell Compiler / GHC Commits: 44a9759e by Rodrigo Mesquita at 2023-07-24T12:01:44+01:00 ghc-toolchain: Fix ranlib option - - - - - 1 changed file: - utils/ghc-toolchain/Main.hs Changes: ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -146,7 +146,7 @@ options = , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr - , progOpts "ranlib" "ranlib utility" _optAr + , progOpts "ranlib" "ranlib utility" _optRanlib , progOpts "nm" "nm archiver" _optNm , progOpts "readelf" "readelf utility" _optReadelf , progOpts "merge-objs" "linker for merging objects" _optMergeObjs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44a9759ea0f2a80f18fa38ca43f59bf81ec2dfab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44a9759ea0f2a80f18fa38ca43f59bf81ec2dfab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 11:37:38 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 24 Jul 2023 07:37:38 -0400 Subject: [Git][ghc/ghc][wip/romes/enable-ghc-toolchain] 4 commits: ghc-toolchain: Parse javascript and ghcjs as a Arch and OS Message-ID: <64be62821f89c_17b24eb809c5219b9@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/enable-ghc-toolchain at Glasgow Haskell Compiler / GHC Commits: 3e6e0b9a by Rodrigo Mesquita at 2023-07-24T12:30:47+01:00 ghc-toolchain: Parse javascript and ghcjs as a Arch and OS - - - - - 8e82daa7 by Rodrigo Mesquita at 2023-07-24T12:31:59+01:00 ghc-toolchain: Try the C compiler as a fallback C++ compiler It's not uncommon for users to specify a particular C compiler but not the C++ compiler. An example of this is `configure` invoking ghc-toolchain for the HOST target configuration, but only configuring a CC_STAGE0, not a CXX_STAGE0 We instruct ghc-toolchain to be a bit cleverer here, by trying the C compiler as a fallback C++ compiler if none is otherwise found. It might be that the C compiler program is a collection of compilers that also support C++, such as gcc or clang. - - - - - b947472b by Rodrigo Mesquita at 2023-07-24T12:32:01+01:00 ghc-toolchain: Fix ranlib option - - - - - 58a37221 by Rodrigo Mesquita at 2023-07-24T12:37:28+01:00 Improve handling of Cc as a fallback - - - - - 6 changed files: - utils/ghc-toolchain/CHANGELOG.md - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== utils/ghc-toolchain/CHANGELOG.md ===================================== @@ -2,4 +2,6 @@ ## Unreleased +* Try the C compiler as a fallback C++ compiler +* Parse "javascript" and "ghcjs" as a valid Arch and OS * First version. See Note [ghc-toolchain overview] in GHC.Toolchain for an overview ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -146,7 +146,7 @@ options = , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr - , progOpts "ranlib" "ranlib utility" _optAr + , progOpts "ranlib" "ranlib utility" _optRanlib , progOpts "nm" "nm archiver" _optNm , progOpts "readelf" "readelf utility" _optReadelf , progOpts "merge-objs" "linker for merging objects" _optMergeObjs @@ -314,7 +314,7 @@ mkTarget opts = do -- Use Llvm target if specified, otherwise use triple as llvm target let tgtLlvmTarget = fromMaybe (optTriple opts) (optLlvmTriple opts) cc0 <- findCc tgtLlvmTarget (optCc opts) - cxx <- findCxx tgtLlvmTarget (optCxx opts) + cxx <- findCxx tgtLlvmTarget (optCxx opts) cc0 cpp <- findCpp (optCpp opts) cc0 hsCpp <- findHsCpp (optHsCpp opts) cc0 (archOs, tgtVendor) <- parseTriple cc0 (optTriple opts) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -53,6 +53,7 @@ parseArch cc arch = "riscv64" -> pure ArchRISCV64 "hppa" -> pure ArchUnknown "wasm32" -> pure ArchWasm32 + "javascript" -> pure ArchJavaScript _ -> throwE $ "Unknown architecture " ++ arch parseOs :: String -> M OS @@ -76,6 +77,7 @@ parseOs os = "aix" -> pure OSAIX "gnu" -> pure OSHurd "wasi" -> pure OSWasi + "ghc-js" -> pure OSGhcjs _ -> throwE $ "Unknown operating system " ++ os splitOn :: Char -> String -> [String] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -23,8 +23,8 @@ newtype HsCpp = HsCpp { hsCppProgram :: Program findHsCpp :: ProgOpt -> Cc -> M HsCpp findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do - -- Use the specified HS CPP or try to find one (candidate is the c compiler) - foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [takeFileName $ prgPath $ ccProgram cc] + -- Use the specified HS CPP or try to use the c compiler + foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) []) case poFlags progOpt of -- If the user specified HS CPP flags don't second-guess them Just _ -> return HsCpp{hsCppProgram=foundHsCppProg} @@ -61,8 +61,8 @@ findHsCppArgs cpp = withTempDir $ \dir -> do findCpp :: ProgOpt -> Cc -> M Cpp findCpp progOpt cc = checking "for C preprocessor" $ do - -- Use the specified CPP or try to find one (candidate is the c compiler) - foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] + -- Use the specified CPP or try to use the c compiler + foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) []) case poFlags progOpt of -- If the user specified CPP flags don't second-guess them Just _ -> return Cpp{cppProgram=foundCppProg} ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs ===================================== @@ -11,6 +11,7 @@ import System.FilePath import GHC.Toolchain.Prelude import GHC.Toolchain.Program import GHC.Toolchain.Utils +import GHC.Toolchain.Tools.Cc newtype Cxx = Cxx { cxxProgram :: Program } @@ -20,10 +21,12 @@ _cxxProgram :: Lens Cxx Program _cxxProgram = Lens cxxProgram (\x o -> o{cxxProgram=x}) findCxx :: String -- ^ The llvm target to use if Cc supports --target - -> ProgOpt -> M Cxx -findCxx target progOpt = checking "for C++ compiler" $ do + -> ProgOpt -- ^ A user specified C++ compiler + -> Cc -- ^ The C compiler, to try as a fallback C++ compiler if we can't find one. + -> M Cxx +findCxx target progOpt cc = checking "for C++ compiler" $ do -- TODO: We use the search order in configure, but there could be a more optimal one - cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"] + cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"] <|> pure (Program (prgPath $ ccProgram cc) []) cxx <- cxxSupportsTarget target Cxx{cxxProgram} checkCxxWorks cxx return cxx ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -46,8 +46,8 @@ findCcLink :: String -- ^ The llvm target to use if CcLink supports --target -> Bool -- ^ Whether we should search for a more efficient linker -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do - -- Use the specified linker or try to find one - rawCcLink <- findProgram "C compiler for linking" progOpt [takeFileName $ prgPath $ ccProgram cc] + -- Use the specified linker or try using the C compiler + rawCcLink <- findProgram "C compiler for linking" progOpt [] <|> pure (Program (prgPath $ ccProgram cc) []) ccLinkProgram <- case poFlags progOpt of Just _ -> -- If the user specified linker flags don't second-guess them View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44a9759ea0f2a80f18fa38ca43f59bf81ec2dfab...58a37221f70f573bf317d006cb9ca571cdb26dec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44a9759ea0f2a80f18fa38ca43f59bf81ec2dfab...58a37221f70f573bf317d006cb9ca571cdb26dec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 11:47:57 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 24 Jul 2023 07:47:57 -0400 Subject: [Git][ghc/ghc][wip/hadrian-werror-ci] 20 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64be64ed1d0b4_17b24eb809c524995@gitlab.mail> Matthew Pickering pushed to branch wip/hadrian-werror-ci at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - cb12db4c by Matthew Pickering at 2023-07-24T11:47:52+00:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1bebfa502b9216ce56f84c8f911e5d96aa89abb...cb12db4c47d9d6734d9822e768f3699afa9a106d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d1bebfa502b9216ce56f84c8f911e5d96aa89abb...cb12db4c47d9d6734d9822e768f3699afa9a106d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 12:37:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 24 Jul 2023 08:37:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Kill off gen_bytearray_addr_access_ops.py Message-ID: <64be709a29f08_17b24eb804c539064@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b6b7ec71 by Matthew Craven at 2023-07-24T08:37:34-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 2bc0c367 by Matthew Pickering at 2023-07-24T08:37:35-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 17 changed files: - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs - hadrian/src/Rules/Generate.hs - + utils/genprimopcode/AccessOps.hs - utils/genprimopcode/Lexer.x - utils/genprimopcode/Parser.y - utils/genprimopcode/ParserM.hs - utils/genprimopcode/genprimopcode.cabal Changes: ===================================== compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py deleted ===================================== @@ -1,201 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -# This script generates the primop descriptions for many similar ByteArray# -# and Addr# access operations. Its output is #include-d into primops.txt.pp. - -from typing import Optional, NamedTuple -import textwrap -import argparse - -arg_parser = argparse.ArgumentParser() -arg_parser.add_argument('addr_or_bytearray', - choices = ["addr-access-ops", "bytearray-access-ops"], - ) -arg_parser.add_argument('output_file', - type=argparse.FileType('w'), - metavar='FILE', - ) -args = arg_parser.parse_args() -write = args.output_file.write - - - -write(''' --- Do not edit. --- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. --- (The build system should take care of this for you.) - -''') - -class ElementType(NamedTuple): - name: str - rep_ty: str - desc: str - width: Optional[int] - -MACH_WORD = None - -element_types = [ - # (name, representation type, human description, width) - # - # width in bytes. - # width == None denotes machine word - - ElementType("Char", "Char#", "8-bit character", 1), - ElementType("WideChar", "Char#", "32-bit character", 4), - ElementType("Int", "Int#", "word-sized integer", MACH_WORD), - ElementType("Word", "Word#", "word-sized unsigned integer", MACH_WORD), - ElementType("Addr", "Addr#", "machine address", MACH_WORD), - ElementType("Float", "Float#", "single-precision floating-point value", 4), - ElementType("Double", "Double#", "double-precision floating-point value", 8), - ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), -] - -for n in [8,16,32,64]: - element_types += [ - ElementType(f"Int{n}", f"Int{n}#", - f"{n}-bit signed integer", n // 8), - ElementType(f"Word{n}", f"Word{n}#", - f"{n}-bit unsigned integer", n // 8) - ] - -def pretty_offset(n: Optional[int]) -> str: - if n == MACH_WORD: - return 'machine words' - elif n == 1: - return 'bytes' - else: - return f'{n}-byte words' - -def get_align_warn(n: ElementType) -> str: - if n.width == 1: - return '' - return ''' - On some platforms, the access may fail - for an insufficiently aligned @Addr#@. - ''' - -def print_block(template: str, **kwargs) -> None: - write(textwrap.dedent(template.format(**kwargs)).lstrip()) - write('\n') - -def header(s: str): - write('\n') - print_block(''' - ------------------------------------ - -- {s} - ------------------------------------ - ''', s=s) - -if args.addr_or_bytearray == "bytearray-access-ops": - header("ByteArray# operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in {offset}.}} - with can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned index operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in bytes.}} - with can_fail = True - ''', **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned read operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned write operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - -else: # addr_or_bytearray == "addr-access-ops": - header("Addr# access operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} -> State# s -> State# s - {{ Write a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1956,7 +1956,11 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-access-ops.txt.pp" + +bytearray_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2259,7 +2263,11 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -#include "addr-access-ops.txt.pp" + +addr_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== compiler/GHC/Data/Word64Map.hs ===================================== @@ -8,7 +8,6 @@ {-# LANGUAGE MonoLocalBinds #-} #endif -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -14,7 +14,6 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Data/Word64Map/Strict.hs ===================================== @@ -4,8 +4,6 @@ {-# LANGUAGE Trustworthy #-} #endif -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Map.Strict ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -4,8 +4,6 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Map.Strict.Internal ===================================== compiler/GHC/Data/Word64Set.hs ===================================== @@ -3,8 +3,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Set ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -12,8 +12,6 @@ {-# OPTIONS_HADDOCK not-home #-} -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Set.Internal ===================================== compiler/GHC/Utils/Containers/Internal/BitUtil.hs ===================================== @@ -6,8 +6,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Utils.Containers.Internal.BitUtil ===================================== compiler/GHC/Utils/Containers/Internal/StrictPair.hs ===================================== @@ -3,8 +3,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" - -- | A strict pair module GHC.Utils.Containers.Internal.StrictPair (StrictPair(..), toPair) where ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -38,17 +38,6 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" -accessOpsSource :: FilePath -accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" - -byteArrayAccessOpsTxt :: Stage -> FilePath -byteArrayAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" - -addrAccessOpsTxt :: Stage -> FilePath -addrAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" - isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -159,21 +148,8 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do - let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage - let addr_ops_txt = root -/- addrAccessOpsTxt stage - ba_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "bytearray-access-ops", file] - [] [] - addr_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "addr-access-ops", file] - [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] - -- ba_ops_txt and addr_ops_txt get #include-d + need $ [primopsSource] build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== utils/genprimopcode/AccessOps.hs ===================================== @@ -0,0 +1,250 @@ +module AccessOps (byteArrayAccessOps, addrAccessOps) where + +import Syntax + +data ElementType = MkElementType + { elt_name :: String + , elt_rep_ty :: Ty + , elt_desc :: String + , elt_width :: Maybe Int + } + +machWord :: Maybe Int +machWord = Nothing + +strToTy :: String -> Ty +strToTy s = TyApp (TyCon s) [] + +elementTypes :: [ElementType] +elementTypes = + [ MkElementType "Char" (strToTy "Char#" ) "an 8-bit character" (Just 1) + , MkElementType "WideChar" (strToTy "Char#" ) "a 32-bit character" (Just 4) + , MkElementType "Int" (strToTy "Int#" ) "a word-sized integer" machWord + , MkElementType "Word" (strToTy "Word#" ) "a word-sized unsigned integer" machWord + , MkElementType "Addr" (strToTy "Addr#" ) "a machine address" machWord + , MkElementType "Float" (strToTy "Float#" ) "a single-precision floating-point value" (Just 4) + , MkElementType "Double" (strToTy "Double#") "a double-precision floating-point value" (Just 8) + , MkElementType "StablePtr" (TyApp (TyCon "StablePtr#") [TyVar "a"]) + "a 'StablePtr#' value" machWord + ] ++ do + n <- [8, 16, 32, 64] + let mkDesc suff = (if n == 8 then "an " else "a ") ++ shows n suff + [ MkElementType + { elt_name = "Int" ++ show n + , elt_rep_ty = strToTy $ "Int" ++ shows n "#" + , elt_desc = mkDesc "-bit signed integer" + , elt_width = Just (n `quot` 8) + }, + MkElementType + { elt_name = "Word" ++ show n + , elt_rep_ty = strToTy $ "Word" ++ shows n "#" + , elt_desc = mkDesc "-bit unsigned integer" + , elt_width = Just (n `quot` 8) + } + ] + +unalignedElementTypes :: [ElementType] +unalignedElementTypes + = filter (\e -> elt_name e `notElem` ["Int8", "Word8"]) elementTypes +--unalignedElementTypes = filter (\e -> elt_width e /= Just 1) elementTypes + +prettyOffset :: ElementType -> String +prettyOffset e = case elt_width e of + Nothing -> "machine words" + Just 1 -> "bytes" + Just n -> shows n "-byte words" + +getAlignWarn :: ElementType -> String +getAlignWarn e = case elt_width e of + Just 1 -> "" + _ -> "On some platforms, the access may fail\n" + ++ "for an insufficiently aligned @Addr#@." + +mutableByteArrayS :: Ty +mutableByteArrayS = TyApp (TyCon "MutableByteArray#") [TyVar "s"] + +stateS :: Ty +stateS = TyApp (TyCon "State#") [TyVar "s"] + +readResTy :: ElementType -> Ty +readResTy e = TyF stateS (TyUTup [stateS, elt_rep_ty e]) + +writeResTy :: ElementType -> Ty +writeResTy e = TyF (elt_rep_ty e) (TyF stateS stateS) + + + +mkIndexByteArrayOp :: ElementType -> Entry +mkIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "Array#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail"] + } + +mkUnalignedIndexByteArrayOp :: ElementType -> Entry +mkUnalignedIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_Word8As" ++ elt_name e + , name = "indexWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } + +mkReadByteArrayOp :: ElementType -> Entry +mkReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedReadByteArrayOp :: ElementType -> Entry +mkUnalignedReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_Word8As" ++ elt_name e + , name = "readWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkWriteByteArrayOp :: ElementType -> Entry +mkWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedWriteByteArrayOp :: ElementType -> Entry +mkUnalignedWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_Word8As" ++ elt_name e + , name = "writeWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + + +byteArrayAccessOps :: [Entry] +byteArrayAccessOps + = map mkIndexByteArrayOp elementTypes + ++ map mkUnalignedIndexByteArrayOp unalignedElementTypes + ++ map mkReadByteArrayOp elementTypes + ++ map mkUnalignedReadByteArrayOp unalignedElementTypes + ++ map mkWriteByteArrayOp elementTypes + ++ map mkUnalignedWriteByteArrayOp unalignedElementTypes + + + +mkIndexOffAddrOp :: ElementType -> Entry +mkIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail"] + } + +{- +mkUnalignedIndexOffAddrOp :: ElementType -> Entry +mkUnalignedIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_Word8As" ++ elt_name e + , name = "indexWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } +-} + +mkReadOffAddrOp :: ElementType -> Entry +mkReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedReadOffAddrOp :: ElementType -> Entry +mkUnalignedReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_Word8As" ++ elt_name e + , name = "readWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + +mkWriteOffAddrOp :: ElementType -> Entry +mkWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedWriteOffAddrOp :: ElementType -> Entry +mkUnalignedWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_Word8As" ++ elt_name e + , name = "writeWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + + +addrAccessOps :: [Entry] +addrAccessOps + = map mkIndexOffAddrOp elementTypes +-- ++ map mkUnalignedIndexOffAddrOp unalignedElementTypes + ++ map mkReadOffAddrOp elementTypes +-- ++ map mkUnalignedReadOffAddrOp unalignedElementTypes + ++ map mkWriteOffAddrOp elementTypes +-- ++ map mkUnalignedWriteOffAddrOp unalignedElementTypes ===================================== utils/genprimopcode/Lexer.x ===================================== @@ -52,6 +52,8 @@ words :- <0> "infixr" { mkT TInfixR } <0> "Nothing" { mkT TNothing } <0> "vector" { mkT TVector } + <0> "bytearray_access_ops" { mkT TByteArrayAccessOps } + <0> "addr_access_ops" { mkT TAddrAccessOps } <0> "thats_all_folks" { mkT TThatsAllFolks } <0> "SCALAR" { mkT TSCALAR } <0> "VECTOR" { mkT TVECTOR } ===================================== utils/genprimopcode/Parser.y ===================================== @@ -5,6 +5,8 @@ import Lexer (lex_tok) import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos, happyError) import Syntax + +import AccessOps } %name parsex @@ -47,6 +49,8 @@ import Syntax SCALAR { TSCALAR } VECTOR { TVECTOR } VECTUPLE { TVECTUPLE } + bytearray_access_ops { TByteArrayAccessOps } + addr_access_ops { TAddrAccessOps } thats_all_folks { TThatsAllFolks } lowerName { TLowerName $$ } upperName { TUpperName $$ } @@ -83,8 +87,13 @@ pInfix : infix integer { Just $ Fixity NoSourceText $2 InfixN } pEntries :: { [Entry] } pEntries : pEntry pEntries { $1 : $2 } + | pAccessOps pEntries { $1 ++ $2 } | {- empty -} { [] } +pAccessOps :: { [Entry] } +pAccessOps : bytearray_access_ops { byteArrayAccessOps } + | addr_access_ops { addrAccessOps } + pEntry :: { Entry } pEntry : pPrimOpSpec { $1 } | pPrimTypeSpec { $1 } @@ -148,7 +157,7 @@ pVectors : pVector ',' pVectors { [$1] ++ $3 } pVector :: { (String, String, Int) } pVector : '<' upperName ',' upperName ',' integer '>' { ($2, $4, $6) } - + pType :: { Ty } pType : paT '->' pType { TyF $1 $3 } | paT '=>' pType { TyC $1 $3 } ===================================== utils/genprimopcode/ParserM.hs ===================================== @@ -98,6 +98,8 @@ data Token = TEOF | TFalse | TCompare | TGenPrimOp + | TByteArrayAccessOps + | TAddrAccessOps | TThatsAllFolks | TLowerName String | TUpperName String ===================================== utils/genprimopcode/genprimopcode.cabal ===================================== @@ -28,6 +28,7 @@ Executable genprimopcode Parser ParserM Syntax + AccessOps Build-Depends: base >= 4 && < 5, array if flag(build-tool-depends) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86cd1f6cdebcc8ef365b1d1289a176ee834e551e...2bc0c36754f086d0b65a39a558e1391b0ac67ffa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86cd1f6cdebcc8ef365b1d1289a176ee834e551e...2bc0c36754f086d0b65a39a558e1391b0ac67ffa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 12:57:16 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 24 Jul 2023 08:57:16 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] Aarch64 NCG: Don't emit overflowed literals Message-ID: <64be752c9afe6_17b24e624d8ee4556220@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: a3860418 by Andreas Klebinger at 2023-07-24T14:47:37+02:00 Aarch64 NCG: Don't emit overflowed literals Rather than emitting overflowed literals we truncate them now. - - - - - 2 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -397,55 +397,57 @@ For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, -- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. -- Used with MOVZ,MOVN, MOVK -- See Note [Aarch64 immediates] -getMovWideImm :: Integer -> Maybe Operand -getMovWideImm n - -- TODO: Handle sign extension +getMovWideImm :: Integer -> Width -> Maybe Operand +getMovWideImm n w + -- TODO: Handle sign extension/negatives | n <= 0 = Nothing -- Fits in 16 bits | sized_n < 2^(16 :: Int) - = Just $ OpImm (ImmInteger n) + = Just $ OpImm (ImmInteger truncated) -- 0x0000 0000 xxxx 0000 | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 16) SLSL 16 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 16) SLSL 16 -- 0x 0000 xxxx 0000 0000 | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 32) SLSL 32 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 32) SLSL 32 -- 0x xxxx 0000 0000 0000 | trailing_zeros >= 48 - = Just $ OpImmShift (ImmInteger $ n `shiftR` 48) SLSL 48 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 48) SLSL 48 | otherwise = Nothing where - sized_n = fromIntegral n :: Word64 + truncated = narrowU w n + sized_n = fromIntegral truncated :: Word64 trailing_zeros = countTrailingZeros sized_n -- | Arithmetic(immediate) -- Allows for 12bit immediates which can be shifted by 0 or 12 bits. -- Used with ADD, ADDS, SUB, SUBS, CMP, CMN -- See Note [Aarch64 immediates] -getArithImm :: Integer -> Maybe Operand -getArithImm n +getArithImm :: Integer -> Width -> Maybe Operand +getArithImm n w -- TODO: Handle sign extension | n <= 0 = Nothing -- Fits in 16 bits -- Fits in 12 bits | sized_n < 2^(12::Int) - = Just $ OpImm (ImmInteger n) + = Just $ OpImm (ImmInteger truncated) -- 12 bits shifted by 12 places. | trailing_zeros >= 12 && sized_n < 2^(24::Int) - = Just $ OpImmShift (ImmInteger $ n `shiftR` 12) SLSL 12 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 12) SLSL 12 | otherwise = Nothing where - sized_n = fromIntegral n :: Word64 + sized_n = fromIntegral truncated :: Word64 + truncated = narrowU w n trailing_zeros = countTrailingZeros sized_n -- | Logical (immediate) @@ -453,10 +455,12 @@ getArithImm n -- Used with AND, ANDS, EOR, ORR, TST -- and their aliases which includes at least MOV (bitmask immediate) -- See Note [Aarch64 immediates] -getBitmaskImm :: Integer -> Maybe Operand -getBitmaskImm n - | isAArch64Bitmask n = Just $ OpImm (ImmInteger n) +getBitmaskImm :: Integer -> Width -> Maybe Operand +getBitmaskImm n w + | isAArch64Bitmask truncated = Just $ OpImm (ImmInteger truncated) | otherwise = Nothing + where + truncated = narrowU w n -- TODO OPT: we might be able give getRegister @@ -604,7 +608,7 @@ getRegister' config plat expr -- or figure out something smarter. Lowered to -- `MOV dst XZR` CmmInt i w | i >= 0 - , Just imm_op <- getMovWideImm i -> do + , Just imm_op <- getMovWideImm i w -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op))) CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do @@ -895,7 +899,7 @@ getRegister' config plat expr (reg_x, format_x, code_x) <- getSomeReg x (op_y, format_y, code_y) <- case y of CmmLit (CmmInt n w) - | Just imm_operand_y <- encode_imm n + | Just imm_operand_y <- encode_imm n w -> return (imm_operand_y, intFormat w, nilOL) _ -> do (reg_y, format_y, code_y) <- getSomeReg y @@ -910,7 +914,7 @@ getRegister' config plat expr -- In the case of 8- and 16-bit signed arithmetic we must first -- sign-extend both arguments to 32-bits. -- See Note [Signed arithmetic on AArch64]. - intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Maybe Operand) -> NatM (Register) + intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) intOpImm {- is signed -} True w op _encode_imm = intOp True w op intOpImm False w op encode_imm = do -- compute x <- x @@ -919,7 +923,7 @@ getRegister' config plat expr (reg_x, format_x, code_x) <- getSomeReg x (op_y, format_y, code_y) <- case y of CmmLit (CmmInt n w) - | Just imm_operand_y <- encode_imm n + | Just imm_operand_y <- encode_imm n w -> return (imm_operand_y, intFormat w, nilOL) _ -> do (reg_y, format_y, code_y) <- getSomeReg y ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -77,6 +77,8 @@ litToImm (CmmInt i w) = ImmInteger (narrowS w i) -- narrow to the width: a CmmInt might be out of -- range, but we assume that ImmInteger only contains -- in-range values. A signed value should be fine here. + -- AK: We do call this with out of range values, however + -- it just truncates as we would expect. litToImm (CmmFloat f W32) = ImmFloat f litToImm (CmmFloat f W64) = ImmDouble f litToImm (CmmLabel l) = ImmCLbl l View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a386041869261daf9aeff0a31eff8b1f375a37b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a386041869261daf9aeff0a31eff8b1f375a37b8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 14:04:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 24 Jul 2023 10:04:43 -0400 Subject: [Git][ghc/ghc][wip/romes/enable-ghc-toolchain] 6 commits: ghc-toolchain: Parse javascript and ghcjs as a Arch and OS Message-ID: <64be84fb32236_17b24eb80605774d0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/enable-ghc-toolchain at Glasgow Haskell Compiler / GHC Commits: e5f4f031 by Rodrigo Mesquita at 2023-07-24T14:58:41+01:00 ghc-toolchain: Parse javascript and ghcjs as a Arch and OS - - - - - d9d77ef8 by Rodrigo Mesquita at 2023-07-24T14:58:41+01:00 ghc-toolchain: Try the C compiler as a fallback C++ compiler It's not uncommon for users to specify a particular C compiler but not the C++ compiler. An example of this is `configure` invoking ghc-toolchain for the HOST target configuration, but only configuring a CC_STAGE0, not a CXX_STAGE0 We instruct ghc-toolchain to be a bit cleverer here, by trying the C compiler as a fallback C++ compiler if none is otherwise found. It might be that the C compiler program is a collection of compilers that also support C++, such as gcc or clang. - - - - - d9a1a0b0 by Rodrigo Mesquita at 2023-07-24T14:58:41+01:00 ghc-toolchain: Fix ranlib option - - - - - f986734a by Rodrigo Mesquita at 2023-07-24T14:58:41+01:00 Improve handling of Cc as a fallback - - - - - eb3a2a14 by Rodrigo Mesquita at 2023-07-24T15:04:32+01:00 Using more user options - - - - - a1d38409 by Rodrigo Mesquita at 2023-07-24T15:04:32+01:00 ghc-toolchain: Configure Cpp and HsCpp correctly when user specifies flags In ghc-toolchain, we were only /not/ configuring required flags when the user specified any flags at all for the of the HsCpp and Cpp tools. Otherwise, the linker takes into consideration the user specified flags to determine whether to search for a better linker implementation, but already configured the remaining GHC and platform-specific flags regardless of the user options. Other Tools consider the user options as a baseline for further configuration (see `findProgram`), so #23689 is not applicable. Closes #23689 - - - - - 9 changed files: - configure.ac - m4/ghc_toolchain.m4 - utils/ghc-toolchain/CHANGELOG.md - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -49,7 +49,11 @@ USER_CFLAGS="$CFLAGS" USER_LDFLAGS="$LDFLAGS" USER_LIBS="$LIBS" USER_CXXFLAGS="$CXXFLAGS" - +dnl The lower-level/not user-facing environment variables that may still be set +dnl by developers such as in ghc-wasm-meta +USER_CONF_CC_OPTS_STAGE2="$CONF_CC_OPTS_STAGE2" +USER_CONF_CXX_OPTS_STAGE2="$CONF_CXX_OPTS_STAGE2" +USER_CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2" dnl ---------------------------------------------------------- dnl ** Find unixy sort and find commands, ===================================== m4/ghc_toolchain.m4 ===================================== @@ -8,6 +8,18 @@ AC_DEFUN([ADD_GHC_TOOLCHAIN_ARG], done ]) +dnl $1 argument name +dnl $2 first variable to try +dnl $3 variable to add if the first variable is empty +AC_DEFUN([ADD_GHC_TOOLCHAIN_ARG_CHOOSE], +[ + if test -z "$2"; then + ADD_GHC_TOOLCHAIN_ARG([$1],[$3]) + else + ADD_GHC_TOOLCHAIN_ARG([$1],[$2]) + fi +]) + AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], [ if test "$2" = "YES"; then @@ -99,10 +111,10 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. - ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$USER_CFLAGS]) - ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LDFLAGS]) + ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-opt], [$USER_CONF_CC_OPTS_STAGE2], [$USER_CFLAGS]) + ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cc-link-opt], [$USER_CONF_GCC_LINKER_OPTS_STAGE2], [$USER_LDFLAGS]) ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LIBS]) - ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$USER_CXXFLAGS]) + ADD_GHC_TOOLCHAIN_ARG_CHOOSE([cxx-opt], [$USER_CONF_CXX_OPTS_STAGE2], [$USER_CXXFLAGS]) ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$USER_CPP_ARGS]) ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) ===================================== utils/ghc-toolchain/CHANGELOG.md ===================================== @@ -2,4 +2,6 @@ ## Unreleased +* Try the C compiler as a fallback C++ compiler +* Parse "javascript" and "ghcjs" as a valid Arch and OS * First version. See Note [ghc-toolchain overview] in GHC.Toolchain for an overview ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -146,7 +146,7 @@ options = , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr - , progOpts "ranlib" "ranlib utility" _optAr + , progOpts "ranlib" "ranlib utility" _optRanlib , progOpts "nm" "nm archiver" _optNm , progOpts "readelf" "readelf utility" _optReadelf , progOpts "merge-objs" "linker for merging objects" _optMergeObjs @@ -314,7 +314,7 @@ mkTarget opts = do -- Use Llvm target if specified, otherwise use triple as llvm target let tgtLlvmTarget = fromMaybe (optTriple opts) (optLlvmTriple opts) cc0 <- findCc tgtLlvmTarget (optCc opts) - cxx <- findCxx tgtLlvmTarget (optCxx opts) + cxx <- findCxx tgtLlvmTarget (optCxx opts) cc0 cpp <- findCpp (optCpp opts) cc0 hsCpp <- findHsCpp (optHsCpp opts) cc0 (archOs, tgtVendor) <- parseTriple cc0 (optTriple opts) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -53,6 +53,7 @@ parseArch cc arch = "riscv64" -> pure ArchRISCV64 "hppa" -> pure ArchUnknown "wasm32" -> pure ArchWasm32 + "javascript" -> pure ArchJavaScript _ -> throwE $ "Unknown architecture " ++ arch parseOs :: String -> M OS @@ -76,6 +77,7 @@ parseOs os = "aix" -> pure OSAIX "gnu" -> pure OSHurd "wasi" -> pure OSWasi + "ghcjs" -> pure OSGhcjs _ -> throwE $ "Unknown operating system " ++ os splitOn :: Char -> String -> [String] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -2,6 +2,7 @@ module GHC.Toolchain.Program ( Program(..) , _prgPath , _prgFlags + , addFlagIfNew -- * Running programs , runProgram , callProgram @@ -10,6 +11,7 @@ module GHC.Toolchain.Program -- * Finding 'Program's , ProgOpt(..) , emptyProgOpt + , programFromOpt , _poPath , _poFlags , findProgram @@ -41,6 +43,13 @@ _prgPath = Lens prgPath (\x o -> o {prgPath = x}) _prgFlags :: Lens Program [String] _prgFlags = Lens prgFlags (\x o -> o {prgFlags = x}) +-- | Prepends a flag to a program's flags if the flag is not in the existing flags. +addFlagIfNew :: String -> Program -> Program +addFlagIfNew flag prog@(Program path flags) + = if flag `elem` flags + then prog + else Program path (flag:flags) + runProgram :: Program -> [String] -> M ExitCode runProgram prog args = do logExecute prog args @@ -98,6 +107,14 @@ _poFlags = Lens poFlags (\x o -> o {poFlags=x}) emptyProgOpt :: ProgOpt emptyProgOpt = ProgOpt Nothing Nothing +-- | Make a @'Program'@ from user specified program options (@'ProgOpt'@), +-- defaulting to the given path and flags if unspecified in the @'ProgOpt'@. +programFromOpt :: ProgOpt + -> FilePath -- ^ Program path to default to + -> [String] -- ^ Program flags to default to + -> Program +programFromOpt userSpec path flags = Program { prgPath = fromMaybe path (poPath userSpec), prgFlags = fromMaybe flags (poFlags userSpec) } + -- | Tries to find the user specified program by path or tries to look for one -- in the given list of candidates. -- ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -23,17 +23,14 @@ newtype HsCpp = HsCpp { hsCppProgram :: Program findHsCpp :: ProgOpt -> Cc -> M HsCpp findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do - -- Use the specified HS CPP or try to find one (candidate is the c compiler) - foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [takeFileName $ prgPath $ ccProgram cc] - case poFlags progOpt of - -- If the user specified HS CPP flags don't second-guess them - Just _ -> return HsCpp{hsCppProgram=foundHsCppProg} - -- Otherwise, configure the HS CPP flags for this CPP program - Nothing -> do - let rawHsCppProgram = over _prgFlags (["-E"]++) foundHsCppProg - hppArgs <- findHsCppArgs rawHsCppProgram - let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram - return HsCpp{hsCppProgram} + -- Use the specified Hs Cpp or try to use the c compiler + foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) + -- Always add the -E flag to the CPP, regardless of the user options + let rawHsCppProgram = addFlagIfNew "-E" foundHsCppProg + -- Always try to add the Haskell-specific CPP flags, regardless of the user options + hppArgs <- findHsCppArgs rawHsCppProgram + let hsCppProgram = over _prgFlags (++hppArgs) rawHsCppProgram + return HsCpp{hsCppProgram} -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. @@ -61,13 +58,9 @@ findHsCppArgs cpp = withTempDir $ \dir -> do findCpp :: ProgOpt -> Cc -> M Cpp findCpp progOpt cc = checking "for C preprocessor" $ do - -- Use the specified CPP or try to find one (candidate is the c compiler) - foundCppProg <- findProgram "C preprocessor" progOpt [prgPath $ ccProgram cc] - case poFlags progOpt of - -- If the user specified CPP flags don't second-guess them - Just _ -> return Cpp{cppProgram=foundCppProg} - -- Otherwise, configure the CPP flags for this CPP program - Nothing -> do - let cppProgram = over _prgFlags (["-E"]++) foundCppProg - return Cpp{cppProgram} + -- Use the specified CPP or try to use the c compiler + foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) + -- Always add the -E flag to the CPP, regardless of the user options + let cppProgram = addFlagIfNew "-E" foundCppProg + return Cpp{cppProgram} ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs ===================================== @@ -11,6 +11,7 @@ import System.FilePath import GHC.Toolchain.Prelude import GHC.Toolchain.Program import GHC.Toolchain.Utils +import GHC.Toolchain.Tools.Cc newtype Cxx = Cxx { cxxProgram :: Program } @@ -20,10 +21,12 @@ _cxxProgram :: Lens Cxx Program _cxxProgram = Lens cxxProgram (\x o -> o{cxxProgram=x}) findCxx :: String -- ^ The llvm target to use if Cc supports --target - -> ProgOpt -> M Cxx -findCxx target progOpt = checking "for C++ compiler" $ do + -> ProgOpt -- ^ A user specified C++ compiler + -> Cc -- ^ The C compiler, to try as a fallback C++ compiler if we can't find one. + -> M Cxx +findCxx target progOpt cc = checking "for C++ compiler" $ do -- TODO: We use the search order in configure, but there could be a more optimal one - cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"] + cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) cxx <- cxxSupportsTarget target Cxx{cxxProgram} checkCxxWorks cxx return cxx ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -46,8 +46,8 @@ findCcLink :: String -- ^ The llvm target to use if CcLink supports --target -> Bool -- ^ Whether we should search for a more efficient linker -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do - -- Use the specified linker or try to find one - rawCcLink <- findProgram "C compiler for linking" progOpt [takeFileName $ prgPath $ ccProgram cc] + -- Use the specified linker or try using the C compiler + rawCcLink <- findProgram "C compiler for linking" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) ccLinkProgram <- case poFlags progOpt of Just _ -> -- If the user specified linker flags don't second-guess them View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58a37221f70f573bf317d006cb9ca571cdb26dec...a1d38409fcdb951af7613aae1dc7fb81cadb66f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/58a37221f70f573bf317d006cb9ca571cdb26dec...a1d38409fcdb951af7613aae1dc7fb81cadb66f2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 15:28:22 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 24 Jul 2023 11:28:22 -0400 Subject: [Git][ghc/ghc][wip/expand-do] more informative statement error context when rebindable syntax is turned on Message-ID: <64be9896e8bd_17b24eb809c6030a@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 7280f48c by Apoorv Ingle at 2023-07-24T10:27:45-05:00 more informative statement error context when rebindable syntax is turned on - - - - - 5 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Types/Basic.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -514,6 +514,17 @@ data XXExprGhcTc (LHsExpr GhcTc) -- sub-expression + +-- | Build a 'HsExpansion' out of an extension constructor, +-- and the two components of the expansion: original and +-- expanded typechecked expressions. +mkExpandedExprTc + :: HsExpr GhcRn -- ^ source expression + -> HsExpr GhcTc -- ^ expanded typechecked expression + -> HsExpr GhcTc -- ^ suitably wrapped 'HsExpansion' +mkExpandedExprTc a b = XExpr (ExpansionExpr (HsExpanded a b)) + + {- ********************************************************************* * * Pretty-printing expressions ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -480,39 +480,24 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L loc stmts)) res_ty +tcExpr hsDo@(HsDo _ do_or_lc@(DoExpr{}) ss@(L loc stmts)) res_ty +-- In the case of vanilla do expression. +-- We expand the statements into explicit application of binds, thens and lets +-- This helps in infering the right types for bind expressions when impredicativity is turned on +-- See Note [Expanding HsDo with HsExpansion] in GHC.Tc.Gen.Match.hs = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo ; if isApplicativeDo - then tcDoStmts doFlav ss res_ty - else do { (L _ expanded_expr) <- expandDoStmts doFlav stmts + then tcDoStmts do_or_lc ss res_ty -- Use tcSyntaxOp if ApplicativeDo is turned on for now + else do { (L _ expanded_expr) <- expandDoStmts do_or_lc stmts -- Do expansion on the fly - -- ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) ; traceTc "tcDoStmts hsDo" (vcat [ ppr hsDo , text "expr:" <+> ppr expanded_expr ]) ; setSrcSpanA loc $ - -- addExprCtxt (text "tcExpr") hsDo $ - (\ x -> XExpr (ExpansionExpr (HsExpanded hsDo x))) <$> (tcExpr expanded_expr res_ty) + mkExpandedExprTc hsDo <$> (tcExpr expanded_expr res_ty) } } --- tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) ss@(L loc stmts)) res_ty --- = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo --- ; is --- ; if isApplicativeDo --- then tcDoStmts doFlav ss res_ty --- else do { (L _ expanded_expr) <- expandDoStmts doFlav stmts --- -- Do expansion on the fly --- -- ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) --- ; traceTc "tcDoStmts hsDo" (vcat [ ppr hsDo --- , text "expr:" <+> ppr expanded_expr --- ]) --- ; setSrcSpanA loc $ --- -- addExprCtxt (text "tcExpr") hsDo $ --- (\ x -> XExpr (ExpansionExpr (HsExpanded hsDo x))) <$> (tcExpr expanded_expr res_ty) --- } --- } - tcExpr (HsDo _ do_or_lc stmts) res_ty = tcDoStmts do_or_lc stmts res_ty ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -85,6 +85,8 @@ import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic.Plain +import qualified GHC.LanguageExtensions as LangExt + import GHC.Data.Maybe import Control.Monad @@ -1538,20 +1540,28 @@ mis-match in the number of value arguments. addStmtCtxt :: SDoc -> ExprLStmt GhcRn -> TcRn a -> TcRn a addStmtCtxt doc stmt thing_inside - = do let err = pprStmtInCtxt (HsDoStmt (DoExpr Nothing)) (unLoc stmt) + = do isRebindable <- xoptM LangExt.RebindableSyntax + let err = pprStmtInCtxt isRebindable (HsDoStmt (DoExpr Nothing)) (unLoc stmt) traceTc "addStmtCtxt" (ppr $ doc <+> err) addErrCtxt ({-doc <+>-} err) thing_inside where - pprStmtInCtxt :: HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc - pprStmtInCtxt ctxt stmt - = hang (text "In a stmt of" <+> pprAStmtContext ctxt <> colon) - 2 (pprStmt stmt) - -- maybeExpansionClause :: StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc - -- maybeExpansionClause stmt | BindStmt{} <- stmt = text "the expansion of" - -- | otherwise = empty - - + pprStmtInCtxt :: Bool -> HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc + pprStmtInCtxt isRebindable ctxt stmt + = vcat [ text "In" <+> optionalExpansionClause isRebindable stmt <+> text "a stmt of" + <+> pprAStmtContext ctxt <> colon + , nest 2 (pprStmt stmt) + , optionalNote isRebindable + ] + optionalExpansionClause :: Bool -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc + optionalExpansionClause True stmt | BindStmt{} <- stmt = text "the expansion of" + | otherwise = empty + optionalExpansionClause _ _ = empty + + + optionalNote :: Bool -> SDoc + optionalNote True = text "NB: The language extension" <+> ppr LangExt.RebindableSyntax <+> text "is turned on" + optionalNote _ = empty addExprCtxt :: SDoc -> HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt doc e thing_inside ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -84,7 +84,7 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Control.Arrow ( second ) import qualified Data.List.NonEmpty as NE -import Data.List ((\\)) + {- ************************************************************************ * * @@ -1227,7 +1227,7 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = -- See See Note [Monad Comprehensions] pprPanic "expand_do_stmts: ParStmt" $ ppr stmt -expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ _ _)): _) = +expand_do_stmts _ (stmt@(L _ (ApplicativeStmt{})): _) = pprPanic "expand_do_stmts: Applicative Stmt" $ ppr stmt expand_do_stmts _ [stmt@(L loc (LastStmt _ (L _ body) _ ret_expr))] @@ -1260,7 +1260,7 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding pat can fail --- instead of making an internal name, the fail block is just an anonymous match block +-- instead of making an internal name, the fail block is just an anonymous lambda -- stmts ~~> stmt' f = / -> pat = stmts'; -- _ = fail "Pattern match failure .." -- ------------------------------------------------------- @@ -1268,14 +1268,15 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) do -- isRebindableOn <- xoptM LangExt.RebindableSyntax -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan expand_stmts <- expand_do_stmts do_or_lc lstmts - expr <- mk_failable_lexpr_tcm pat + expr <- mk_failable_expr_tcm pat expand_stmts fail_op return $ wrapGenSpan (mkPopErrCtxtExpr $ (wrapGenSpan (mkExpandedStmt stmt ( (wrapGenSpan ((wrapGenSpan bind_op) -- (>>=) `genHsApp` e)) `genHsApp` expr)))) - | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) + | otherwise + = pprPanic "expand_do_stmts: The impossible happened, missing bind operator" (text "stmt" <+> ppr stmt) expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) = -- See Note [BodyStmt] @@ -1314,7 +1315,7 @@ expand_do_stmts do_or_lc return $ mkHsApps (wrapGenSpan bind_fun) -- (>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) , genHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> - ({-genPopSrcSpanExpr-} expand_stmts) -- stmts') + ( expand_stmts) -- stmts') ] where local_only_ids = local_ids \\ later_ids -- get unique local rec ids; @@ -1332,20 +1333,14 @@ expand_do_stmts do_or_lc do_block = L do_loc $ HsDo noExtField (DoExpr Nothing) $ do_stmts mfix_expr :: LHsExpr GhcRn mfix_expr = genHsLamDoExp [ wrapGenSpan (LazyPat noExtField $ mkBigLHsVarPatTup all_ids) ] $ do_block - -- LazyPat becuase we do not want to eagerly evaluate the pattern + -- LazyPat because we do not want to eagerly evaluate the pattern -- and potentially loop forever expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) - - -mk_failable_lexpr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) --- checks the pattern `pat` and decides if we need to decorate it with a fail block --- Type checking the pattern is necessary to decide if we need to generate the fail block --- The Renamer cannot always determine if a fail block is necessary, and its conservative behaviour would --- generate a fail block even if it is not really needed. This would fail typechecking as --- a monad fail instance for such datatypes maynot be defined. cf. GHC.Hs.isIrrefutableHsPat -mk_failable_lexpr_tcm pat@(L loc _) lexpr fail_op = +mk_failable_expr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +-- checks the pattern `pat`for irrefutability which decides if we need to decorate it with a fail block +mk_failable_expr_tcm pat@(L loc _) lexpr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict ; irrf_pat <- isIrrefutableHsPatRn' tc_env is_strict pat @@ -1359,17 +1354,17 @@ mk_failable_lexpr_tcm pat@(L loc _) lexpr fail_op = -- the pattern is irrefutable then return $ let (L _ e) = genHsLamDoExp [pat] lexpr in L loc e - else mk_fail_lexpr pat lexpr fail_op + else mk_fail_block pat lexpr fail_op } -- makes the fail block -- TODO: check the discussion around MonadFail.fail type signature. -- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help -mk_fail_lexpr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) -mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = +mk_fail_block :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +mk_fail_block pat e (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup (Generated DoExpansion SkipPmc) -- \ - (wrapGenSpan [ genHsCaseAltDoExp pat lexpr -- pat -> expr + return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup doExpansionOrigin -- \ + (wrapGenSpan [ genHsCaseAltDoExp pat e -- pat -> expr , genHsCaseAltDoExp (wrapGenSpan (WildPat noExtField)) -- _ -> fail "fail pattern" $ wrapGenSpan (genHsApp (wrapGenSpan fail_op) (mk_fail_msg_expr dflags pat)) ])) @@ -1380,7 +1375,7 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = text "Pattern match failure in" <+> pprHsDoFlavour (DoExpr Nothing) <+> text "at" <+> ppr (getLocA pat) -mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty +mk_fail_block _ _ _ = pprPanic "mk_fail_block: impossible happened" empty genHsApp :: LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn @@ -1392,7 +1387,7 @@ genHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) -> LHsExpr (GhcPass p) genHsLamDoExp pats body = mkHsPar (wrapGenSpan $ HsLam noExtField matches) where - matches = mkMatchGroup (Generated DoExpansion SkipPmc) + matches = mkMatchGroup doExpansionOrigin (wrapGenSpan [genSimpleMatch (StmtCtxt (HsDoStmt (DoExpr Nothing))) pats' body]) pats' = map (parenthesizePat appPrec) pats ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Types.Basic ( RecFlag(..), isRec, isNonRec, boolToRecFlag, Origin(..), isGenerated, DoPmc(..), requiresPMC, - isDoExpansionGenerated, GenReason(..), + GenReason(..), isDoExpansionGenerated, doExpansionOrigin, RuleName, pprRuleName, @@ -610,6 +610,11 @@ isDoExpansionGenerated :: Origin -> Bool isDoExpansionGenerated (Generated DoExpansion _) = True isDoExpansionGenerated _ = False +doExpansionOrigin :: Origin +doExpansionOrigin = Generated DoExpansion DoPmc + -- It is important that we perfrom PMC on these + -- statements to get the right warnings + instance Outputable Origin where ppr FromSource = text "FromSource" ppr (Generated reason pmc) = text "Generated" <+> ppr reason <+> ppr pmc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7280f48c990d853342724642e0d17e7f5aeb873f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7280f48c990d853342724642e0d17e7f5aeb873f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 15:36:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 11:36:49 -0400 Subject: [Git][ghc/ghc][ghc-9.8] 6 commits: JS: support levity-polymorphic datatypes (#22360,#22291) Message-ID: <64be9a91d45bf_17b24eb804c60535b@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: b0b88c24 by Sylvain Henry at 2023-07-21T13:09:52-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b (cherry picked from commit 8d6574bc68cbbcabbf7c0e5700571c4746127fb8) - - - - - e39e8fae by Arnaud Spiwack at 2023-07-21T13:10:17-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 (cherry picked from commit 522bd584f71ddeda21efdf0917606ce3d81ec6cc) - - - - - f0b9bfa1 by Torsten Schmits at 2023-07-21T13:10:24-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall (cherry picked from commit 459dee1b671958bcd5857a676afaf92f944a0af4) - - - - - 3cac14d2 by Ben Gamari at 2023-07-21T13:11:43-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. (cherry picked from commit 3ece9856d157c85511d59f9f862ab351bbd9b38b) - - - - - f9ef5a44 by Ben Gamari at 2023-07-21T13:11:47-04:00 nativeGen: Set explicit section types on all platforms (cherry picked from commit db7f7240b53c01447e44d2790ee37eacaabfbcf3) - - - - - f09530c5 by Ben Gamari at 2023-07-24T11:36:08-04:00 gitlab-ci: Mark linker_unload_native as broken on Alpine Due to lack of dlinfo() support, which is necessary for sound unloading support. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Types/Unique/DFM.hs - nofib - rts/js/rts.js - rts/js/verify.js - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/ghci/should_run/T16096.stdout - testsuite/tests/primops/should_run/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5615af43fc74699a3e9f5b81bc57482bf94d1b2...f09530c5546af1c5ba26ce5bbdcd03ba8383158a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5615af43fc74699a3e9f5b81bc57482bf94d1b2...f09530c5546af1c5ba26ce5bbdcd03ba8383158a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 15:38:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 11:38:00 -0400 Subject: [Git][ghc/ghc][ghc-9.8] gitlab-ci: Mark linker_unload_native as broken on Alpine Message-ID: <64be9ad8e058c_17b24e289f3ad0605769@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: a3756043 by Ben Gamari at 2023-07-24T11:37:25-04:00 gitlab-ci: Mark linker_unload_native as broken on Alpine Due to lack of dlinfo() support, which is necessary for sound unloading support. - - - - - 2 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -434,7 +434,8 @@ distroVariables Alpine = mconcat , "HADRIAN_ARGS" =: "--docs=no-sphinx" -- encoding004: due to lack of locale support -- T10458, ghcilink002: due to #17869 - , "BROKEN_TESTS" =: "encoding004 T10458" + -- linker_unload_native: due to lack of dlinfo() support + , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" ===================================== .gitlab/jobs.yaml ===================================== @@ -598,7 +598,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -660,7 +660,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", - "BROKEN_TESTS": "encoding004 T10458", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -722,7 +722,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2536,7 +2536,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2599,7 +2599,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2662,7 +2662,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -3647,7 +3647,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3756043516e4046090a6a62e95f87b6c90221cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a3756043516e4046090a6a62e95f87b6c90221cb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 15:49:59 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 24 Jul 2023 11:49:59 -0400 Subject: [Git][ghc/ghc][wip/expand-do] do not pop anthing in tcMatch Message-ID: <64be9da73b439_17b24eb80106095ae@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: c845874f by Apoorv Ingle at 2023-07-24T10:49:49-05:00 do not pop anthing in tcMatch - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1548,9 +1548,8 @@ addStmtCtxt doc stmt thing_inside where pprStmtInCtxt :: Bool -> HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc pprStmtInCtxt isRebindable ctxt stmt - = vcat [ text "In" <+> optionalExpansionClause isRebindable stmt <+> text "a stmt of" - <+> pprAStmtContext ctxt <> colon - , nest 2 (pprStmt stmt) + = vcat [ hang (text "In" <+> optionalExpansionClause isRebindable stmt <+> text "a stmt of" + <+> pprAStmtContext ctxt <> colon) 2 (pprStmt stmt) , optionalNote isRebindable ] optionalExpansionClause :: Bool -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -84,7 +84,7 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Control.Arrow ( second ) import qualified Data.List.NonEmpty as NE - +import Data.List((\\)) {- ************************************************************************ * * @@ -256,11 +256,7 @@ tcMatch ctxt pat_tys rhs_ty match match@(Match { m_pats = pats, m_grhss = grhss }) = add_match_ctxt match $ do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $ - maybeErrPopCtxt (mc_what ctxt) $ -- we are likely in a do expansion generated match - -- pop the previous context as it is - -- the one for previous statement context - do { traceTc "tcMatch" (ppr pats) - ; tcGRHSs ctxt grhss rhs_ty } + tcGRHSs ctxt grhss rhs_ty ; return (Match { m_ext = noAnn , m_ctxt = mc_what ctxt, m_pats = pats' , m_grhss = grhss' }) } @@ -273,9 +269,6 @@ tcMatch ctxt pat_tys rhs_ty match StmtCtxt (HsDoStmt{}) -> thing_inside -- this is an expanded do stmt _ -> addErrCtxt (pprMatchInCtxt match) thing_inside - maybeErrPopCtxt (StmtCtxt (HsDoStmt{})) thing_inside = do traceTc "tcMatch popErrCtxt" empty - popErrCtxt thing_inside - maybeErrPopCtxt _ thing_inside = thing_inside ------------- tcGRHSs :: AnnoBody body => TcMatchCtxt body -> GRHSs GhcRn (LocatedA (body GhcRn)) -> ExpRhoType View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c845874fe60517e1bd772c803d59a3a6372f5244 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c845874fe60517e1bd772c803d59a3a6372f5244 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:26:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 24 Jul 2023 13:26:39 -0400 Subject: [Git][ghc/ghc][wip/romes/enable-ghc-toolchain] 2 commits: Check Link Works with -Werror Message-ID: <64beb44f14236_17b24e624d8ee4626230@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/enable-ghc-toolchain at Glasgow Haskell Compiler / GHC Commits: ec6463b0 by Rodrigo Mesquita at 2023-07-24T18:24:09+01:00 Check Link Works with -Werror - - - - - 2c4236d6 by Rodrigo Mesquita at 2023-07-24T18:26:31+01:00 Make search for Cpp message better, since we're not really looking for anything - - - - - 2 changed files: - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -24,7 +24,7 @@ newtype HsCpp = HsCpp { hsCppProgram :: Program findHsCpp :: ProgOpt -> Cc -> M HsCpp findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do -- Use the specified Hs Cpp or try to use the c compiler - foundHsCppProg <- findProgram "Haskell C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) + foundHsCppProg <- findProgram "a user specified Haskell C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) -- Always add the -E flag to the CPP, regardless of the user options let rawHsCppProgram = addFlagIfNew "-E" foundHsCppProg -- Always try to add the Haskell-specific CPP flags, regardless of the user options @@ -59,7 +59,7 @@ findHsCppArgs cpp = withTempDir $ \dir -> do findCpp :: ProgOpt -> Cc -> M Cpp findCpp progOpt cc = checking "for C preprocessor" $ do -- Use the specified CPP or try to use the c compiler - foundCppProg <- findProgram "C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) + foundCppProg <- findProgram "a user specified C preprocessor" progOpt [] <|> pure (programFromOpt progOpt (prgPath $ ccProgram cc) []) -- Always add the -E flag to the CPP, regardless of the user options let cppProgram = addFlagIfNew "-E" foundCppProg return Cpp{cppProgram} ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -163,7 +163,7 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do let out = dir "test" err = "linker didn't produce any output" - callProgram ccLink ["-o", out, test_o, main_o] + callProgram ccLink ["-Werror", "-o", out, test_o, main_o] expectFileExists out err -- Linking in windows might produce an executable with an ".exe" extension <|> expectFileExists (out <.> "exe") err View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1d38409fcdb951af7613aae1dc7fb81cadb66f2...2c4236d6f37d03f76fa5e54c998d5e28b036e9f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a1d38409fcdb951af7613aae1dc7fb81cadb66f2...2c4236d6f37d03f76fa5e54c998d5e28b036e9f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:33:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 13:33:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/readArray Message-ID: <64beb5e6677b9_17b24eb809c63045c@gitlab.mail> Ben Gamari pushed new branch wip/tsan/readArray at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/readArray You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:47:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 13:47:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/prep Message-ID: <64beb93b6e652_17b24e624d8ee463789e@gitlab.mail> Ben Gamari pushed new branch wip/tsan/prep at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/prep You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:50:11 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 13:50:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/cmm-codegen Message-ID: <64beb9d312c51_17b24e289f3ad06413ee@gitlab.mail> Ben Gamari pushed new branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/cmm-codegen You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:53:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 13:53:25 -0400 Subject: [Git][ghc/ghc][wip/tsan/cmm-codegen] 4 commits: codeGen/tsan: Rework handling of spilling Message-ID: <64beba95d896a_17b24eb801064335@gitlab.mail> Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC Commits: 5b5507c3 by Ben Gamari at 2023-07-24T13:51:50-04:00 codeGen/tsan: Rework handling of spilling - - - - - 60401ef3 by Ben Gamari at 2023-07-24T13:51:59-04:00 hadrian: More debug information - - - - - a1888b87 by Ben Gamari at 2023-07-24T13:52:34-04:00 Improve TSAN documentation - - - - - 4af5ca8d by Ben Gamari at 2023-07-24T13:52:36-04:00 hadrian: More selective TSAN instrumentation - - - - - 4 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - hadrian/src/Flavour.hs - rts/include/rts/TSANUtils.h Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -205,7 +205,7 @@ memory ordering guarantees. These are supported in Cmm syntax as follows: %relaxed W_[ptr] = ...; // an atomic store with relaxed ordering semantics %release W_[ptr] = ...; // an atomic store with release ordering semantics - x = W_(ptr); // a non-atomic load + x = W_[ptr]; // a non-atomic load x = %relaxed W_[ptr]; // an atomic load with relaxed ordering x = %acquire W_[ptr]; // an atomic load with acquire ordering // or equivalently... ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Cmm.ThreadSanitizer (annotateTSAN) where import GHC.Prelude -import GHC.StgToCmm.Utils (get_GlobalReg_addr) import GHC.Platform import GHC.Platform.Regs (activeStgRegs, callerSaves) import GHC.Cmm @@ -24,12 +23,12 @@ import GHC.Types.Unique.Supply import Data.Maybe (fromMaybe) data Env = Env { platform :: Platform - , uniques :: [Unique] + , uniques :: UniqSupply } annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph annotateTSAN platform graph = do - env <- Env platform <$> getUniquesM + env <- Env platform <$> getUniqueSupplyM return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph mapBlockList :: (forall e' x'. n e' x' -> Block n e' x') @@ -133,14 +132,15 @@ mkUnsafeCall env ftgt formals args = call `blockAppend` -- perform call restore -- restore global registers where - -- We are rather conservative here and just save/restore all GlobalRegs. - (save, restore) = saveRestoreCallerRegs (platform env) + (save, restore) = saveRestoreCallerRegs gregs_us (platform env) + + (arg_us, gregs_us) = splitUniqSupply (uniques env) -- We also must be careful not to mention caller-saved registers in -- arguments as Cmm-Lint checks this. To accomplish this we instead bind -- the arguments to local registers. arg_regs :: [CmmReg] - arg_regs = zipWith arg_reg (uniques env) args + arg_regs = zipWith arg_reg (uniqsFromSupply arg_us) args where arg_reg :: Unique -> CmmExpr -> CmmReg arg_reg u expr = CmmLocal $ LocalReg u (cmmExprType (platform env) expr) @@ -150,31 +150,34 @@ mkUnsafeCall env ftgt formals args = call = CmmUnsafeForeignCall ftgt formals (map CmmReg arg_regs) -saveRestoreCallerRegs :: Platform +-- | We save the contents of global registers in locals and allow the +-- register allocator to spill them to the stack around the call. +-- We cannot use the register table for this since we would interface +-- with {SAVE,RESTORE}_THREAD_STATE. +saveRestoreCallerRegs :: UniqSupply -> Platform -> (Block CmmNode O O, Block CmmNode O O) -saveRestoreCallerRegs platform = +saveRestoreCallerRegs us platform = (save, restore) where - regs = filter (callerSaves platform) (activeStgRegs platform) - - save = blockFromList (map saveReg regs) - - saveReg :: GlobalReg -> CmmNode O O - saveReg reg = - CmmStore (get_GlobalReg_addr platform reg) - (CmmReg (CmmGlobal (GlobalRegUse reg ty))) - NaturallyAligned - where ty = globalRegSpillType platform reg - - restore = blockFromList (map restoreReg regs) - - restoreReg :: GlobalReg -> CmmNode O O - restoreReg reg = - CmmAssign (CmmGlobal (GlobalRegUse reg ty)) - (CmmLoad (get_GlobalReg_addr platform reg) - ty - NaturallyAligned) - where ty = globalRegSpillType platform reg + regs_to_save :: [GlobalReg] + regs_to_save = filter (callerSaves platform) (activeStgRegs platform) + + nodes :: [(CmmNode O O, CmmNode O O)] + nodes = + zipWith mk_reg regs_to_save (uniqsFromSupply us) + where + mk_reg :: GlobalReg -> Unique -> (CmmNode O O, CmmNode O O) + mk_reg reg u = + let ty = globalRegSpillType platform reg + greg = CmmGlobal (GlobalRegUse reg ty) + lreg = CmmLocal (LocalReg u ty) + save = CmmAssign lreg (CmmReg greg) + restore = CmmAssign greg (CmmReg lreg) + in (save, restore) + + (save_nodes, restore_nodes) = unzip nodes + save = blockFromList save_nodes + restore = blockFromList restore_nodes -- | Mirrors __tsan_memory_order -- ===================================== hadrian/src/Flavour.hs ===================================== @@ -47,7 +47,8 @@ flavourTransformers = M.fromList , "ticky_ghc" =: enableTickyGhc , "split_sections" =: splitSections , "no_split_sections" =: noSplitSections - , "thread_sanitizer" =: enableThreadSanitizer + , "thread_sanitizer" =: enableThreadSanitizer False + , "thread_sanitizer_cmm" =: enableThreadSanitizer True , "llvm" =: viaLlvmBackend , "profiled_ghc" =: enableProfiledGhc , "no_dynamic_ghc" =: disableDynamicGhcPrograms @@ -152,7 +153,8 @@ werror = -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour enableDebugInfo = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? arg "-g3" + [ builder (Ghc CompileHs) ? pure ["-g3"] + , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"] , builder (Cc CompileC) ? arg "-g3" , builder (Cabal Setup) ? arg "--disable-library-stripping" , builder (Cabal Setup) ? arg "--disable-executable-stripping" @@ -218,14 +220,18 @@ noSplitSections f = f { ghcSplitSections = False } -- | Build GHC and libraries with ThreadSanitizer support. You likely want to -- configure with @--disable-large-address-space@ when using this. -enableThreadSanitizer :: Flavour -> Flavour -enableThreadSanitizer = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") - , builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" +enableThreadSanitizer :: Bool -> Flavour -> Flavour +enableThreadSanitizer instrumentCmm = addArgs $ notStage0 ? mconcat + [ instrumentCmm ? builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" + , builder (Ghc LinkHs) ? (arg "-optc-fsanitize=thread" <> arg "-optl-fsanitize=thread") , builder Cc ? arg "-fsanitize=thread" , builder (Cabal Flags) ? arg "thread-sanitizer" , builder Testsuite ? arg "--config=have_thread_sanitizer=True" + , builder (Ghc CompileHs) ? mconcat + [ package pkg ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") + | pkg <- [base, ghcPrim, array, rts] + ] ] -- | Use the LLVM backend in stages 1 and later. ===================================== rts/include/rts/TSANUtils.h ===================================== @@ -28,6 +28,40 @@ * In general it's best to add suppressions only as a last resort, when the * more precise annotation functions prove to be insufficient. * + * GHC can be configured with two extents of TSAN instrumentation: + * + * - instrumenting the C RTS (by passing `-optc-fsanitize=thread` + * when compiling the RTS) + * + * - instrumenting both the C RTS and Cmm memory accesses (by passing + * `-optc-fsanitize=thread -fcmm-thread-sanitizer` to all GHC invocations). + * + * These two modes can be realized in Hadrian using the `+thread_sanitizer` + * and `+thread_sanitizer_cmm` flavour transformers. + * + * Tips and tricks: + * + * - One should generally run TSAN instrumented programs with the environment + * variable + * + * TSAN_OPTIONS=suppressions=$ghc_root/rts/.tsan-suppressions + * + * to maximize signal-to-noise. + * + * - One can set a breakpoint on `__tsan_on_report` in a debugger to pause when + * a TSAN report is found. + * + * - TSAN-instrumented will by default exit with code 66 when a violation has + * been found. However, this can be disabled by setting + * `TSAN_OPTIONS=exitcode=0` + * + * - If TSAN is able to report useful stack traces it may help to set + * `TSAN_OPTIONS=history_size=3` or greater (up to 7). This increases the + * size of TSAN's per-thread memory access history buffer. + * + * - TSAN report messages can be redirected to a file using + * `TSAN_OPTIONS=log_path=...` + * * Users guide: https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad75d63b329521ccc9dfcb3b0fb7e78406473a08...4af5ca8d0c20fd13289ea28135b9525e3ba642d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad75d63b329521ccc9dfcb3b0fb7e78406473a08...4af5ca8d0c20fd13289ea28135b9525e3ba642d0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:58:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 13:58:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/fix-races Message-ID: <64bebbcfb574c_17b24eb804c645364@gitlab.mail> Ben Gamari pushed new branch wip/tsan/fix-races at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/fix-races You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:59:11 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 13:59:11 -0400 Subject: [Git][ghc/ghc][wip/tsan/prep] rts: Introduce NO_WARN macro Message-ID: <64bebbefd01df_17b24e624d8ee4645761@gitlab.mail> Ben Gamari pushed to branch wip/tsan/prep at Glasgow Haskell Compiler / GHC Commits: df059575 by Ben Gamari at 2023-07-24T13:58:58-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 1 changed file: - rts/include/Stg.h Changes: ===================================== rts/include/Stg.h ===================================== @@ -284,6 +284,17 @@ # define STG_RETURNS_NONNULL #endif +/* ----------------------------------------------------------------------------- + Suppressing C warnings + -------------------------------------------------------------------------- */ + +#define DO_PRAGMA(x) _Pragma(#x) +#define NO_WARN(warnoption, ...) \ + DO_PRAGMA(GCC diagnostic push) \ + DO_PRAGMA(GCC diagnostic ignored #warnoption) \ + __VA_ARGS__ \ + DO_PRAGMA(GCC diagnostic pop) + /* ----------------------------------------------------------------------------- Global type definitions -------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df05957519aca01a83cbf4d55d3d199285e6957c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df05957519aca01a83cbf4d55d3d199285e6957c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 17:59:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 13:59:34 -0400 Subject: [Git][ghc/ghc][wip/tsan/prep] rts: Simplify atomicModifyMutVar2# implementation Message-ID: <64bebc06c76b7_17b24eb80b06459c7@gitlab.mail> Ben Gamari pushed to branch wip/tsan/prep at Glasgow Haskell Compiler / GHC Commits: 04b2fc72 by Ben Gamari at 2023-07-24T13:59:28-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 1 changed file: - rts/PrimOps.cmm Changes: ===================================== rts/PrimOps.cmm ===================================== @@ -785,12 +785,13 @@ stg_atomicModifyMutVar2zh ( gcptr mv, gcptr f ) (h) = prim %cmpxchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y); if (h != x) { goto retry; } #else - h = StgMutVar_var(mv); StgMutVar_var(mv) = y; #endif - if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) { - ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", h "ptr"); + W_ info; + info = %relaxed GET_INFO(mv); + if (info == stg_MUT_VAR_CLEAN_info) { + ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", x "ptr"); } return (x,z); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04b2fc724b86703c619d55f17c7047efdf297b8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04b2fc724b86703c619d55f17c7047efdf297b8c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:00:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:00:24 -0400 Subject: [Git][ghc/ghc][wip/tsan/fix-races] 38 commits: rts: Introduce NO_WARN macro Message-ID: <64bebc3810e21_17b24eb8074646511@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fix-races at Glasgow Haskell Compiler / GHC Commits: df059575 by Ben Gamari at 2023-07-24T13:58:58-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 04b2fc72 by Ben Gamari at 2023-07-24T13:59:28-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 47cefc2c by Ben Gamari at 2023-07-24T13:59:45-04:00 codeGen/tsan: Rework handling of spilling - - - - - 0908d5aa by Ben Gamari at 2023-07-24T13:59:46-04:00 hadrian: More debug information - - - - - a5447054 by Ben Gamari at 2023-07-24T13:59:46-04:00 Improve TSAN documentation - - - - - e4045a96 by Ben Gamari at 2023-07-24T13:59:46-04:00 hadrian: More selective TSAN instrumentation - - - - - c7e56f47 by Ben Gamari at 2023-07-24T13:59:58-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - d8876441 by Ben Gamari at 2023-07-24T13:59:59-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 965e854f by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 322fec56 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Fix data race in Interpreter's preemption check - - - - - 5fd8e460 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Fix data race in threadStatus# - - - - - f0c53940 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Fix data race in CHECK_GC - - - - - 6ff3e99f by Ben Gamari at 2023-07-24T13:59:59-04:00 base: use atomic write when updating timer manager - - - - - 53fb087a by Ben Gamari at 2023-07-24T13:59:59-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - a8683256 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - e6c213ab by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Fix synchronization on thread blocking state - - - - - f35e4f70 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Relaxed load MutVar info table - - - - - 40441db9 by Ben Gamari at 2023-07-24T13:59:59-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - e54ae5d6 by Ben Gamari at 2023-07-24T13:59:59-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - 8dae1b88 by Ben Gamari at 2023-07-24T13:59:59-04:00 Wordsmith TSAN Note - - - - - 5f4429f5 by Ben Gamari at 2023-07-24T13:59:59-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - ac9392de by Ben Gamari at 2023-07-24T13:59:59-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 46b5f5d5 by Ben Gamari at 2023-07-24T13:59:59-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 52006729 by Ben Gamari at 2023-07-24T13:59:59-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 0ee0f2df by Ubuntu at 2023-07-24T13:59:59-04:00 ghc-prim: Use C11 atomics - - - - - 539e2a5b by Ubuntu at 2023-07-24T13:59:59-04:00 Run script - - - - - 1cd4cefb by Ben Gamari at 2023-07-24T13:59:59-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 945355b5 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts/Interpreter: Fix data race - - - - - a071ba09 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts/Messages: Fix data race - - - - - f6c3da63 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts/Prof: Fix data race - - - - - c0df6355 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Fix various data races - - - - - e272d834 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Use fence rather than redundant load - - - - - 15c7eeab by Ben Gamari at 2023-07-24T13:59:59-04:00 codeGen: More precise barriers for eager blackholing - - - - - 6e89673e by Ben Gamari at 2023-07-24T13:59:59-04:00 Tighten up thunk update barriers - - - - - c4dd2992 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Ensure that TSANUtils.h is included in Stg.h - - - - - 94ef84b6 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Fix unsupported fence warnings with TSAN - - - - - 1a46a250 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts/RaiseAsync: Drop redundant release fence - - - - - 690c0791 by Ben Gamari at 2023-07-24T13:59:59-04:00 rts: Fixes profiling timer races - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - libraries/base/GHC/Event/Thread.hs - libraries/ghc-prim/cbits/atomic.c - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/Proftimer.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08db5433e73a586c8db7a7feff12a5dc370628d2...690c0791fd85de6049dc845a10f2231de4a71661 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08db5433e73a586c8db7a7feff12a5dc370628d2...690c0791fd85de6049dc845a10f2231de4a71661 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:00:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:00:22 -0400 Subject: [Git][ghc/ghc][wip/tsan/cmm-codegen] 6 commits: rts: Introduce NO_WARN macro Message-ID: <64bebc362718b_17b24eb809c646359@gitlab.mail> Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC Commits: df059575 by Ben Gamari at 2023-07-24T13:58:58-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 04b2fc72 by Ben Gamari at 2023-07-24T13:59:28-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 47cefc2c by Ben Gamari at 2023-07-24T13:59:45-04:00 codeGen/tsan: Rework handling of spilling - - - - - 0908d5aa by Ben Gamari at 2023-07-24T13:59:46-04:00 hadrian: More debug information - - - - - a5447054 by Ben Gamari at 2023-07-24T13:59:46-04:00 Improve TSAN documentation - - - - - e4045a96 by Ben Gamari at 2023-07-24T13:59:46-04:00 hadrian: More selective TSAN instrumentation - - - - - 6 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - hadrian/src/Flavour.hs - rts/PrimOps.cmm - rts/include/Stg.h - rts/include/rts/TSANUtils.h Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -205,7 +205,7 @@ memory ordering guarantees. These are supported in Cmm syntax as follows: %relaxed W_[ptr] = ...; // an atomic store with relaxed ordering semantics %release W_[ptr] = ...; // an atomic store with release ordering semantics - x = W_(ptr); // a non-atomic load + x = W_[ptr]; // a non-atomic load x = %relaxed W_[ptr]; // an atomic load with relaxed ordering x = %acquire W_[ptr]; // an atomic load with acquire ordering // or equivalently... ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Cmm.ThreadSanitizer (annotateTSAN) where import GHC.Prelude -import GHC.StgToCmm.Utils (get_GlobalReg_addr) import GHC.Platform import GHC.Platform.Regs (activeStgRegs, callerSaves) import GHC.Cmm @@ -24,12 +23,12 @@ import GHC.Types.Unique.Supply import Data.Maybe (fromMaybe) data Env = Env { platform :: Platform - , uniques :: [Unique] + , uniques :: UniqSupply } annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph annotateTSAN platform graph = do - env <- Env platform <$> getUniquesM + env <- Env platform <$> getUniqueSupplyM return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph mapBlockList :: (forall e' x'. n e' x' -> Block n e' x') @@ -133,14 +132,15 @@ mkUnsafeCall env ftgt formals args = call `blockAppend` -- perform call restore -- restore global registers where - -- We are rather conservative here and just save/restore all GlobalRegs. - (save, restore) = saveRestoreCallerRegs (platform env) + (save, restore) = saveRestoreCallerRegs gregs_us (platform env) + + (arg_us, gregs_us) = splitUniqSupply (uniques env) -- We also must be careful not to mention caller-saved registers in -- arguments as Cmm-Lint checks this. To accomplish this we instead bind -- the arguments to local registers. arg_regs :: [CmmReg] - arg_regs = zipWith arg_reg (uniques env) args + arg_regs = zipWith arg_reg (uniqsFromSupply arg_us) args where arg_reg :: Unique -> CmmExpr -> CmmReg arg_reg u expr = CmmLocal $ LocalReg u (cmmExprType (platform env) expr) @@ -150,31 +150,34 @@ mkUnsafeCall env ftgt formals args = call = CmmUnsafeForeignCall ftgt formals (map CmmReg arg_regs) -saveRestoreCallerRegs :: Platform +-- | We save the contents of global registers in locals and allow the +-- register allocator to spill them to the stack around the call. +-- We cannot use the register table for this since we would interface +-- with {SAVE,RESTORE}_THREAD_STATE. +saveRestoreCallerRegs :: UniqSupply -> Platform -> (Block CmmNode O O, Block CmmNode O O) -saveRestoreCallerRegs platform = +saveRestoreCallerRegs us platform = (save, restore) where - regs = filter (callerSaves platform) (activeStgRegs platform) - - save = blockFromList (map saveReg regs) - - saveReg :: GlobalReg -> CmmNode O O - saveReg reg = - CmmStore (get_GlobalReg_addr platform reg) - (CmmReg (CmmGlobal (GlobalRegUse reg ty))) - NaturallyAligned - where ty = globalRegSpillType platform reg - - restore = blockFromList (map restoreReg regs) - - restoreReg :: GlobalReg -> CmmNode O O - restoreReg reg = - CmmAssign (CmmGlobal (GlobalRegUse reg ty)) - (CmmLoad (get_GlobalReg_addr platform reg) - ty - NaturallyAligned) - where ty = globalRegSpillType platform reg + regs_to_save :: [GlobalReg] + regs_to_save = filter (callerSaves platform) (activeStgRegs platform) + + nodes :: [(CmmNode O O, CmmNode O O)] + nodes = + zipWith mk_reg regs_to_save (uniqsFromSupply us) + where + mk_reg :: GlobalReg -> Unique -> (CmmNode O O, CmmNode O O) + mk_reg reg u = + let ty = globalRegSpillType platform reg + greg = CmmGlobal (GlobalRegUse reg ty) + lreg = CmmLocal (LocalReg u ty) + save = CmmAssign lreg (CmmReg greg) + restore = CmmAssign greg (CmmReg lreg) + in (save, restore) + + (save_nodes, restore_nodes) = unzip nodes + save = blockFromList save_nodes + restore = blockFromList restore_nodes -- | Mirrors __tsan_memory_order -- ===================================== hadrian/src/Flavour.hs ===================================== @@ -47,7 +47,8 @@ flavourTransformers = M.fromList , "ticky_ghc" =: enableTickyGhc , "split_sections" =: splitSections , "no_split_sections" =: noSplitSections - , "thread_sanitizer" =: enableThreadSanitizer + , "thread_sanitizer" =: enableThreadSanitizer False + , "thread_sanitizer_cmm" =: enableThreadSanitizer True , "llvm" =: viaLlvmBackend , "profiled_ghc" =: enableProfiledGhc , "no_dynamic_ghc" =: disableDynamicGhcPrograms @@ -152,7 +153,8 @@ werror = -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour enableDebugInfo = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? arg "-g3" + [ builder (Ghc CompileHs) ? pure ["-g3"] + , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"] , builder (Cc CompileC) ? arg "-g3" , builder (Cabal Setup) ? arg "--disable-library-stripping" , builder (Cabal Setup) ? arg "--disable-executable-stripping" @@ -218,14 +220,18 @@ noSplitSections f = f { ghcSplitSections = False } -- | Build GHC and libraries with ThreadSanitizer support. You likely want to -- configure with @--disable-large-address-space@ when using this. -enableThreadSanitizer :: Flavour -> Flavour -enableThreadSanitizer = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") - , builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" +enableThreadSanitizer :: Bool -> Flavour -> Flavour +enableThreadSanitizer instrumentCmm = addArgs $ notStage0 ? mconcat + [ instrumentCmm ? builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" + , builder (Ghc LinkHs) ? (arg "-optc-fsanitize=thread" <> arg "-optl-fsanitize=thread") , builder Cc ? arg "-fsanitize=thread" , builder (Cabal Flags) ? arg "thread-sanitizer" , builder Testsuite ? arg "--config=have_thread_sanitizer=True" + , builder (Ghc CompileHs) ? mconcat + [ package pkg ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") + | pkg <- [base, ghcPrim, array, rts] + ] ] -- | Use the LLVM backend in stages 1 and later. ===================================== rts/PrimOps.cmm ===================================== @@ -785,12 +785,13 @@ stg_atomicModifyMutVar2zh ( gcptr mv, gcptr f ) (h) = prim %cmpxchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y); if (h != x) { goto retry; } #else - h = StgMutVar_var(mv); StgMutVar_var(mv) = y; #endif - if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) { - ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", h "ptr"); + W_ info; + info = %relaxed GET_INFO(mv); + if (info == stg_MUT_VAR_CLEAN_info) { + ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", x "ptr"); } return (x,z); ===================================== rts/include/Stg.h ===================================== @@ -284,6 +284,17 @@ # define STG_RETURNS_NONNULL #endif +/* ----------------------------------------------------------------------------- + Suppressing C warnings + -------------------------------------------------------------------------- */ + +#define DO_PRAGMA(x) _Pragma(#x) +#define NO_WARN(warnoption, ...) \ + DO_PRAGMA(GCC diagnostic push) \ + DO_PRAGMA(GCC diagnostic ignored #warnoption) \ + __VA_ARGS__ \ + DO_PRAGMA(GCC diagnostic pop) + /* ----------------------------------------------------------------------------- Global type definitions -------------------------------------------------------------------------- */ ===================================== rts/include/rts/TSANUtils.h ===================================== @@ -28,6 +28,40 @@ * In general it's best to add suppressions only as a last resort, when the * more precise annotation functions prove to be insufficient. * + * GHC can be configured with two extents of TSAN instrumentation: + * + * - instrumenting the C RTS (by passing `-optc-fsanitize=thread` + * when compiling the RTS) + * + * - instrumenting both the C RTS and Cmm memory accesses (by passing + * `-optc-fsanitize=thread -fcmm-thread-sanitizer` to all GHC invocations). + * + * These two modes can be realized in Hadrian using the `+thread_sanitizer` + * and `+thread_sanitizer_cmm` flavour transformers. + * + * Tips and tricks: + * + * - One should generally run TSAN instrumented programs with the environment + * variable + * + * TSAN_OPTIONS=suppressions=$ghc_root/rts/.tsan-suppressions + * + * to maximize signal-to-noise. + * + * - One can set a breakpoint on `__tsan_on_report` in a debugger to pause when + * a TSAN report is found. + * + * - TSAN-instrumented will by default exit with code 66 when a violation has + * been found. However, this can be disabled by setting + * `TSAN_OPTIONS=exitcode=0` + * + * - If TSAN is able to report useful stack traces it may help to set + * `TSAN_OPTIONS=history_size=3` or greater (up to 7). This increases the + * size of TSAN's per-thread memory access history buffer. + * + * - TSAN report messages can be redirected to a file using + * `TSAN_OPTIONS=log_path=...` + * * Users guide: https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4af5ca8d0c20fd13289ea28135b9525e3ba642d0...e4045a960c7e224e3a084edc67755c3fdc2ffa70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4af5ca8d0c20fd13289ea28135b9525e3ba642d0...e4045a960c7e224e3a084edc67755c3fdc2ffa70 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:04:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:04:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/c11-atomics Message-ID: <64bebd46c8742_17b24eb8074646944@gitlab.mail> Ben Gamari pushed new branch wip/tsan/c11-atomics at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/c11-atomics You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:06:17 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 24 Jul 2023 14:06:17 -0400 Subject: [Git][ghc/ghc][wip/expand-do] fix the runtime rep errors for rebindable syntax Message-ID: <64bebd99ad953_17b24eb806064932f@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 0e4d8c27 by Apoorv Ingle at 2023-07-24T13:05:56-05:00 fix the runtime rep errors for rebindable syntax - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -737,25 +737,28 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args -- Rule IARG from Fig 4 of the QL paper: go1 delta acc so_far fun_ty (eva@(EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt }) : rest_args) - = do { (wrap, arg_ty, res_ty) <- + = do { let herald = case fun_ctxt of + VAExpansionStmt{} -> ExpectedFunTySyntaxOp DoOrigin tc_fun + _ -> ExpectedFunTyArg (HsExprTcThing tc_fun) (unLoc arg) + ; (wrap, arg_ty, res_ty) <- -- NB: matchActualFunTySigma does the rep-poly check. -- For example, suppose we have f :: forall r (a::TYPE r). a -> Int -- In an application (f x), we need 'x' to have a fixed runtime -- representation; matchActualFunTySigma checks that when -- taking apart the arrow type (a -> Int). matchActualFunTySigma - (ExpectedFunTyArg (HsExprTcThing tc_fun) (unLoc arg)) + herald (Just $ HsExprTcThing tc_fun) (n_val_args, so_far) fun_ty - ; (delta', arg') <- if do_ql + ; (delta', arg') <- if do_ql then addArgCtxt ctxt arg $ -- Context needed for constraints -- generated by calls in arg quickLookArg delta arg arg_ty else return (delta, ValArg arg) - ; let acc' = eva { eva_arg = arg', eva_arg_ty = arg_ty } + ; let acc' = eva { eva_arg = arg', eva_arg_ty = arg_ty } : addArgWrap wrap acc - ; go delta' acc' (arg_ty:so_far) res_ty rest_args } + ; go delta' acc' (arg_ty:so_far) res_ty rest_args } addArgCtxt :: AppCtxt -> LHsExpr GhcRn ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1547,20 +1547,20 @@ addStmtCtxt doc stmt thing_inside where pprStmtInCtxt :: Bool -> HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc - pprStmtInCtxt isRebindable ctxt stmt - = vcat [ hang (text "In" <+> optionalExpansionClause isRebindable stmt <+> text "a stmt of" + pprStmtInCtxt _ ctxt stmt + = vcat [ hang (text "In" <+> {-optionalExpansionClause isRebindable stmt <+>-} text "a stmt of" <+> pprAStmtContext ctxt <> colon) 2 (pprStmt stmt) - , optionalNote isRebindable + -- , optionalNote isRebindable ] - optionalExpansionClause :: Bool -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc - optionalExpansionClause True stmt | BindStmt{} <- stmt = text "the expansion of" - | otherwise = empty - optionalExpansionClause _ _ = empty + -- optionalExpansionClause :: Bool -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc + -- optionalExpansionClause True stmt | BindStmt{} <- stmt = text "the expansion of" + -- | otherwise = empty + -- optionalExpansionClause _ _ = empty - optionalNote :: Bool -> SDoc - optionalNote True = text "NB: The language extension" <+> ppr LangExt.RebindableSyntax <+> text "is turned on" - optionalNote _ = empty + -- optionalNote :: Bool -> SDoc + -- optionalNote True = text "NB: The language extension" <+> ppr LangExt.RebindableSyntax <+> text "is turned on" + -- optionalNote _ = empty addExprCtxt :: SDoc -> HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt doc e thing_inside ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -436,6 +436,7 @@ tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside (rhs', rhs_ty) <- tcScalingUsage ManyTy $ tcInferRhoNC rhs -- Stmt has a context already ; hasFixedRuntimeRep_syntactic FRRBindStmtGuard rhs_ty + ; traceTc "tcGuardStmt" (ppr pat <+> ppr rhs) ; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (unrestricted rhs_ty) $ thing_inside res_ty ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1386,9 +1386,9 @@ data ExpectedFunTyOrigin -- -- Test cases for representation-polymorphism checks: -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK - = ExpectedFunTySyntaxOp - !CtOrigin - !(HsExpr GhcRn) + = forall (p :: Pass) + . (OutputableBndrId p) + => ExpectedFunTySyntaxOp !CtOrigin !(HsExpr (GhcPass p)) -- ^ rebindable syntax operator -- | A view pattern must have a function type. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e4d8c27c9f6bb9baaead3971e56f852e76fc6d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0e4d8c27c9f6bb9baaead3971e56f852e76fc6d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:17:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:17:33 -0400 Subject: [Git][ghc/ghc][wip/tsan/prep] 3 commits: rts: Introduce more principled fence operations Message-ID: <64bec03d9a7c_17b24eb8060651577@gitlab.mail> Ben Gamari pushed to branch wip/tsan/prep at Glasgow Haskell Compiler / GHC Commits: afdc15ea by Ben Gamari at 2023-07-24T14:13:28-04:00 rts: Introduce more principled fence operations - - - - - 6bdb0bce by Ben Gamari at 2023-07-24T14:14:02-04:00 rts: Introduce SET_INFO_RELAXED - - - - - af672b66 by Ben Gamari at 2023-07-24T14:14:11-04:00 rts: Fix unsupported fence warnings with TSAN - - - - - 3 changed files: - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h - rts/include/stg/SMP.h Changes: ===================================== rts/include/Cmm.h ===================================== @@ -596,6 +596,7 @@ /* Getting/setting the info pointer of a closure */ #define SET_INFO(p,info) StgHeader_info(p) = info #define SET_INFO_RELEASE(p,info) %release StgHeader_info(p) = info +#define SET_INFO_RELAXED(p,info) %relaxed StgHeader_info(p) = info #define GET_INFO(p) StgHeader_info(p) #define GET_INFO_ACQUIRE(p) %acquire GET_INFO(p) @@ -687,10 +688,18 @@ #define RELEASE_FENCE prim %fence_release(); #define ACQUIRE_FENCE prim %fence_acquire(); +// TODO +#if 1 +#define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire64(x); } +#else +#define ACQUIRE_FENCE_ON(x) ACQUIRE_FENCE +#endif + #else #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ +#define ACQUIRE_FENCE_ON(x) /* nothing */ #endif /* THREADED_RTS */ /* ----------------------------------------------------------------------------- ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -47,6 +47,11 @@ EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info); EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info) { + c->header.info = info; +} + +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info); +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info) { RELAXED_STORE(&c->header.info, info); } @@ -70,6 +75,7 @@ EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl (const StgInfoTable *i); EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl (const StgInfoTable *i); #if defined(TABLES_NEXT_TO_CODE) +NO_WARN(-Warray-bounds, EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;} EXTERN_INLINE StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;} @@ -79,6 +85,7 @@ EXTERN_INLINE StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return ( EXTERN_INLINE StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;} +) #else EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;} ===================================== rts/include/stg/SMP.h ===================================== @@ -490,10 +490,25 @@ busy_wait_nop(void) // These are typically necessary only in very specific cases (e.g. WSDeque) // where the ordered operations aren't expressive enough to capture the desired // ordering. +// +// Additionally, it is preferable to use the *_FENCE_ON() forms, which turn into +// memory accesses when compiling for ThreadSanitizer (as ThreadSanitizer is +// otherwise unable to reason about fences). See Note [ThreadSanitizer] in +// TSANUtils.h. + #define ACQUIRE_FENCE() __atomic_thread_fence(__ATOMIC_ACQUIRE) #define RELEASE_FENCE() __atomic_thread_fence(__ATOMIC_RELEASE) #define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) +#if defined(TSAN_ENABLED) +#define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);) +#define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);) +#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) +#define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) +#else +#define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) +#endif + /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ @@ -521,6 +536,8 @@ busy_wait_nop(void) #define ACQUIRE_FENCE() #define RELEASE_FENCE() #define SEQ_CST_FENCE() +#define ACQUIRE_FENCE_ON(x) +#define RELEASE_FENCE_ON(x) #if !IN_STG_CODE || IN_STGCRUN INLINE_HEADER StgWord View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04b2fc724b86703c619d55f17c7047efdf297b8c...af672b6669059a8df0e04cbd2b2959d0390830fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04b2fc724b86703c619d55f17c7047efdf297b8c...af672b6669059a8df0e04cbd2b2959d0390830fb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:17:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:17:59 -0400 Subject: [Git][ghc/ghc][wip/tsan/cmm-codegen] 7 commits: rts: Introduce more principled fence operations Message-ID: <64bec0575a928_17b24eb80106519c4@gitlab.mail> Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC Commits: afdc15ea by Ben Gamari at 2023-07-24T14:13:28-04:00 rts: Introduce more principled fence operations - - - - - 6bdb0bce by Ben Gamari at 2023-07-24T14:14:02-04:00 rts: Introduce SET_INFO_RELAXED - - - - - af672b66 by Ben Gamari at 2023-07-24T14:14:11-04:00 rts: Fix unsupported fence warnings with TSAN - - - - - 9451cd1e by Ben Gamari at 2023-07-24T14:17:51-04:00 codeGen/tsan: Rework handling of spilling - - - - - 65feb180 by Ben Gamari at 2023-07-24T14:17:51-04:00 hadrian: More debug information - - - - - 4993f3b4 by Ben Gamari at 2023-07-24T14:17:51-04:00 Improve TSAN documentation - - - - - e4820538 by Ben Gamari at 2023-07-24T14:17:51-04:00 hadrian: More selective TSAN instrumentation - - - - - 7 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - hadrian/src/Flavour.hs - rts/include/Cmm.h - rts/include/rts/TSANUtils.h - rts/include/rts/storage/ClosureMacros.h - rts/include/stg/SMP.h Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -205,7 +205,7 @@ memory ordering guarantees. These are supported in Cmm syntax as follows: %relaxed W_[ptr] = ...; // an atomic store with relaxed ordering semantics %release W_[ptr] = ...; // an atomic store with release ordering semantics - x = W_(ptr); // a non-atomic load + x = W_[ptr]; // a non-atomic load x = %relaxed W_[ptr]; // an atomic load with relaxed ordering x = %acquire W_[ptr]; // an atomic load with acquire ordering // or equivalently... ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Cmm.ThreadSanitizer (annotateTSAN) where import GHC.Prelude -import GHC.StgToCmm.Utils (get_GlobalReg_addr) import GHC.Platform import GHC.Platform.Regs (activeStgRegs, callerSaves) import GHC.Cmm @@ -24,12 +23,12 @@ import GHC.Types.Unique.Supply import Data.Maybe (fromMaybe) data Env = Env { platform :: Platform - , uniques :: [Unique] + , uniques :: UniqSupply } annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph annotateTSAN platform graph = do - env <- Env platform <$> getUniquesM + env <- Env platform <$> getUniqueSupplyM return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph mapBlockList :: (forall e' x'. n e' x' -> Block n e' x') @@ -133,14 +132,15 @@ mkUnsafeCall env ftgt formals args = call `blockAppend` -- perform call restore -- restore global registers where - -- We are rather conservative here and just save/restore all GlobalRegs. - (save, restore) = saveRestoreCallerRegs (platform env) + (save, restore) = saveRestoreCallerRegs gregs_us (platform env) + + (arg_us, gregs_us) = splitUniqSupply (uniques env) -- We also must be careful not to mention caller-saved registers in -- arguments as Cmm-Lint checks this. To accomplish this we instead bind -- the arguments to local registers. arg_regs :: [CmmReg] - arg_regs = zipWith arg_reg (uniques env) args + arg_regs = zipWith arg_reg (uniqsFromSupply arg_us) args where arg_reg :: Unique -> CmmExpr -> CmmReg arg_reg u expr = CmmLocal $ LocalReg u (cmmExprType (platform env) expr) @@ -150,31 +150,34 @@ mkUnsafeCall env ftgt formals args = call = CmmUnsafeForeignCall ftgt formals (map CmmReg arg_regs) -saveRestoreCallerRegs :: Platform +-- | We save the contents of global registers in locals and allow the +-- register allocator to spill them to the stack around the call. +-- We cannot use the register table for this since we would interface +-- with {SAVE,RESTORE}_THREAD_STATE. +saveRestoreCallerRegs :: UniqSupply -> Platform -> (Block CmmNode O O, Block CmmNode O O) -saveRestoreCallerRegs platform = +saveRestoreCallerRegs us platform = (save, restore) where - regs = filter (callerSaves platform) (activeStgRegs platform) - - save = blockFromList (map saveReg regs) - - saveReg :: GlobalReg -> CmmNode O O - saveReg reg = - CmmStore (get_GlobalReg_addr platform reg) - (CmmReg (CmmGlobal (GlobalRegUse reg ty))) - NaturallyAligned - where ty = globalRegSpillType platform reg - - restore = blockFromList (map restoreReg regs) - - restoreReg :: GlobalReg -> CmmNode O O - restoreReg reg = - CmmAssign (CmmGlobal (GlobalRegUse reg ty)) - (CmmLoad (get_GlobalReg_addr platform reg) - ty - NaturallyAligned) - where ty = globalRegSpillType platform reg + regs_to_save :: [GlobalReg] + regs_to_save = filter (callerSaves platform) (activeStgRegs platform) + + nodes :: [(CmmNode O O, CmmNode O O)] + nodes = + zipWith mk_reg regs_to_save (uniqsFromSupply us) + where + mk_reg :: GlobalReg -> Unique -> (CmmNode O O, CmmNode O O) + mk_reg reg u = + let ty = globalRegSpillType platform reg + greg = CmmGlobal (GlobalRegUse reg ty) + lreg = CmmLocal (LocalReg u ty) + save = CmmAssign lreg (CmmReg greg) + restore = CmmAssign greg (CmmReg lreg) + in (save, restore) + + (save_nodes, restore_nodes) = unzip nodes + save = blockFromList save_nodes + restore = blockFromList restore_nodes -- | Mirrors __tsan_memory_order -- ===================================== hadrian/src/Flavour.hs ===================================== @@ -47,7 +47,8 @@ flavourTransformers = M.fromList , "ticky_ghc" =: enableTickyGhc , "split_sections" =: splitSections , "no_split_sections" =: noSplitSections - , "thread_sanitizer" =: enableThreadSanitizer + , "thread_sanitizer" =: enableThreadSanitizer False + , "thread_sanitizer_cmm" =: enableThreadSanitizer True , "llvm" =: viaLlvmBackend , "profiled_ghc" =: enableProfiledGhc , "no_dynamic_ghc" =: disableDynamicGhcPrograms @@ -152,7 +153,8 @@ werror = -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour enableDebugInfo = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? arg "-g3" + [ builder (Ghc CompileHs) ? pure ["-g3"] + , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"] , builder (Cc CompileC) ? arg "-g3" , builder (Cabal Setup) ? arg "--disable-library-stripping" , builder (Cabal Setup) ? arg "--disable-executable-stripping" @@ -218,14 +220,18 @@ noSplitSections f = f { ghcSplitSections = False } -- | Build GHC and libraries with ThreadSanitizer support. You likely want to -- configure with @--disable-large-address-space@ when using this. -enableThreadSanitizer :: Flavour -> Flavour -enableThreadSanitizer = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") - , builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" +enableThreadSanitizer :: Bool -> Flavour -> Flavour +enableThreadSanitizer instrumentCmm = addArgs $ notStage0 ? mconcat + [ instrumentCmm ? builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" + , builder (Ghc LinkHs) ? (arg "-optc-fsanitize=thread" <> arg "-optl-fsanitize=thread") , builder Cc ? arg "-fsanitize=thread" , builder (Cabal Flags) ? arg "thread-sanitizer" , builder Testsuite ? arg "--config=have_thread_sanitizer=True" + , builder (Ghc CompileHs) ? mconcat + [ package pkg ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") + | pkg <- [base, ghcPrim, array, rts] + ] ] -- | Use the LLVM backend in stages 1 and later. ===================================== rts/include/Cmm.h ===================================== @@ -596,6 +596,7 @@ /* Getting/setting the info pointer of a closure */ #define SET_INFO(p,info) StgHeader_info(p) = info #define SET_INFO_RELEASE(p,info) %release StgHeader_info(p) = info +#define SET_INFO_RELAXED(p,info) %relaxed StgHeader_info(p) = info #define GET_INFO(p) StgHeader_info(p) #define GET_INFO_ACQUIRE(p) %acquire GET_INFO(p) @@ -687,10 +688,18 @@ #define RELEASE_FENCE prim %fence_release(); #define ACQUIRE_FENCE prim %fence_acquire(); +// TODO +#if 1 +#define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire64(x); } +#else +#define ACQUIRE_FENCE_ON(x) ACQUIRE_FENCE +#endif + #else #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ +#define ACQUIRE_FENCE_ON(x) /* nothing */ #endif /* THREADED_RTS */ /* ----------------------------------------------------------------------------- ===================================== rts/include/rts/TSANUtils.h ===================================== @@ -28,6 +28,40 @@ * In general it's best to add suppressions only as a last resort, when the * more precise annotation functions prove to be insufficient. * + * GHC can be configured with two extents of TSAN instrumentation: + * + * - instrumenting the C RTS (by passing `-optc-fsanitize=thread` + * when compiling the RTS) + * + * - instrumenting both the C RTS and Cmm memory accesses (by passing + * `-optc-fsanitize=thread -fcmm-thread-sanitizer` to all GHC invocations). + * + * These two modes can be realized in Hadrian using the `+thread_sanitizer` + * and `+thread_sanitizer_cmm` flavour transformers. + * + * Tips and tricks: + * + * - One should generally run TSAN instrumented programs with the environment + * variable + * + * TSAN_OPTIONS=suppressions=$ghc_root/rts/.tsan-suppressions + * + * to maximize signal-to-noise. + * + * - One can set a breakpoint on `__tsan_on_report` in a debugger to pause when + * a TSAN report is found. + * + * - TSAN-instrumented will by default exit with code 66 when a violation has + * been found. However, this can be disabled by setting + * `TSAN_OPTIONS=exitcode=0` + * + * - If TSAN is able to report useful stack traces it may help to set + * `TSAN_OPTIONS=history_size=3` or greater (up to 7). This increases the + * size of TSAN's per-thread memory access history buffer. + * + * - TSAN report messages can be redirected to a file using + * `TSAN_OPTIONS=log_path=...` + * * Users guide: https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual */ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -47,6 +47,11 @@ EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info); EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info) { + c->header.info = info; +} + +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info); +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info) { RELAXED_STORE(&c->header.info, info); } @@ -70,6 +75,7 @@ EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl (const StgInfoTable *i); EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl (const StgInfoTable *i); #if defined(TABLES_NEXT_TO_CODE) +NO_WARN(-Warray-bounds, EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;} EXTERN_INLINE StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;} @@ -79,6 +85,7 @@ EXTERN_INLINE StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return ( EXTERN_INLINE StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;} +) #else EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;} ===================================== rts/include/stg/SMP.h ===================================== @@ -490,10 +490,25 @@ busy_wait_nop(void) // These are typically necessary only in very specific cases (e.g. WSDeque) // where the ordered operations aren't expressive enough to capture the desired // ordering. +// +// Additionally, it is preferable to use the *_FENCE_ON() forms, which turn into +// memory accesses when compiling for ThreadSanitizer (as ThreadSanitizer is +// otherwise unable to reason about fences). See Note [ThreadSanitizer] in +// TSANUtils.h. + #define ACQUIRE_FENCE() __atomic_thread_fence(__ATOMIC_ACQUIRE) #define RELEASE_FENCE() __atomic_thread_fence(__ATOMIC_RELEASE) #define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) +#if defined(TSAN_ENABLED) +#define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);) +#define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);) +#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) +#define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) +#else +#define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) +#endif + /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ @@ -521,6 +536,8 @@ busy_wait_nop(void) #define ACQUIRE_FENCE() #define RELEASE_FENCE() #define SEQ_CST_FENCE() +#define ACQUIRE_FENCE_ON(x) +#define RELEASE_FENCE_ON(x) #if !IN_STG_CODE || IN_STGCRUN INLINE_HEADER StgWord View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4045a960c7e224e3a084edc67755c3fdc2ffa70...e4820538810f0b348ee0155f90811ada0956058b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4045a960c7e224e3a084edc67755c3fdc2ffa70...e4820538810f0b348ee0155f90811ada0956058b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:30:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:30:21 -0400 Subject: [Git][ghc/ghc][wip/tsan/fix-races] 30 commits: rts: Introduce more principled fence operations Message-ID: <64bec33d68229_17b24eb80106545a8@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fix-races at Glasgow Haskell Compiler / GHC Commits: b431aa81 by Ben Gamari at 2023-07-24T14:23:58-04:00 rts: Introduce more principled fence operations - - - - - 8a64b390 by Ben Gamari at 2023-07-24T14:23:59-04:00 rts: Introduce SET_INFO_RELAXED - - - - - e6f15532 by Ben Gamari at 2023-07-24T14:24:28-04:00 codeGen/tsan: Rework handling of spilling - - - - - 30d33118 by Ben Gamari at 2023-07-24T14:24:28-04:00 hadrian: More debug information - - - - - 83b508dc by Ben Gamari at 2023-07-24T14:24:28-04:00 Improve TSAN documentation - - - - - 97e29767 by Ben Gamari at 2023-07-24T14:24:28-04:00 hadrian: More selective TSAN instrumentation - - - - - 0c1b925a by Ben Gamari at 2023-07-24T14:24:58-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - e9398995 by Ben Gamari at 2023-07-24T14:24:58-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - f1d15c88 by Ben Gamari at 2023-07-24T14:24:58-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 565f2c96 by Ben Gamari at 2023-07-24T14:29:49-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - cfa412f9 by Ben Gamari at 2023-07-24T14:29:49-04:00 rts: Fix data race in Interpreter's preemption check - - - - - 6b7d605f by Ben Gamari at 2023-07-24T14:29:49-04:00 rts: Fix data race in threadStatus# - - - - - a11ca8ee by Ben Gamari at 2023-07-24T14:29:49-04:00 rts: Fix data race in CHECK_GC - - - - - 4fac43a6 by Ben Gamari at 2023-07-24T14:29:49-04:00 base: use atomic write when updating timer manager - - - - - 5e22b039 by Ben Gamari at 2023-07-24T14:29:49-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - c105d725 by Ben Gamari at 2023-07-24T14:29:49-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 1a3a0576 by Ben Gamari at 2023-07-24T14:29:49-04:00 rts: Fix synchronization on thread blocking state - - - - - 1b5951a0 by Ben Gamari at 2023-07-24T14:29:49-04:00 rts: Relaxed load MutVar info table - - - - - 19cbd620 by Ben Gamari at 2023-07-24T14:29:50-04:00 Wordsmith TSAN Note - - - - - 3ae8b8fa by Ben Gamari at 2023-07-24T14:29:50-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 2db2c8d9 by Ben Gamari at 2023-07-24T14:29:50-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 4be16b7b by Ben Gamari at 2023-07-24T14:29:50-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 20982159 by Ben Gamari at 2023-07-24T14:29:50-04:00 rts/Interpreter: Fix data race - - - - - 30ab9251 by Ben Gamari at 2023-07-24T14:29:50-04:00 rts/Messages: Fix data race - - - - - be9e5ae6 by Ben Gamari at 2023-07-24T14:29:50-04:00 rts/Prof: Fix data race - - - - - 9698a4c6 by Ben Gamari at 2023-07-24T14:29:50-04:00 rts: Fix various data races - - - - - c14da691 by Ben Gamari at 2023-07-24T14:29:50-04:00 rts: Use fence rather than redundant load - - - - - c3b7e920 by Ben Gamari at 2023-07-24T14:29:50-04:00 Tighten up thunk update barriers - - - - - 60876ace by Ben Gamari at 2023-07-24T14:29:50-04:00 rts/RaiseAsync: Drop redundant release fence - - - - - baafa60e by Ben Gamari at 2023-07-24T14:29:50-04:00 rts: Fixes profiling timer races - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - libraries/base/GHC/Event/Thread.hs - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/Proftimer.c - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c - rts/StgMiscClosures.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690c0791fd85de6049dc845a10f2231de4a71661...baafa60e240b05a2a225ec0b730447db8837a1a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690c0791fd85de6049dc845a10f2231de4a71661...baafa60e240b05a2a225ec0b730447db8837a1a4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:30:19 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:30:19 -0400 Subject: [Git][ghc/ghc][wip/tsan/cmm-codegen] 6 commits: rts: Introduce more principled fence operations Message-ID: <64bec33ae8766_17b24eb807465432e@gitlab.mail> Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC Commits: b431aa81 by Ben Gamari at 2023-07-24T14:23:58-04:00 rts: Introduce more principled fence operations - - - - - 8a64b390 by Ben Gamari at 2023-07-24T14:23:59-04:00 rts: Introduce SET_INFO_RELAXED - - - - - e6f15532 by Ben Gamari at 2023-07-24T14:24:28-04:00 codeGen/tsan: Rework handling of spilling - - - - - 30d33118 by Ben Gamari at 2023-07-24T14:24:28-04:00 hadrian: More debug information - - - - - 83b508dc by Ben Gamari at 2023-07-24T14:24:28-04:00 Improve TSAN documentation - - - - - 97e29767 by Ben Gamari at 2023-07-24T14:24:28-04:00 hadrian: More selective TSAN instrumentation - - - - - 9 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - hadrian/src/Flavour.hs - rts/include/Cmm.h - rts/include/Rts.h - rts/include/Stg.h - rts/include/rts/TSANUtils.h - rts/include/rts/storage/ClosureMacros.h - rts/include/stg/SMP.h Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -205,7 +205,7 @@ memory ordering guarantees. These are supported in Cmm syntax as follows: %relaxed W_[ptr] = ...; // an atomic store with relaxed ordering semantics %release W_[ptr] = ...; // an atomic store with release ordering semantics - x = W_(ptr); // a non-atomic load + x = W_[ptr]; // a non-atomic load x = %relaxed W_[ptr]; // an atomic load with relaxed ordering x = %acquire W_[ptr]; // an atomic load with acquire ordering // or equivalently... ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Cmm.ThreadSanitizer (annotateTSAN) where import GHC.Prelude -import GHC.StgToCmm.Utils (get_GlobalReg_addr) import GHC.Platform import GHC.Platform.Regs (activeStgRegs, callerSaves) import GHC.Cmm @@ -24,12 +23,12 @@ import GHC.Types.Unique.Supply import Data.Maybe (fromMaybe) data Env = Env { platform :: Platform - , uniques :: [Unique] + , uniques :: UniqSupply } annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph annotateTSAN platform graph = do - env <- Env platform <$> getUniquesM + env <- Env platform <$> getUniqueSupplyM return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph mapBlockList :: (forall e' x'. n e' x' -> Block n e' x') @@ -133,14 +132,15 @@ mkUnsafeCall env ftgt formals args = call `blockAppend` -- perform call restore -- restore global registers where - -- We are rather conservative here and just save/restore all GlobalRegs. - (save, restore) = saveRestoreCallerRegs (platform env) + (save, restore) = saveRestoreCallerRegs gregs_us (platform env) + + (arg_us, gregs_us) = splitUniqSupply (uniques env) -- We also must be careful not to mention caller-saved registers in -- arguments as Cmm-Lint checks this. To accomplish this we instead bind -- the arguments to local registers. arg_regs :: [CmmReg] - arg_regs = zipWith arg_reg (uniques env) args + arg_regs = zipWith arg_reg (uniqsFromSupply arg_us) args where arg_reg :: Unique -> CmmExpr -> CmmReg arg_reg u expr = CmmLocal $ LocalReg u (cmmExprType (platform env) expr) @@ -150,31 +150,34 @@ mkUnsafeCall env ftgt formals args = call = CmmUnsafeForeignCall ftgt formals (map CmmReg arg_regs) -saveRestoreCallerRegs :: Platform +-- | We save the contents of global registers in locals and allow the +-- register allocator to spill them to the stack around the call. +-- We cannot use the register table for this since we would interface +-- with {SAVE,RESTORE}_THREAD_STATE. +saveRestoreCallerRegs :: UniqSupply -> Platform -> (Block CmmNode O O, Block CmmNode O O) -saveRestoreCallerRegs platform = +saveRestoreCallerRegs us platform = (save, restore) where - regs = filter (callerSaves platform) (activeStgRegs platform) - - save = blockFromList (map saveReg regs) - - saveReg :: GlobalReg -> CmmNode O O - saveReg reg = - CmmStore (get_GlobalReg_addr platform reg) - (CmmReg (CmmGlobal (GlobalRegUse reg ty))) - NaturallyAligned - where ty = globalRegSpillType platform reg - - restore = blockFromList (map restoreReg regs) - - restoreReg :: GlobalReg -> CmmNode O O - restoreReg reg = - CmmAssign (CmmGlobal (GlobalRegUse reg ty)) - (CmmLoad (get_GlobalReg_addr platform reg) - ty - NaturallyAligned) - where ty = globalRegSpillType platform reg + regs_to_save :: [GlobalReg] + regs_to_save = filter (callerSaves platform) (activeStgRegs platform) + + nodes :: [(CmmNode O O, CmmNode O O)] + nodes = + zipWith mk_reg regs_to_save (uniqsFromSupply us) + where + mk_reg :: GlobalReg -> Unique -> (CmmNode O O, CmmNode O O) + mk_reg reg u = + let ty = globalRegSpillType platform reg + greg = CmmGlobal (GlobalRegUse reg ty) + lreg = CmmLocal (LocalReg u ty) + save = CmmAssign lreg (CmmReg greg) + restore = CmmAssign greg (CmmReg lreg) + in (save, restore) + + (save_nodes, restore_nodes) = unzip nodes + save = blockFromList save_nodes + restore = blockFromList restore_nodes -- | Mirrors __tsan_memory_order -- ===================================== hadrian/src/Flavour.hs ===================================== @@ -47,7 +47,8 @@ flavourTransformers = M.fromList , "ticky_ghc" =: enableTickyGhc , "split_sections" =: splitSections , "no_split_sections" =: noSplitSections - , "thread_sanitizer" =: enableThreadSanitizer + , "thread_sanitizer" =: enableThreadSanitizer False + , "thread_sanitizer_cmm" =: enableThreadSanitizer True , "llvm" =: viaLlvmBackend , "profiled_ghc" =: enableProfiledGhc , "no_dynamic_ghc" =: disableDynamicGhcPrograms @@ -152,7 +153,8 @@ werror = -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour enableDebugInfo = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? arg "-g3" + [ builder (Ghc CompileHs) ? pure ["-g3"] + , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"] , builder (Cc CompileC) ? arg "-g3" , builder (Cabal Setup) ? arg "--disable-library-stripping" , builder (Cabal Setup) ? arg "--disable-executable-stripping" @@ -218,14 +220,18 @@ noSplitSections f = f { ghcSplitSections = False } -- | Build GHC and libraries with ThreadSanitizer support. You likely want to -- configure with @--disable-large-address-space@ when using this. -enableThreadSanitizer :: Flavour -> Flavour -enableThreadSanitizer = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") - , builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" +enableThreadSanitizer :: Bool -> Flavour -> Flavour +enableThreadSanitizer instrumentCmm = addArgs $ notStage0 ? mconcat + [ instrumentCmm ? builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" + , builder (Ghc LinkHs) ? (arg "-optc-fsanitize=thread" <> arg "-optl-fsanitize=thread") , builder Cc ? arg "-fsanitize=thread" , builder (Cabal Flags) ? arg "thread-sanitizer" , builder Testsuite ? arg "--config=have_thread_sanitizer=True" + , builder (Ghc CompileHs) ? mconcat + [ package pkg ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") + | pkg <- [base, ghcPrim, array, rts] + ] ] -- | Use the LLVM backend in stages 1 and later. ===================================== rts/include/Cmm.h ===================================== @@ -596,6 +596,7 @@ /* Getting/setting the info pointer of a closure */ #define SET_INFO(p,info) StgHeader_info(p) = info #define SET_INFO_RELEASE(p,info) %release StgHeader_info(p) = info +#define SET_INFO_RELAXED(p,info) %relaxed StgHeader_info(p) = info #define GET_INFO(p) StgHeader_info(p) #define GET_INFO_ACQUIRE(p) %acquire GET_INFO(p) @@ -687,10 +688,18 @@ #define RELEASE_FENCE prim %fence_release(); #define ACQUIRE_FENCE prim %fence_acquire(); +// TODO +#if 1 +#define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire64(x); } +#else +#define ACQUIRE_FENCE_ON(x) ACQUIRE_FENCE +#endif + #else #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ +#define ACQUIRE_FENCE_ON(x) /* nothing */ #endif /* THREADED_RTS */ /* ----------------------------------------------------------------------------- ===================================== rts/include/Rts.h ===================================== @@ -236,7 +236,6 @@ void _warnFail(const char *filename, unsigned int linenum); /* Parallel information */ #include "rts/OSThreads.h" -#include "rts/TSANUtils.h" #include "rts/SpinLock.h" #include "rts/Messages.h" ===================================== rts/include/Stg.h ===================================== @@ -393,6 +393,7 @@ external prototype return neither of these types to workaround #11395. #include "stg/MachRegsForHost.h" #include "stg/Regs.h" #include "stg/Ticky.h" +#include "rts/TSANUtils.h" #if IN_STG_CODE /* ===================================== rts/include/rts/TSANUtils.h ===================================== @@ -28,6 +28,40 @@ * In general it's best to add suppressions only as a last resort, when the * more precise annotation functions prove to be insufficient. * + * GHC can be configured with two extents of TSAN instrumentation: + * + * - instrumenting the C RTS (by passing `-optc-fsanitize=thread` + * when compiling the RTS) + * + * - instrumenting both the C RTS and Cmm memory accesses (by passing + * `-optc-fsanitize=thread -fcmm-thread-sanitizer` to all GHC invocations). + * + * These two modes can be realized in Hadrian using the `+thread_sanitizer` + * and `+thread_sanitizer_cmm` flavour transformers. + * + * Tips and tricks: + * + * - One should generally run TSAN instrumented programs with the environment + * variable + * + * TSAN_OPTIONS=suppressions=$ghc_root/rts/.tsan-suppressions + * + * to maximize signal-to-noise. + * + * - One can set a breakpoint on `__tsan_on_report` in a debugger to pause when + * a TSAN report is found. + * + * - TSAN-instrumented will by default exit with code 66 when a violation has + * been found. However, this can be disabled by setting + * `TSAN_OPTIONS=exitcode=0` + * + * - If TSAN is able to report useful stack traces it may help to set + * `TSAN_OPTIONS=history_size=3` or greater (up to 7). This increases the + * size of TSAN's per-thread memory access history buffer. + * + * - TSAN report messages can be redirected to a file using + * `TSAN_OPTIONS=log_path=...` + * * Users guide: https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual */ ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -47,6 +47,11 @@ EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info); EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info) { + c->header.info = info; +} + +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info); +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info) { RELAXED_STORE(&c->header.info, info); } @@ -70,6 +75,7 @@ EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl (const StgInfoTable *i); EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl (const StgInfoTable *i); #if defined(TABLES_NEXT_TO_CODE) +NO_WARN(-Warray-bounds, EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;} EXTERN_INLINE StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;} @@ -79,6 +85,7 @@ EXTERN_INLINE StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return ( EXTERN_INLINE StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;} +) #else EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;} ===================================== rts/include/stg/SMP.h ===================================== @@ -490,10 +490,25 @@ busy_wait_nop(void) // These are typically necessary only in very specific cases (e.g. WSDeque) // where the ordered operations aren't expressive enough to capture the desired // ordering. +// +// Additionally, it is preferable to use the *_FENCE_ON() forms, which turn into +// memory accesses when compiling for ThreadSanitizer (as ThreadSanitizer is +// otherwise unable to reason about fences). See Note [ThreadSanitizer] in +// TSANUtils.h. + #define ACQUIRE_FENCE() __atomic_thread_fence(__ATOMIC_ACQUIRE) #define RELEASE_FENCE() __atomic_thread_fence(__ATOMIC_RELEASE) #define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) +#if defined(TSAN_ENABLED) +#define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);) +#define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);) +#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) +#define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) +#else +#define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) +#endif + /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ @@ -521,6 +536,8 @@ busy_wait_nop(void) #define ACQUIRE_FENCE() #define RELEASE_FENCE() #define SEQ_CST_FENCE() +#define ACQUIRE_FENCE_ON(x) +#define RELEASE_FENCE_ON(x) #if !IN_STG_CODE || IN_STGCRUN INLINE_HEADER StgWord View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4820538810f0b348ee0155f90811ada0956058b...97e297677ef8478d30157f8a1cac5cd84f9623b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4820538810f0b348ee0155f90811ada0956058b...97e297677ef8478d30157f8a1cac5cd84f9623b4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:30:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:30:25 -0400 Subject: [Git][ghc/ghc][wip/tsan/prep] 2 commits: rts: Introduce more principled fence operations Message-ID: <64bec34147088_17b24eb801065497a@gitlab.mail> Ben Gamari pushed to branch wip/tsan/prep at Glasgow Haskell Compiler / GHC Commits: b431aa81 by Ben Gamari at 2023-07-24T14:23:58-04:00 rts: Introduce more principled fence operations - - - - - 8a64b390 by Ben Gamari at 2023-07-24T14:23:59-04:00 rts: Introduce SET_INFO_RELAXED - - - - - 5 changed files: - rts/include/Cmm.h - rts/include/Rts.h - rts/include/Stg.h - rts/include/rts/storage/ClosureMacros.h - rts/include/stg/SMP.h Changes: ===================================== rts/include/Cmm.h ===================================== @@ -596,6 +596,7 @@ /* Getting/setting the info pointer of a closure */ #define SET_INFO(p,info) StgHeader_info(p) = info #define SET_INFO_RELEASE(p,info) %release StgHeader_info(p) = info +#define SET_INFO_RELAXED(p,info) %relaxed StgHeader_info(p) = info #define GET_INFO(p) StgHeader_info(p) #define GET_INFO_ACQUIRE(p) %acquire GET_INFO(p) @@ -687,10 +688,18 @@ #define RELEASE_FENCE prim %fence_release(); #define ACQUIRE_FENCE prim %fence_acquire(); +// TODO +#if 1 +#define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire64(x); } +#else +#define ACQUIRE_FENCE_ON(x) ACQUIRE_FENCE +#endif + #else #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ +#define ACQUIRE_FENCE_ON(x) /* nothing */ #endif /* THREADED_RTS */ /* ----------------------------------------------------------------------------- ===================================== rts/include/Rts.h ===================================== @@ -236,7 +236,6 @@ void _warnFail(const char *filename, unsigned int linenum); /* Parallel information */ #include "rts/OSThreads.h" -#include "rts/TSANUtils.h" #include "rts/SpinLock.h" #include "rts/Messages.h" ===================================== rts/include/Stg.h ===================================== @@ -393,6 +393,7 @@ external prototype return neither of these types to workaround #11395. #include "stg/MachRegsForHost.h" #include "stg/Regs.h" #include "stg/Ticky.h" +#include "rts/TSANUtils.h" #if IN_STG_CODE /* ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -47,6 +47,11 @@ EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info); EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info) { + c->header.info = info; +} + +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info); +EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info) { RELAXED_STORE(&c->header.info, info); } @@ -70,6 +75,7 @@ EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl (const StgInfoTable *i); EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl (const StgInfoTable *i); #if defined(TABLES_NEXT_TO_CODE) +NO_WARN(-Warray-bounds, EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;} EXTERN_INLINE StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;} @@ -79,6 +85,7 @@ EXTERN_INLINE StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return ( EXTERN_INLINE StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;} +) #else EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;} ===================================== rts/include/stg/SMP.h ===================================== @@ -490,10 +490,25 @@ busy_wait_nop(void) // These are typically necessary only in very specific cases (e.g. WSDeque) // where the ordered operations aren't expressive enough to capture the desired // ordering. +// +// Additionally, it is preferable to use the *_FENCE_ON() forms, which turn into +// memory accesses when compiling for ThreadSanitizer (as ThreadSanitizer is +// otherwise unable to reason about fences). See Note [ThreadSanitizer] in +// TSANUtils.h. + #define ACQUIRE_FENCE() __atomic_thread_fence(__ATOMIC_ACQUIRE) #define RELEASE_FENCE() __atomic_thread_fence(__ATOMIC_RELEASE) #define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) +#if defined(TSAN_ENABLED) +#define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);) +#define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);) +#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) +#define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) +#else +#define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) +#endif + /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ @@ -521,6 +536,8 @@ busy_wait_nop(void) #define ACQUIRE_FENCE() #define RELEASE_FENCE() #define SEQ_CST_FENCE() +#define ACQUIRE_FENCE_ON(x) +#define RELEASE_FENCE_ON(x) #if !IN_STG_CODE || IN_STGCRUN INLINE_HEADER StgWord View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af672b6669059a8df0e04cbd2b2959d0390830fb...8a64b390f2bd5da967e4935e9db399db387e8a8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af672b6669059a8df0e04cbd2b2959d0390830fb...8a64b390f2bd5da967e4935e9db399db387e8a8d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:33:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:33:42 -0400 Subject: [Git][ghc/ghc][wip/tsan/cmm-codegen] 5 commits: rts: Style fixes Message-ID: <64bec406bba6d_17b24e289f3ad06555dd@gitlab.mail> Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC Commits: a38fa0bf by Ben Gamari at 2023-07-24T14:33:01-04:00 rts: Style fixes - - - - - a7d012c9 by Ben Gamari at 2023-07-24T14:33:14-04:00 codeGen/tsan: Rework handling of spilling - - - - - f7decdf3 by Ben Gamari at 2023-07-24T14:33:14-04:00 hadrian: More debug information - - - - - d53eb92e by Ben Gamari at 2023-07-24T14:33:14-04:00 Improve TSAN documentation - - - - - 75437706 by Ben Gamari at 2023-07-24T14:33:15-04:00 hadrian: More selective TSAN instrumentation - - - - - 5 changed files: - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - hadrian/src/Flavour.hs - rts/Updates.h - rts/include/rts/TSANUtils.h Changes: ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -205,7 +205,7 @@ memory ordering guarantees. These are supported in Cmm syntax as follows: %relaxed W_[ptr] = ...; // an atomic store with relaxed ordering semantics %release W_[ptr] = ...; // an atomic store with release ordering semantics - x = W_(ptr); // a non-atomic load + x = W_[ptr]; // a non-atomic load x = %relaxed W_[ptr]; // an atomic load with relaxed ordering x = %acquire W_[ptr]; // an atomic load with acquire ordering // or equivalently... ===================================== compiler/GHC/Cmm/ThreadSanitizer.hs ===================================== @@ -6,7 +6,6 @@ module GHC.Cmm.ThreadSanitizer (annotateTSAN) where import GHC.Prelude -import GHC.StgToCmm.Utils (get_GlobalReg_addr) import GHC.Platform import GHC.Platform.Regs (activeStgRegs, callerSaves) import GHC.Cmm @@ -24,12 +23,12 @@ import GHC.Types.Unique.Supply import Data.Maybe (fromMaybe) data Env = Env { platform :: Platform - , uniques :: [Unique] + , uniques :: UniqSupply } annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph annotateTSAN platform graph = do - env <- Env platform <$> getUniquesM + env <- Env platform <$> getUniqueSupplyM return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph mapBlockList :: (forall e' x'. n e' x' -> Block n e' x') @@ -133,14 +132,15 @@ mkUnsafeCall env ftgt formals args = call `blockAppend` -- perform call restore -- restore global registers where - -- We are rather conservative here and just save/restore all GlobalRegs. - (save, restore) = saveRestoreCallerRegs (platform env) + (save, restore) = saveRestoreCallerRegs gregs_us (platform env) + + (arg_us, gregs_us) = splitUniqSupply (uniques env) -- We also must be careful not to mention caller-saved registers in -- arguments as Cmm-Lint checks this. To accomplish this we instead bind -- the arguments to local registers. arg_regs :: [CmmReg] - arg_regs = zipWith arg_reg (uniques env) args + arg_regs = zipWith arg_reg (uniqsFromSupply arg_us) args where arg_reg :: Unique -> CmmExpr -> CmmReg arg_reg u expr = CmmLocal $ LocalReg u (cmmExprType (platform env) expr) @@ -150,31 +150,34 @@ mkUnsafeCall env ftgt formals args = call = CmmUnsafeForeignCall ftgt formals (map CmmReg arg_regs) -saveRestoreCallerRegs :: Platform +-- | We save the contents of global registers in locals and allow the +-- register allocator to spill them to the stack around the call. +-- We cannot use the register table for this since we would interface +-- with {SAVE,RESTORE}_THREAD_STATE. +saveRestoreCallerRegs :: UniqSupply -> Platform -> (Block CmmNode O O, Block CmmNode O O) -saveRestoreCallerRegs platform = +saveRestoreCallerRegs us platform = (save, restore) where - regs = filter (callerSaves platform) (activeStgRegs platform) - - save = blockFromList (map saveReg regs) - - saveReg :: GlobalReg -> CmmNode O O - saveReg reg = - CmmStore (get_GlobalReg_addr platform reg) - (CmmReg (CmmGlobal (GlobalRegUse reg ty))) - NaturallyAligned - where ty = globalRegSpillType platform reg - - restore = blockFromList (map restoreReg regs) - - restoreReg :: GlobalReg -> CmmNode O O - restoreReg reg = - CmmAssign (CmmGlobal (GlobalRegUse reg ty)) - (CmmLoad (get_GlobalReg_addr platform reg) - ty - NaturallyAligned) - where ty = globalRegSpillType platform reg + regs_to_save :: [GlobalReg] + regs_to_save = filter (callerSaves platform) (activeStgRegs platform) + + nodes :: [(CmmNode O O, CmmNode O O)] + nodes = + zipWith mk_reg regs_to_save (uniqsFromSupply us) + where + mk_reg :: GlobalReg -> Unique -> (CmmNode O O, CmmNode O O) + mk_reg reg u = + let ty = globalRegSpillType platform reg + greg = CmmGlobal (GlobalRegUse reg ty) + lreg = CmmLocal (LocalReg u ty) + save = CmmAssign lreg (CmmReg greg) + restore = CmmAssign greg (CmmReg lreg) + in (save, restore) + + (save_nodes, restore_nodes) = unzip nodes + save = blockFromList save_nodes + restore = blockFromList restore_nodes -- | Mirrors __tsan_memory_order -- ===================================== hadrian/src/Flavour.hs ===================================== @@ -47,7 +47,8 @@ flavourTransformers = M.fromList , "ticky_ghc" =: enableTickyGhc , "split_sections" =: splitSections , "no_split_sections" =: noSplitSections - , "thread_sanitizer" =: enableThreadSanitizer + , "thread_sanitizer" =: enableThreadSanitizer False + , "thread_sanitizer_cmm" =: enableThreadSanitizer True , "llvm" =: viaLlvmBackend , "profiled_ghc" =: enableProfiledGhc , "no_dynamic_ghc" =: disableDynamicGhcPrograms @@ -152,7 +153,8 @@ werror = -- | Build C and Haskell objects with debugging information. enableDebugInfo :: Flavour -> Flavour enableDebugInfo = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? arg "-g3" + [ builder (Ghc CompileHs) ? pure ["-g3"] + , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"] , builder (Cc CompileC) ? arg "-g3" , builder (Cabal Setup) ? arg "--disable-library-stripping" , builder (Cabal Setup) ? arg "--disable-executable-stripping" @@ -218,14 +220,18 @@ noSplitSections f = f { ghcSplitSections = False } -- | Build GHC and libraries with ThreadSanitizer support. You likely want to -- configure with @--disable-large-address-space@ when using this. -enableThreadSanitizer :: Flavour -> Flavour -enableThreadSanitizer = addArgs $ notStage0 ? mconcat - [ builder (Ghc CompileHs) ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") - , builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" +enableThreadSanitizer :: Bool -> Flavour -> Flavour +enableThreadSanitizer instrumentCmm = addArgs $ notStage0 ? mconcat + [ instrumentCmm ? builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread" + , builder (Ghc LinkHs) ? (arg "-optc-fsanitize=thread" <> arg "-optl-fsanitize=thread") , builder Cc ? arg "-fsanitize=thread" , builder (Cabal Flags) ? arg "thread-sanitizer" , builder Testsuite ? arg "--config=have_thread_sanitizer=True" + , builder (Ghc CompileHs) ? mconcat + [ package pkg ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer") + | pkg <- [base, ghcPrim, array, rts] + ] ] -- | Use the LLVM backend in stages 1 and later. ===================================== rts/Updates.h ===================================== @@ -76,9 +76,9 @@ INLINE_HEADER void updateWithIndirection (Capability *cap, /* See Note [Heap memory barriers] in SMP.h */ bdescr *bd = Bdescr((StgPtr)p1); if (bd->gen_no != 0) { - IF_NONMOVING_WRITE_BARRIER_ENABLED { - updateRemembSetPushThunk(cap, (StgThunk*)p1); - } + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushThunk(cap, (StgThunk*)p1); + } recordMutableCap(p1, cap, bd->gen_no); TICK_UPD_OLD_IND(); } else { ===================================== rts/include/rts/TSANUtils.h ===================================== @@ -28,6 +28,40 @@ * In general it's best to add suppressions only as a last resort, when the * more precise annotation functions prove to be insufficient. * + * GHC can be configured with two extents of TSAN instrumentation: + * + * - instrumenting the C RTS (by passing `-optc-fsanitize=thread` + * when compiling the RTS) + * + * - instrumenting both the C RTS and Cmm memory accesses (by passing + * `-optc-fsanitize=thread -fcmm-thread-sanitizer` to all GHC invocations). + * + * These two modes can be realized in Hadrian using the `+thread_sanitizer` + * and `+thread_sanitizer_cmm` flavour transformers. + * + * Tips and tricks: + * + * - One should generally run TSAN instrumented programs with the environment + * variable + * + * TSAN_OPTIONS=suppressions=$ghc_root/rts/.tsan-suppressions + * + * to maximize signal-to-noise. + * + * - One can set a breakpoint on `__tsan_on_report` in a debugger to pause when + * a TSAN report is found. + * + * - TSAN-instrumented will by default exit with code 66 when a violation has + * been found. However, this can be disabled by setting + * `TSAN_OPTIONS=exitcode=0` + * + * - If TSAN is able to report useful stack traces it may help to set + * `TSAN_OPTIONS=history_size=3` or greater (up to 7). This increases the + * size of TSAN's per-thread memory access history buffer. + * + * - TSAN report messages can be redirected to a file using + * `TSAN_OPTIONS=log_path=...` + * * Users guide: https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97e297677ef8478d30157f8a1cac5cd84f9623b4...7543770667bc95d953665ecffbdeab9ac1f12940 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97e297677ef8478d30157f8a1cac5cd84f9623b4...7543770667bc95d953665ecffbdeab9ac1f12940 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:33:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:33:45 -0400 Subject: [Git][ghc/ghc][wip/tsan/fix-races] 28 commits: rts: Style fixes Message-ID: <64bec409ae2a3_17b24eb80b065570@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fix-races at Glasgow Haskell Compiler / GHC Commits: a38fa0bf by Ben Gamari at 2023-07-24T14:33:01-04:00 rts: Style fixes - - - - - a7d012c9 by Ben Gamari at 2023-07-24T14:33:14-04:00 codeGen/tsan: Rework handling of spilling - - - - - f7decdf3 by Ben Gamari at 2023-07-24T14:33:14-04:00 hadrian: More debug information - - - - - d53eb92e by Ben Gamari at 2023-07-24T14:33:14-04:00 Improve TSAN documentation - - - - - 75437706 by Ben Gamari at 2023-07-24T14:33:15-04:00 hadrian: More selective TSAN instrumentation - - - - - f02a8a0f by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - 0b347896 by Ben Gamari at 2023-07-24T14:33:32-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 7164a60c by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 70cfaa0a by Ben Gamari at 2023-07-24T14:33:32-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - 85afd351 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Fix data race in Interpreter's preemption check - - - - - 6c127548 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Fix data race in threadStatus# - - - - - 24fc3475 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Fix data race in CHECK_GC - - - - - 3791b8fc by Ben Gamari at 2023-07-24T14:33:32-04:00 base: use atomic write when updating timer manager - - - - - f623c923 by Ben Gamari at 2023-07-24T14:33:32-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - 30b9be29 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - d7f9ef7a by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Fix synchronization on thread blocking state - - - - - 270c7542 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Relaxed load MutVar info table - - - - - 4a778fe8 by Ben Gamari at 2023-07-24T14:33:32-04:00 Wordsmith TSAN Note - - - - - ac5d7458 by Ben Gamari at 2023-07-24T14:33:32-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 43534f63 by Ben Gamari at 2023-07-24T14:33:32-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - dd34c0be by Ben Gamari at 2023-07-24T14:33:32-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - d8ef8b00 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts/Interpreter: Fix data race - - - - - 58a6dd60 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts/Messages: Fix data race - - - - - 5cb1825c by Ben Gamari at 2023-07-24T14:33:32-04:00 rts/Prof: Fix data race - - - - - 1f7cb9ab by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Fix various data races - - - - - f8158fea by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Use fence rather than redundant load - - - - - 34422ee6 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts/RaiseAsync: Drop redundant release fence - - - - - b778e090 by Ben Gamari at 2023-07-24T14:33:32-04:00 rts: Fixes profiling timer races - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - libraries/base/GHC/Event/Thread.hs - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/Proftimer.c - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c - rts/StgMiscClosures.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baafa60e240b05a2a225ec0b730447db8837a1a4...b778e09017b1ce08b93a426fa194b2252e730d8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baafa60e240b05a2a225ec0b730447db8837a1a4...b778e09017b1ce08b93a426fa194b2252e730d8b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:33:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:33:48 -0400 Subject: [Git][ghc/ghc][wip/tsan/prep] rts: Style fixes Message-ID: <64bec40c7cd7d_17b24eb804c6561a8@gitlab.mail> Ben Gamari pushed to branch wip/tsan/prep at Glasgow Haskell Compiler / GHC Commits: a38fa0bf by Ben Gamari at 2023-07-24T14:33:01-04:00 rts: Style fixes - - - - - 1 changed file: - rts/Updates.h Changes: ===================================== rts/Updates.h ===================================== @@ -76,9 +76,9 @@ INLINE_HEADER void updateWithIndirection (Capability *cap, /* See Note [Heap memory barriers] in SMP.h */ bdescr *bd = Bdescr((StgPtr)p1); if (bd->gen_no != 0) { - IF_NONMOVING_WRITE_BARRIER_ENABLED { - updateRemembSetPushThunk(cap, (StgThunk*)p1); - } + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushThunk(cap, (StgThunk*)p1); + } recordMutableCap(p1, cap, bd->gen_no); TICK_UPD_OLD_IND(); } else { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a38fa0bf4b47628014ff747eacbb1e982b4fa6ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a38fa0bf4b47628014ff747eacbb1e982b4fa6ab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 18:39:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 14:39:43 -0400 Subject: [Git][ghc/ghc][wip/tsan/fix-races] 22 commits: rts: Fix data race in threadPaused Message-ID: <64bec56f2037_17b24e289f3ad06567e1@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fix-races at Glasgow Haskell Compiler / GHC Commits: 646d977d by Ben Gamari at 2023-07-24T14:39:27-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS and only needs relaxed ordering. - - - - - 14f4534f by Ben Gamari at 2023-07-24T14:39:36-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 3c48cd4e by Ben Gamari at 2023-07-24T14:39:36-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 1b0f7d64 by Ben Gamari at 2023-07-24T14:39:36-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - 23422ad4 by Ben Gamari at 2023-07-24T14:39:36-04:00 rts: Fix data race in Interpreter's preemption check - - - - - 7feebec0 by Ben Gamari at 2023-07-24T14:39:36-04:00 rts: Fix data race in threadStatus# - - - - - 5def4d18 by Ben Gamari at 2023-07-24T14:39:36-04:00 rts: Fix data race in CHECK_GC - - - - - 87252027 by Ben Gamari at 2023-07-24T14:39:36-04:00 base: use atomic write when updating timer manager - - - - - 54ff735f by Ben Gamari at 2023-07-24T14:39:36-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - 27341960 by Ben Gamari at 2023-07-24T14:39:36-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 2f964518 by Ben Gamari at 2023-07-24T14:39:36-04:00 rts: Fix synchronization on thread blocking state - - - - - 0181a367 by Ben Gamari at 2023-07-24T14:39:36-04:00 rts: Use relaxed ordering on dirty/clean info tables updates When changing the dirty/clean state of a mutable object we needn't have any particular ordering. - - - - - ee8b99b1 by Ben Gamari at 2023-07-24T14:39:36-04:00 Wordsmith TSAN Note - - - - - dd426c0e by Ben Gamari at 2023-07-24T14:39:36-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 17ad4ce4 by Ben Gamari at 2023-07-24T14:39:36-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 6d68c280 by Ben Gamari at 2023-07-24T14:39:36-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 22b33959 by Ben Gamari at 2023-07-24T14:39:37-04:00 rts/Interpreter: Fix data race - - - - - 2ae773fa by Ben Gamari at 2023-07-24T14:39:37-04:00 rts/Messages: Fix data race - - - - - f404338a by Ben Gamari at 2023-07-24T14:39:37-04:00 rts/Prof: Fix data race - - - - - 807d24f6 by Ben Gamari at 2023-07-24T14:39:37-04:00 rts: Use fence rather than redundant load Previously we would use an atomic load to ensure acquire ordering. However, we now have `ACQUIRE_FENCE_ON`, which allows us to express this more directly. - - - - - 42059a81 by Ben Gamari at 2023-07-24T14:39:37-04:00 rts: Fixes profiling timer races - - - - - 690a4e4f by Ben Gamari at 2023-07-24T14:39:37-04:00 rts/RaiseAsync: Drop redundant release fence - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - libraries/base/GHC/Event/Thread.hs - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/Proftimer.c - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c - rts/StgMiscClosures.cmm - rts/StgStartup.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b778e09017b1ce08b93a426fa194b2252e730d8b...690a4e4fac47008933e58836b6f3d28d772d7d68 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b778e09017b1ce08b93a426fa194b2252e730d8b...690a4e4fac47008933e58836b6f3d28d772d7d68 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 20:48:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 24 Jul 2023 16:48:17 -0400 Subject: [Git][ghc/ghc][master] 5 commits: ghc-toolchain: Initial commit Message-ID: <64bee391bb2ae_17b24eb804c6749dc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 30 changed files: - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - + hadrian/cfg/default.host.target.in - + hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73b5c7ce33929e1f7c9283ed7c2860aa40f6d0ec...38e795ffc1688d2a1c62dec1a5309c2ba7a8b2c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/73b5c7ce33929e1f7c9283ed7c2860aa40f6d0ec...38e795ffc1688d2a1c62dec1a5309c2ba7a8b2c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 20:48:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 24 Jul 2023 16:48:50 -0400 Subject: [Git][ghc/ghc][master] Kill off gen_bytearray_addr_access_ops.py Message-ID: <64bee3b2e89f1_17b24eb806068048@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 8 changed files: - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Generate.hs - + utils/genprimopcode/AccessOps.hs - utils/genprimopcode/Lexer.x - utils/genprimopcode/Parser.y - utils/genprimopcode/ParserM.hs - utils/genprimopcode/genprimopcode.cabal Changes: ===================================== compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py deleted ===================================== @@ -1,201 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -# This script generates the primop descriptions for many similar ByteArray# -# and Addr# access operations. Its output is #include-d into primops.txt.pp. - -from typing import Optional, NamedTuple -import textwrap -import argparse - -arg_parser = argparse.ArgumentParser() -arg_parser.add_argument('addr_or_bytearray', - choices = ["addr-access-ops", "bytearray-access-ops"], - ) -arg_parser.add_argument('output_file', - type=argparse.FileType('w'), - metavar='FILE', - ) -args = arg_parser.parse_args() -write = args.output_file.write - - - -write(''' --- Do not edit. --- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. --- (The build system should take care of this for you.) - -''') - -class ElementType(NamedTuple): - name: str - rep_ty: str - desc: str - width: Optional[int] - -MACH_WORD = None - -element_types = [ - # (name, representation type, human description, width) - # - # width in bytes. - # width == None denotes machine word - - ElementType("Char", "Char#", "8-bit character", 1), - ElementType("WideChar", "Char#", "32-bit character", 4), - ElementType("Int", "Int#", "word-sized integer", MACH_WORD), - ElementType("Word", "Word#", "word-sized unsigned integer", MACH_WORD), - ElementType("Addr", "Addr#", "machine address", MACH_WORD), - ElementType("Float", "Float#", "single-precision floating-point value", 4), - ElementType("Double", "Double#", "double-precision floating-point value", 8), - ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), -] - -for n in [8,16,32,64]: - element_types += [ - ElementType(f"Int{n}", f"Int{n}#", - f"{n}-bit signed integer", n // 8), - ElementType(f"Word{n}", f"Word{n}#", - f"{n}-bit unsigned integer", n // 8) - ] - -def pretty_offset(n: Optional[int]) -> str: - if n == MACH_WORD: - return 'machine words' - elif n == 1: - return 'bytes' - else: - return f'{n}-byte words' - -def get_align_warn(n: ElementType) -> str: - if n.width == 1: - return '' - return ''' - On some platforms, the access may fail - for an insufficiently aligned @Addr#@. - ''' - -def print_block(template: str, **kwargs) -> None: - write(textwrap.dedent(template.format(**kwargs)).lstrip()) - write('\n') - -def header(s: str): - write('\n') - print_block(''' - ------------------------------------ - -- {s} - ------------------------------------ - ''', s=s) - -if args.addr_or_bytearray == "bytearray-access-ops": - header("ByteArray# operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in {offset}.}} - with can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned index operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp - ByteArray# -> Int# -> {rep_ty} - {{Read a {desc}; offset in bytes.}} - with can_fail = True - ''', **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned read operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{Read a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - print_block(''' - primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in {offset}.}} - with has_side_effects = True - can_fail = True - ''', offset = offset, **t._asdict()) - - header('unaligned write operations') - for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' - primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp - MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s - {{Write a {desc}; offset in bytes.}} - with has_side_effects = True - can_fail = True - ''', **t._asdict()) - - -else: # addr_or_bytearray == "addr-access-ops": - header("Addr# access operations") - - header('aligned index operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned read operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) - {{ Read a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) - - header('aligned write operations') - for t in element_types: - offset = pretty_offset(t.width) - align_warn = get_align_warn(t) - print_block(''' - primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp - Addr# -> Int# -> {rep_ty} -> State# s -> State# s - {{ Write a {desc}; offset in {offset}. - {align_warn} - }} - with has_side_effects = True - can_fail = True - ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1956,7 +1956,11 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-access-ops.txt.pp" + +bytearray_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2259,7 +2263,11 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -#include "addr-access-ops.txt.pp" + +addr_access_ops +-- This generates a whole bunch of primops; +-- see utils/genprimopcode/AccessOps.hs + primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -38,17 +38,6 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" -accessOpsSource :: FilePath -accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" - -byteArrayAccessOpsTxt :: Stage -> FilePath -byteArrayAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" - -addrAccessOpsTxt :: Stage -> FilePath -addrAccessOpsTxt stage - = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" - isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -159,21 +148,8 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do - let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage - let addr_ops_txt = root -/- addrAccessOpsTxt stage - ba_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "bytearray-access-ops", file] - [] [] - addr_ops_txt %> \file -> do - need [accessOpsSource] - runBuilder Python - [accessOpsSource, "addr-access-ops", file] - [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource, ba_ops_txt, addr_ops_txt] - -- ba_ops_txt and addr_ops_txt get #include-d + need $ [primopsSource] build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== utils/genprimopcode/AccessOps.hs ===================================== @@ -0,0 +1,250 @@ +module AccessOps (byteArrayAccessOps, addrAccessOps) where + +import Syntax + +data ElementType = MkElementType + { elt_name :: String + , elt_rep_ty :: Ty + , elt_desc :: String + , elt_width :: Maybe Int + } + +machWord :: Maybe Int +machWord = Nothing + +strToTy :: String -> Ty +strToTy s = TyApp (TyCon s) [] + +elementTypes :: [ElementType] +elementTypes = + [ MkElementType "Char" (strToTy "Char#" ) "an 8-bit character" (Just 1) + , MkElementType "WideChar" (strToTy "Char#" ) "a 32-bit character" (Just 4) + , MkElementType "Int" (strToTy "Int#" ) "a word-sized integer" machWord + , MkElementType "Word" (strToTy "Word#" ) "a word-sized unsigned integer" machWord + , MkElementType "Addr" (strToTy "Addr#" ) "a machine address" machWord + , MkElementType "Float" (strToTy "Float#" ) "a single-precision floating-point value" (Just 4) + , MkElementType "Double" (strToTy "Double#") "a double-precision floating-point value" (Just 8) + , MkElementType "StablePtr" (TyApp (TyCon "StablePtr#") [TyVar "a"]) + "a 'StablePtr#' value" machWord + ] ++ do + n <- [8, 16, 32, 64] + let mkDesc suff = (if n == 8 then "an " else "a ") ++ shows n suff + [ MkElementType + { elt_name = "Int" ++ show n + , elt_rep_ty = strToTy $ "Int" ++ shows n "#" + , elt_desc = mkDesc "-bit signed integer" + , elt_width = Just (n `quot` 8) + }, + MkElementType + { elt_name = "Word" ++ show n + , elt_rep_ty = strToTy $ "Word" ++ shows n "#" + , elt_desc = mkDesc "-bit unsigned integer" + , elt_width = Just (n `quot` 8) + } + ] + +unalignedElementTypes :: [ElementType] +unalignedElementTypes + = filter (\e -> elt_name e `notElem` ["Int8", "Word8"]) elementTypes +--unalignedElementTypes = filter (\e -> elt_width e /= Just 1) elementTypes + +prettyOffset :: ElementType -> String +prettyOffset e = case elt_width e of + Nothing -> "machine words" + Just 1 -> "bytes" + Just n -> shows n "-byte words" + +getAlignWarn :: ElementType -> String +getAlignWarn e = case elt_width e of + Just 1 -> "" + _ -> "On some platforms, the access may fail\n" + ++ "for an insufficiently aligned @Addr#@." + +mutableByteArrayS :: Ty +mutableByteArrayS = TyApp (TyCon "MutableByteArray#") [TyVar "s"] + +stateS :: Ty +stateS = TyApp (TyCon "State#") [TyVar "s"] + +readResTy :: ElementType -> Ty +readResTy e = TyF stateS (TyUTup [stateS, elt_rep_ty e]) + +writeResTy :: ElementType -> Ty +writeResTy e = TyF (elt_rep_ty e) (TyF stateS stateS) + + + +mkIndexByteArrayOp :: ElementType -> Entry +mkIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "Array#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail"] + } + +mkUnalignedIndexByteArrayOp :: ElementType -> Entry +mkUnalignedIndexByteArrayOp e = PrimOpSpec + { cons = "IndexByteArrayOp_Word8As" ++ elt_name e + , name = "indexWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "ByteArray#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } + +mkReadByteArrayOp :: ElementType -> Entry +mkReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedReadByteArrayOp :: ElementType -> Entry +mkUnalignedReadByteArrayOp e = PrimOpSpec + { cons = "ReadByteArrayOp_Word8As" ++ elt_name e + , name = "readWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkWriteByteArrayOp :: ElementType -> Entry +mkWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "Array#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +mkUnalignedWriteByteArrayOp :: ElementType -> Entry +mkUnalignedWriteByteArrayOp e = PrimOpSpec + { cons = "WriteByteArrayOp_Word8As" ++ elt_name e + , name = "writeWord8ArrayAs" ++ elt_name e ++ "#" + , ty = TyF mutableByteArrayS + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + + +byteArrayAccessOps :: [Entry] +byteArrayAccessOps + = map mkIndexByteArrayOp elementTypes + ++ map mkUnalignedIndexByteArrayOp unalignedElementTypes + ++ map mkReadByteArrayOp elementTypes + ++ map mkUnalignedReadByteArrayOp unalignedElementTypes + ++ map mkWriteByteArrayOp elementTypes + ++ map mkUnalignedWriteByteArrayOp unalignedElementTypes + + + +mkIndexOffAddrOp :: ElementType -> Entry +mkIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_" ++ elt_name e + , name = "index" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail"] + } + +{- +mkUnalignedIndexOffAddrOp :: ElementType -> Entry +mkUnalignedIndexOffAddrOp e = PrimOpSpec + { cons = "IndexOffAddrOp_Word8As" ++ elt_name e + , name = "indexWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + (elt_rep_ty e) + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail"] + } +-} + +mkReadOffAddrOp :: ElementType -> Entry +mkReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_" ++ elt_name e + , name = "read" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedReadOffAddrOp :: ElementType -> Entry +mkUnalignedReadOffAddrOp e = PrimOpSpec + { cons = "ReadOffAddrOp_Word8As" ++ elt_name e + , name = "readWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ readResTy e + , cat = GenPrimOp + , desc = "Read " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + +mkWriteOffAddrOp :: ElementType -> Entry +mkWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_" ++ elt_name e + , name = "write" ++ elt_name e ++ "OffAddr#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" + ++ getAlignWarn e + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } + +{- +mkUnalignedWriteOffAddrOp :: ElementType -> Entry +mkUnalignedWriteOffAddrOp e = PrimOpSpec + { cons = "WriteOffAddrOp_Word8As" ++ elt_name e + , name = "writeWord8OffAddrAs" ++ elt_name e ++ "#" + , ty = TyF (strToTy "Addr#") + $ TyF (strToTy "Int#") + $ writeResTy e + , cat = GenPrimOp + , desc = "Write " ++ elt_desc e ++ "; offset in bytes." + , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + } +-} + + +addrAccessOps :: [Entry] +addrAccessOps + = map mkIndexOffAddrOp elementTypes +-- ++ map mkUnalignedIndexOffAddrOp unalignedElementTypes + ++ map mkReadOffAddrOp elementTypes +-- ++ map mkUnalignedReadOffAddrOp unalignedElementTypes + ++ map mkWriteOffAddrOp elementTypes +-- ++ map mkUnalignedWriteOffAddrOp unalignedElementTypes ===================================== utils/genprimopcode/Lexer.x ===================================== @@ -52,6 +52,8 @@ words :- <0> "infixr" { mkT TInfixR } <0> "Nothing" { mkT TNothing } <0> "vector" { mkT TVector } + <0> "bytearray_access_ops" { mkT TByteArrayAccessOps } + <0> "addr_access_ops" { mkT TAddrAccessOps } <0> "thats_all_folks" { mkT TThatsAllFolks } <0> "SCALAR" { mkT TSCALAR } <0> "VECTOR" { mkT TVECTOR } ===================================== utils/genprimopcode/Parser.y ===================================== @@ -5,6 +5,8 @@ import Lexer (lex_tok) import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos, happyError) import Syntax + +import AccessOps } %name parsex @@ -47,6 +49,8 @@ import Syntax SCALAR { TSCALAR } VECTOR { TVECTOR } VECTUPLE { TVECTUPLE } + bytearray_access_ops { TByteArrayAccessOps } + addr_access_ops { TAddrAccessOps } thats_all_folks { TThatsAllFolks } lowerName { TLowerName $$ } upperName { TUpperName $$ } @@ -83,8 +87,13 @@ pInfix : infix integer { Just $ Fixity NoSourceText $2 InfixN } pEntries :: { [Entry] } pEntries : pEntry pEntries { $1 : $2 } + | pAccessOps pEntries { $1 ++ $2 } | {- empty -} { [] } +pAccessOps :: { [Entry] } +pAccessOps : bytearray_access_ops { byteArrayAccessOps } + | addr_access_ops { addrAccessOps } + pEntry :: { Entry } pEntry : pPrimOpSpec { $1 } | pPrimTypeSpec { $1 } @@ -148,7 +157,7 @@ pVectors : pVector ',' pVectors { [$1] ++ $3 } pVector :: { (String, String, Int) } pVector : '<' upperName ',' upperName ',' integer '>' { ($2, $4, $6) } - + pType :: { Ty } pType : paT '->' pType { TyF $1 $3 } | paT '=>' pType { TyC $1 $3 } ===================================== utils/genprimopcode/ParserM.hs ===================================== @@ -98,6 +98,8 @@ data Token = TEOF | TFalse | TCompare | TGenPrimOp + | TByteArrayAccessOps + | TAddrAccessOps | TThatsAllFolks | TLowerName String | TUpperName String ===================================== utils/genprimopcode/genprimopcode.cabal ===================================== @@ -28,6 +28,7 @@ Executable genprimopcode Parser ParserM Syntax + AccessOps Build-Depends: base >= 4 && < 5, array if flag(build-tool-depends) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32cae784b7bfcb6562a9ad041e7608dbcf0f5d72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32cae784b7bfcb6562a9ad041e7608dbcf0f5d72 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 20:49:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 24 Jul 2023 16:49:33 -0400 Subject: [Git][ghc/ghc][master] compiler: Remove unused `containers.h` include Message-ID: <64bee3ddb8ad_17b24eb80606854d7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 9 changed files: - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs Changes: ===================================== compiler/GHC/Data/Word64Map.hs ===================================== @@ -8,7 +8,6 @@ {-# LANGUAGE MonoLocalBinds #-} #endif -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -14,7 +14,6 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -3,7 +3,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Data/Word64Map/Strict.hs ===================================== @@ -4,8 +4,6 @@ {-# LANGUAGE Trustworthy #-} #endif -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Map.Strict ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -4,8 +4,6 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Map.Strict.Internal ===================================== compiler/GHC/Data/Word64Set.hs ===================================== @@ -3,8 +3,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Set ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -12,8 +12,6 @@ {-# OPTIONS_HADDOCK not-home #-} -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Set.Internal ===================================== compiler/GHC/Utils/Containers/Internal/BitUtil.hs ===================================== @@ -6,8 +6,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Utils.Containers.Internal.BitUtil ===================================== compiler/GHC/Utils/Containers/Internal/StrictPair.hs ===================================== @@ -3,8 +3,6 @@ {-# LANGUAGE Safe #-} #endif -#include "containers.h" - -- | A strict pair module GHC.Utils.Containers.Internal.StrictPair (StrictPair(..), toPair) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02e6a6ceac761d62ed30817b9525d952bca599ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02e6a6ceac761d62ed30817b9525d952bca599ac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 23:25:38 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 24 Jul 2023 19:25:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23703 Message-ID: <64bf08729c611_17b24eb8074696446@gitlab.mail> Finley McIlwaine pushed new branch wip/t23703 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23703 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 23:26:56 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 24 Jul 2023 19:26:56 -0400 Subject: [Git][ghc/ghc][wip/t23703] Allow constructor names for -fdistinct-constructor-tables Message-ID: <64bf08c011be4_17b24eb804c6966cd@gitlab.mail> Finley McIlwaine pushed to branch wip/t23703 at Glasgow Haskell Compiler / GHC Commits: be2375db by Finley McIlwaine at 2023-07-24T17:26:30-06:00 Allow constructor names for -fdistinct-constructor-tables Also introduce `-fno-distinct-constructor-tables`. A distinct constructor table configuration is built from the combination of flags given, in order. For example, to create distinct constructor tables for all constructors except for a specific few named `C1`,..., `CN`, pass `-fdistinct-contructor-tables` followed by `fno-distinct-constructor-tables=C1,...,CN`. To only generate distinct constuctor tables for a few specific constructors and no others, just pass `-fdistinct-constructor-tables=C1,...,CN`. The various configuations of these flags is included in the dynflags fingerprints, which should result in the expected recompilation logic. Fixes #23703 - - - - - 8 changed files: - compiler/GHC/Driver/Config/Stg/Debug.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Recomp/Flags.hs - compiler/GHC/Stg/Debug.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/debug-info.rst Changes: ===================================== compiler/GHC/Driver/Config/Stg/Debug.hs ===================================== @@ -10,5 +10,5 @@ import GHC.Driver.DynFlags initStgDebugOpts :: DynFlags -> StgDebugOpts initStgDebugOpts dflags = StgDebugOpts { stgDebug_infoTableMap = gopt Opt_InfoTableMap dflags - , stgDebug_distinctConstructorTables = gopt Opt_DistinctConstructorTables dflags + , stgDebug_distinctConstructorTables = distinctConstructorTables dflags } ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -99,6 +99,7 @@ import GHC.Types.SrcLoc import GHC.Unit.Module import GHC.Unit.Module.Warnings import GHC.Utils.CliOption +import GHC.Stg.Debug (StgDebugDctConfig(..)) import GHC.SysTools.Terminal ( stderrSupportsAnsiColors ) import GHC.UniqueSubdir (uniqueSubdir) import GHC.Utils.Outputable @@ -116,6 +117,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) +import qualified Data.Set as Set import Data.Word import System.IO import System.IO.Error (catchIOError) @@ -124,8 +126,6 @@ import System.FilePath (normalise, ()) import System.Directory import GHC.Foreign (withCString, peekCString) -import qualified Data.Set as Set - import qualified GHC.LanguageExtensions as LangExt -- ----------------------------------------------------------------------------- @@ -445,7 +445,11 @@ data DynFlags = DynFlags { -- 'Int' because it can be used to test uniques in decreasing order. -- | Temporary: CFG Edge weights for fast iterations - cfgWeights :: Weights + cfgWeights :: Weights, + + -- | Configuration specifying which constructor names we should create + -- distinct info tables for + distinctConstructorTables :: StgDebugDctConfig } class HasDynFlags m where @@ -690,7 +694,9 @@ defaultDynFlags mySettings = reverseErrors = False, maxErrors = Nothing, - cfgWeights = defaultWeights + cfgWeights = defaultWeights, + + distinctConstructorTables = None } type FatalMessager = String -> IO () ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -221,7 +221,6 @@ data GeneralFlag | Opt_FastLlvm -- hidden flag | Opt_NoTypeableBinds - | Opt_DistinctConstructorTables | Opt_InfoTableMap | Opt_WarnIsError -- -Werror; makes warnings fatal @@ -575,7 +574,6 @@ codeGenFlags = EnumSet.fromList , Opt_DoTagInferenceChecks -- Flags that affect debugging information - , Opt_DistinctConstructorTables , Opt_InfoTableMap , Opt_OrigThunkInfo ] ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -260,6 +260,7 @@ import GHC.Utils.Outputable import GHC.Settings import GHC.CmmToAsm.CFG.Weight import GHC.Core.Opt.CallerCC +import GHC.Stg.Debug import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) @@ -1780,7 +1781,9 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "fprof-callers" (HasArg setCallerCcFilters) , make_ord_flag defGhcFlag "fdistinct-constructor-tables" - (NoArg (setGeneralFlag Opt_DistinctConstructorTables)) + (OptPrefix setDistinctCostructorTables) + , make_ord_flag defGhcFlag "fno-distinct-constructor-tables" + (OptPrefix unSetDistinctCostructorTables) , make_ord_flag defGhcFlag "finfo-table-map" (NoArg (setGeneralFlag Opt_InfoTableMap)) ------ Compiler flags ----------------------------------------------- @@ -3292,6 +3295,22 @@ setCallerCcFilters arg = Right filt -> upd $ \d -> d { callerCcFilters = filt : callerCcFilters d } Left err -> addErr err +setDistinctCostructorTables :: String -> DynP () +setDistinctCostructorTables arg = do + let cs = parseDistinctConstructorTablesArg arg + upd $ \d -> + d { distinctConstructorTables = + (distinctConstructorTables d) `dctConfigPlus` cs + } + +unSetDistinctCostructorTables :: String -> DynP () +unSetDistinctCostructorTables arg = do + let cs = parseDistinctConstructorTablesArg arg + upd $ \d -> + d { distinctConstructorTables = + (distinctConstructorTables d) `dctConfigMinus` cs + } + setMainIs :: String -> DynP () setMainIs arg | x:_ <- main_fn, isLower x -- The arg looked like "Foo.Bar.baz" ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -68,7 +68,7 @@ fingerprintDynFlags hsc_env this_mod nameio = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] -- Other flags which affect code generation - codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags) + codegen = (map (`gopt` dflags) (EnumSet.toList codeGenFlags), distinctConstructorTables) flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters)) ===================================== compiler/GHC/Stg/Debug.hs ===================================== @@ -1,10 +1,15 @@ -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} -- This module contains functions which implement -- the -finfo-table-map and -fdistinct-constructor-tables flags module GHC.Stg.Debug ( StgDebugOpts(..) + , StgDebugDctConfig(..) + , dctConfigPlus + , dctConfigMinus , collectDebugInformation + , parseDistinctConstructorTablesArg ) where import GHC.Prelude @@ -16,12 +21,16 @@ import GHC.Types.Tickish import GHC.Core.DataCon import GHC.Types.IPE import GHC.Unit.Module -import GHC.Types.Name ( getName, getOccName, occNameFS, nameSrcSpan) +import GHC.Types.Name ( getName, getOccName, occNameFS, nameSrcSpan, occName, occNameString) import GHC.Data.FastString import Control.Monad (when) import Control.Monad.Trans.Reader +import Data.Set (Set) +import qualified Data.Set as Set import GHC.Utils.Monad.State.Strict +import GHC.Utils.Binary (Binary) +import qualified GHC.Utils.Binary as B import Control.Monad.Trans.Class import GHC.Types.Unique.Map import GHC.Types.SrcLoc @@ -33,9 +42,93 @@ data SpanWithLabel = SpanWithLabel RealSrcSpan LexicalFastString data StgDebugOpts = StgDebugOpts { stgDebug_infoTableMap :: !Bool - , stgDebug_distinctConstructorTables :: !Bool + , stgDebug_distinctConstructorTables :: !StgDebugDctConfig } +-- | Configuration describing which constructors should be given distinct info +-- tables for each usage. +data StgDebugDctConfig = + -- | Create distinct constructor tables for each usage of any data + -- constructor. + -- + -- This is the behavior if just @-fdistinct-constructor-tables@ is supplied. + All + + -- | Create distinct constructor tables for each usage of only these data + -- constructors. + -- + -- This is the behavior if @-fdistinct-constructor-tables=C1,...,CN@ is + -- supplied. + | Only !(Set String) + + -- | Create distinct constructor tables for each usage of any data + -- constructor except these ones. + -- + -- This is the behavior if @-fdistinct-constructor-tables@ and + -- @-fno-distinct-constructor-tables=C1,...,CN@ is given. + | AllExcept !(Set String) + + -- | Do not create distinct constructor tables for any data constructor. + -- + -- This is the behavior if no @-fdistinct-constructor-tables@ is given (or + -- @-fno-distinct-constructor-tables@ is given). + | None + +-- | Necessary for 'StgDebugDctConfig' to be included in the dynflags +-- fingerprint +instance Binary StgDebugDctConfig where + put_ bh All = B.putByte bh 0 + put_ bh (Only cs) = do + B.putByte bh 1 + B.put_ bh cs + put_ bh (AllExcept cs) = do + B.putByte bh 2 + B.put_ bh cs + put_ bh None = B.putByte bh 3 + + get bh = do + h <- B.getByte bh + case h of + 0 -> pure All + 1 -> Only <$> B.get bh + 2 -> AllExcept <$> B.get bh + _ -> pure None + +-- | Given a distinct constructor tables configuration and a set of constructor +-- names that we want to generate distinct info tables for, create a new +-- configuration which includes those constructors. +-- +-- If the given set is empty, that means the user has entered +-- @-fdistinct-constructor-tables@ with no constructor names specified, and +-- therefore we consider that an 'All' configuration. +dctConfigPlus :: StgDebugDctConfig -> Set String -> StgDebugDctConfig +dctConfigPlus cfg cs + | Set.null cs = All + | otherwise = + case (cfg, cs) of + (All , _ ) -> All + ((Only cs1), cs2) -> Only $ Set.union cs1 cs2 + ((AllExcept cs1), cs2) -> AllExcept $ Set.difference cs1 cs2 + (None , cs ) -> Only cs + +-- | Given a distinct constructor tables configuration and a set of constructor +-- names that we /do not/ want to generate distinct info tables for, create a +-- new configuration which excludes those constructors. +-- +-- If the given set is empty, that means the user has entered +-- @-fno-distinct-constructor-tables@ with no constructor names specified, and +-- therefore we consider that a 'None' configuration. +dctConfigMinus :: StgDebugDctConfig -> Set String -> StgDebugDctConfig +dctConfigMinus cfg cs + | Set.null cs = None + | otherwise = + case (cfg, cs) of + (All , cs ) -> AllExcept cs + ((Only cs1), cs2) -> Only $ Set.difference cs1 cs2 + ((AllExcept cs1), cs2) -> AllExcept $ Set.union cs1 cs2 + (None , _ ) -> None + + data R = R { rOpts :: StgDebugOpts, rModLocation :: ModLocation, rSpan :: Maybe SpanWithLabel } type M a = ReaderT R (State InfoTableProvMap) a @@ -160,10 +253,11 @@ numberDataCon dc _ | isUnboxedTupleDataCon dc = return NoNumber numberDataCon dc _ | isUnboxedSumDataCon dc = return NoNumber numberDataCon dc ts = do opts <- asks rOpts - if stgDebug_distinctConstructorTables opts then do - -- -fdistinct-constructor-tables is enabled. Add an entry to the data - -- constructor map for this occurence of the data constructor with a unique - -- number and a src span + if shouldMakeDistinctTable opts dc then do + -- -fdistinct-constructor-tables is enabled and we do want to make distinct + -- tables for this constructor. Add an entry to the data constructor map for + -- this occurence of the data constructor with a unique number and a src + -- span env <- lift get mcc <- asks rSpan let @@ -188,7 +282,8 @@ numberDataCon dc ts = do Nothing -> NoNumber Just res -> Numbered (fst (NE.head res)) else do - -- -fdistinct-constructor-tables is not enabled + -- -fdistinct-constructor-tables is not enabled, or we do not want to make + -- distinct tables for this specific constructor return NoNumber selectTick :: [StgTickish] -> Maybe (RealSrcSpan, LexicalFastString) @@ -198,6 +293,37 @@ selectTick = foldl' go Nothing go _ (SourceNote rss d) = Just (rss, d) go acc _ = acc +-- | Parse a string of comma-separated constructor names into a 'Set' of +-- 'String's with one entry per constructor. +parseDistinctConstructorTablesArg :: String -> Set String +parseDistinctConstructorTablesArg = + -- Ensure we insert the last constructor name built by the fold, if not + -- empty + uncurry insertNonEmpty + . foldr go ("", Set.empty) + where + go :: Char -> (String, Set String) -> (String, Set String) + go ',' (cur, acc) = ("", Set.insert cur acc) + go c (cur, acc) = (c : cur, acc) + + insertNonEmpty :: String -> Set String -> Set String + insertNonEmpty "" = id + insertNonEmpty cs = Set.insert cs + +-- | Descide whether a distinct info table should be made for a usage of a data +-- constructor. We only want to do this if -fdistinct-constructor-tables was +-- given and this constructor name was given, or no constructor names were +-- given. +shouldMakeDistinctTable :: StgDebugOpts -> DataCon -> Bool +shouldMakeDistinctTable StgDebugOpts{..} dc = + case stgDebug_distinctConstructorTables of + All -> True + Only these -> Set.member dcStr these + AllExcept these -> Set.notMember dcStr these + None -> False + where + dcStr = occNameString . occName $ dataConName dc + {- Note [Mapping Info Tables to Source Positions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== docs/users_guide/9.10.1-notes.rst ===================================== @@ -9,6 +9,18 @@ Language Compiler ~~~~~~~~ +- The :ghc-flag:`-fdistinct-constructor-tables + <-fdistinct-constructor-tables=⟨cs⟩>` flag may now be provided with a list of + constructor names for which distinct info tables should be generated. This + avoids the default behavior of generating a distinct info table for *every* + usage of *every* constructor, which often results in more information than is + desired and significantly increases the size of executables. + +- The :ghc-flag:`-fno-distinct-constructor-tables + <-fno-distinct-constructor-tables=⟨cs⟩>` flag is introduced, which allows + users to refine the set of constructors for which distinct info tables should + be generated. + GHCi ~~~~ ===================================== docs/users_guide/debug-info.rst ===================================== @@ -368,7 +368,8 @@ to a source location. This lookup table is generated by using the ``-finfo-table an info table to an approximate source position of where that info table statically originated from. If you also want more precise information about constructor info tables then you - should also use :ghc-flag:`-fdistinct-constructor-tables`. + should also use :ghc-flag:`-fdistinct-constructor-tables + <-fdistinct-constructor-tables=⟨cs⟩>`. The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite a lot, depending on how big your project is. For compiling a project the @@ -391,7 +392,7 @@ to a source location. This lookup table is generated by using the ``-finfo-table In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map` enabled build results was reduced by over 20% when compression was enabled. -.. ghc-flag:: -fdistinct-constructor-tables +.. ghc-flag:: -fdistinct-constructor-tables=⟨cs⟩ :shortdesc: Generate a fresh info table for each usage of a data constructor. :type: dynamic @@ -405,6 +406,41 @@ to a source location. This lookup table is generated by using the ``-finfo-table each info table will correspond to the usage of a data constructor rather than the data constructor itself. + :since: 9.10 + + The entries in the info table map resulting from this flag may significantly + increase the size of executables. However, generating distinct info tables + for *every* usage of *every* data constructor often results in more + information than necessary. Instead, we would like to generate these + distinct tables for some specific constructors. To do this, the names of the + constructors we are interested in may be supplied to this flag in a + comma-separated list. If no constructor names are supplied (i.e. just + ``-fdistinct-constructor-tables`` is given) then fresh info tables will be + generated for every usage of every constructor. + + For example, to only generate distinct info tables for the ``Just`` and + ``Right`` constructors, use ``-fdistinct-constructor-tables=Just,Right``. + +.. ghc-flag:: -fno-distinct-constructor-tables=⟨cs⟩ + :shortdesc: Avoid generating a fresh info table for each usage of a data + constructor. + :type: dynamic + :category: debugging + + :since: 9.10 + + Use this flag to refine the set of data constructors for which distinct info + tables are generated (as specified by + :ghc-flag:`-fdistinct-constructor-tables + <-fdistinct-constructor-tables=⟨cs⟩>`). + If no constructor names are given + (i.e. just ``-fno-distinct-constructor-tables`` is given) then no distinct + info tables will be generated for any usages of any data constructors. + + For example, to generate distinct constructor tables for all data + constructors except those named ``MyConstr``, pass both + ``-fdistinct-constructor-tables`` and + ``-fno-distinct-constructor-tables=MyConstr``. Querying the Info Table Map View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be2375db58f739b13b43859a5ee6ff14c1c00bf5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be2375db58f739b13b43859a5ee6ff14c1c00bf5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 24 23:34:44 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 24 Jul 2023 19:34:44 -0400 Subject: [Git][ghc/ghc][wip/expand-do] debugging error ctxts Message-ID: <64bf0a9413235_17b24e624d8ee4700233@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: bc7db422 by Apoorv Ingle at 2023-07-24T18:34:24-05:00 debugging error ctxts - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Utils/Monad.hs - testsuite/tests/typecheck/should_fail/DoExpansion2.hs - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_fail/DoExpansion3.stderr Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -492,7 +492,7 @@ data XXExprGhcTc {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcTc)) | ExpansionStmt -- See Note [Rebindable syntax and HsExpansion] below - {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (HsExpr GhcTc)) + {-# UNPACK #-} !(HsExpansion (ExprStmt GhcRn) (HsExpr GhcTc)) | ConLikeTc -- Result of typechecking a data-con -- See Note [Typechecking data constructors] in ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -369,14 +369,14 @@ tcApp rn_expr exp_res_ty setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VACall stmt") stmt thing_inside | insideExpansion fun_ctxt - , VAExpansionStmt stmt@(L loc _) <- fun_ctxt + , VAExpansionStmt stmt loc <- fun_ctxt = do traceTc "tcApp" (vcat [text "VAExpansionStmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) - setSrcSpanA loc $ addStmtCtxt (text "tcApp VAExpansionStmt") stmt - thing_inside - | XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun - = do traceTc "tcApp" (vcat [text "RnFun stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) - setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VAExpansion stmt") stmt + setSrcSpan loc $ addStmtCtxt (text "tcApp VAExpansionStmt") stmt thing_inside + -- | XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun + -- = do traceTc "tcApp" (vcat [text "RnFun stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) + -- setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VAExpansion stmt") stmt + -- thing_inside | insideExpansion fun_ctxt = do traceTc "tcApp" (vcat [text "insideExpansion", ppr rn_fun, ppr fun_ctxt]) addHeadCtxt fun_ctxt thing_inside @@ -567,10 +567,10 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args , text "do_ql" <+> ppr do_ql ]) ; go emptyVarSet [] [] fun_sigma rn_args } where - fun_orig = exprCtOrigin (case fun_ctxt of - VAExpansion e _ -> e - VACall e _ _ -> e - VAExpansionStmt stmt -> HsDo noExtField (DoExpr Nothing) (L noSrcSpanA [stmt])) + fun_orig = case fun_ctxt of + VAExpansionStmt{} -> DoOrigin + VAExpansion e _ -> exprCtOrigin e + VACall e _ _ -> exprCtOrigin e -- These are the type variables which must be instantiated to concrete -- types. See Note [Representation-polymorphic Ids with no binding] @@ -786,7 +786,7 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside -- <+> ppr (is_bind_fun (appCtxtExpr ctxt)) ]) ; case ctxt of - VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ + VACall (XExpr (ExpandedStmt (HsExpanded (L loc stmt) _))) _ _ -> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .." setSrcSpanA loc $ addStmtCtxt (text "addArgCtxt 2c") stmt $ @@ -796,27 +796,26 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside setSrcSpanA arg_loc $ addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside - VAExpansionStmt stmt@(L loc (BodyStmt{})) + VAExpansionStmt stmt@(BodyStmt{}) loc -> do traceTc "addArgCtxt 2e body" empty - setSrcSpanA loc $ + setSrcSpan loc $ addStmtCtxt ((text "addArgCtxt 2e")) stmt $ thing_inside - VAExpansionStmt stmt@(L loc (LastStmt {})) + VAExpansionStmt stmt@(LastStmt {}) loc -> do traceTc "addArgCtxt 2e last" empty - setSrcSpanA loc $ - -- addExprCtxt ((text "addArgCtxt body 2e")) body $ + setSrcSpan loc $ addStmtCtxt ((text "addArgCtxt last 2e")) stmt $ - -- setSrcSpanA arg_loc $ - -- addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside - VAExpansionStmt stmt@(L _ (BindStmt _ _ (L body_loc _))) + VAExpansionStmt stmt@(BindStmt {}) loc -> do traceTc "addArgCtxt 2e bind" empty - setSrcSpanA body_loc $ - -- addExprCtxt ((text "addArgCtxt body 2e")) body $ - addStmtCtxt ((text "addArgCtxt body 2e")) stmt $ + setSrcSpan loc $ + -- (if in_generated_code && in_src_ctxt + -- then + addStmtCtxt ((text "addArgCtxt bind 2e")) stmt $ + -- else id) $ thing_inside - VAExpansionStmt (L _ (LetStmt {})) -- TODO: Do nothing for let statements for now? + VAExpansionStmt (LetStmt {}) _ -> do traceTc "addArgCtxt 2e let" empty thing_inside _ -> do traceTc "addArgCtxt 3" empty ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -217,19 +217,17 @@ tcExpr e@(XExpr (ExpandedExpr {})) res_ty } tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty - | XExpr (ExpandedStmt (HsExpanded stmt expanded_expr)) <- e - , L l (LastStmt{}) <- stmt + | XExpr (ExpandedStmt (HsExpanded stmt _)) <- e + , L _ (LastStmt{}) <- stmt = do traceTc "tcExpr" (text "PopErrCtxt last stmt") popErrCtxt $ - setSrcSpanA l $ - addStmtCtxt (text "tcExpr last stmt") stmt $ - tcExpr expanded_expr res_ty + setSrcSpanA loc $ + tcExpr e res_ty | XExpr (ExpandedStmt (HsExpanded stmt _)) <- e , L _ (LetStmt{}) <- stmt = do traceTc "tcExpr" (text "PopErrCtxt let stmt") popErrCtxt $ setSrcSpanA loc $ - -- addStmtCtxt (text "tcExpr let stmt") stmt $ tcExpr e res_ty -- It is important that we call tcExpr and not tcApp here as -- `e` is just the last statement's body expression @@ -254,11 +252,9 @@ tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty , text "loc" <+> ppr loc ]) ; (binds', e') <- setSrcSpanA loc $ - addStmtCtxt (text "tcExpr let") stmt $ + addStmtCtxt (text "tcExpr let") s $ tcLocalBinds binds $ - do { -- traceTc "tcExpr let popErrCtxt" empty - -- ; popErrCtxt $ - tcMonoExprNC e res_ty } + tcMonoExprNC e res_ty ; return $ HsLet x tkLet binds' tkIn e' } | BindStmt{} <- s @@ -271,6 +267,16 @@ tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty -- addStmtCtxt (text "tcExpr bind") stmt $ tcApp e res_ty } + | LastStmt{} <- s + = do { traceTc "tcDoStmts last" (vcat [ text "stmt:" <+> ppr stmt + , text "expr:" <+> ppr expd_expr + , text "res_ty:" <+> ppr res_ty + , text "loc" <+> ppr loc + ]) + ; setSrcSpanA loc $ + addStmtCtxt (text "tcExpr last") s $ + tcExpr expd_expr res_ty + } | otherwise = do { traceTc "tcDoStmts other" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr expd_expr @@ -278,7 +284,7 @@ tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty , text "loc" <+> ppr loc ]) ; setSrcSpanA loc $ - addStmtCtxt (text "tcExpr other") stmt $ + addStmtCtxt (text "tcExpr other") s $ tcExpr expd_expr res_ty } @@ -339,12 +345,12 @@ tcExpr (HsLam _ match) res_ty = do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty ; return (mkHsWrap wrap (HsLam noExtField match')) } where - match_ctxt = MC { mc_what = case mg_ext match of -- refactor this for a better place. - Generated DoExpansion _ -> StmtCtxt (HsDoStmt (DoExpr Nothing)) - -- Either this lambda expr was generated by expanding a do block - _ -> LambdaExpr - -- Or it was a true lambda - , mc_body = tcBody } + match_ctxt = case mg_ext match of + Generated DoExpansion _ -> MC { mc_what = StmtCtxt (HsDoStmt (DoExpr Nothing)) + , mc_body = tcBodyNC + } + _ -> MC { mc_what = LambdaExpr + , mc_body = tcBody } herald = ExpectedFunTyLam match tcExpr e@(HsLamCase x lc_variant matches) res_ty ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -188,7 +188,7 @@ data HsExprArg (p :: TcPass) data EWrap = EPar AppCtxt | EExpand (HsExpr GhcRn) - | EExpandStmt (ExprLStmt GhcRn) + | EExpandStmt (ExprStmt GhcRn) | EHsWrap HsWrapper data EValArg (p :: TcPass) where -- See Note [EValArg] @@ -209,7 +209,8 @@ data AppCtxt SrcSpan -- The SrcSpan of the expression -- noSrcSpan if outermost; see Note [AppCtxt] | VAExpansionStmt - (ExprLStmt GhcRn) -- Inside an expansion of this do stmt + (ExprStmt GhcRn) -- Inside an expansion of this do stmt + SrcSpan -- location of this statement | VACall (HsExpr GhcRn) Int -- In the third argument of function f @@ -245,7 +246,7 @@ a second time. appCtxtLoc :: AppCtxt -> SrcSpan appCtxtLoc (VAExpansion _ l) = l -appCtxtLoc (VAExpansionStmt _) = generatedSrcSpan +appCtxtLoc (VAExpansionStmt _ l) = l appCtxtLoc (VACall _ _ l) = l appCtxtExpr :: AppCtxt -> Maybe (HsExpr GhcRn) @@ -260,7 +261,7 @@ insideExpansion (VACall {}) = False instance Outputable AppCtxt where ppr (VAExpansion e l) = text "VAExpansion" <+> ppr e <+> ppr l - ppr (VAExpansionStmt stmt) = text "VAExpansionStmt" <+> ppr stmt + ppr (VAExpansionStmt stmt l) = text "VAExpansionStmt" <+> ppr stmt <+> ppr l ppr (VACall f n l) = text "VACall" <+> int n <+> ppr f <+> ppr l type family XPass p where @@ -295,22 +296,8 @@ splitHsApps :: HsExpr GhcRn -> ( (HsExpr GhcRn, AppCtxt) -- Head , [HsExprArg 'TcpRn]) -- Args -- See Note [splitHsApps] -splitHsApps e = -- maybeShiftCtxt $ - go e (top_ctxt 0 e) [] +splitHsApps e = go e (top_ctxt 0 e) [] where - -- Ugly fix for setting the correct AppCtxt for let statements - -- The point is that when we try to typecheck a let expression we are checking - -- for the body of the let expression. But the go function for let statement expansion does not - -- calculate the correct app context - -- maybeShiftCtxt :: ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn]) -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn]) - -- maybeShiftCtxt ((rn_fun, fun_ctxt), rn_args) - -- | ((HsLet _ _ _ _ (L _ (XExpr (PopErrCtxt - -- (L _ (XExpr (ExpandedStmt (HsExpanded body_stmt _)))))))) - -- , VAExpansionStmt{}) <- (rn_fun, fun_ctxt) - -- = ((rn_fun, VAExpansionStmt body_stmt), rn_args) - -- | otherwise = ((rn_fun, fun_ctxt), rn_args) - - top_ctxt :: Int -> HsExpr GhcRn -> AppCtxt -- Always returns VACall fun n_val_args noSrcSpan -- to initialise the argument splitting in 'go' @@ -342,8 +329,8 @@ splitHsApps e = -- maybeShiftCtxt $ = go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args) - go (XExpr (ExpandedStmt (HsExpanded stmt fun))) _ args - = go fun (VAExpansionStmt stmt) + go (XExpr (ExpandedStmt (HsExpanded (L loc stmt) fun))) _ args + = go fun (VAExpansionStmt stmt (locA loc)) (EWrap (EExpandStmt stmt) : args) -- See Note [Desugar OpApp in the typechecker] @@ -853,8 +840,8 @@ tcInferAppHead_maybe fun args _ -> return Nothing addHeadCtxt :: AppCtxt -> TcM a -> TcM a -addHeadCtxt (VAExpansionStmt stmt@(L stmt_loc _)) thing_inside = - do setSrcSpanA stmt_loc $ +addHeadCtxt (VAExpansionStmt stmt loc) thing_inside = + do setSrcSpan loc $ addStmtCtxt (text "addHeadCtxt") stmt thing_inside addHeadCtxt fun_ctxt thing_inside @@ -1538,12 +1525,13 @@ mis-match in the number of value arguments. * * ********************************************************************* -} -addStmtCtxt :: SDoc -> ExprLStmt GhcRn -> TcRn a -> TcRn a +addStmtCtxt :: SDoc -> ExprStmt GhcRn -> TcRn a -> TcRn a addStmtCtxt doc stmt thing_inside = do isRebindable <- xoptM LangExt.RebindableSyntax - let err = pprStmtInCtxt isRebindable (HsDoStmt (DoExpr Nothing)) (unLoc stmt) - traceTc "addStmtCtxt" (ppr $ doc <+> err) - addErrCtxt ({-doc <+>-} err) thing_inside + let err = pprStmtInCtxt isRebindable (HsDoStmt (DoExpr Nothing)) stmt + traceTc "addStmtCtxt" (ppr doc) + addErrCtxt ({-doc <+>-} err) $ debugErrCtxt thing_inside + where pprStmtInCtxt :: Bool -> HsStmtContext GhcRn -> StmtLR GhcRn GhcRn (LHsExpr GhcRn) -> SDoc ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Tc.Gen.Match , tcStmtsAndThen , tcDoStmts , tcBody + , tcBodyNC , tcDoStmt , tcGuardStmt , checkArgCounts @@ -343,6 +344,12 @@ tcBody body res_ty ; tcMonoExpr body res_ty } +tcBodyNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc) +tcBodyNC body res_ty + = do { traceTc "tcBodyNC" (ppr res_ty) + ; tcMonoExprNC body res_ty + } + {- ************************************************************************ * * @@ -436,7 +443,6 @@ tcGuardStmt ctxt (BindStmt _ pat rhs) res_ty thing_inside (rhs', rhs_ty) <- tcScalingUsage ManyTy $ tcInferRhoNC rhs -- Stmt has a context already ; hasFixedRuntimeRep_syntactic FRRBindStmtGuard rhs_ty - ; traceTc "tcGuardStmt" (ppr pat <+> ppr rhs) ; (pat', thing) <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs) pat (unrestricted rhs_ty) $ thing_inside res_ty @@ -1262,7 +1268,7 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) do -- isRebindableOn <- xoptM LangExt.RebindableSyntax -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan expand_stmts <- expand_do_stmts do_or_lc lstmts - expr <- mk_failable_expr_tcm pat + expr <- mk_failable_expr pat expand_stmts fail_op return $ wrapGenSpan (mkPopErrCtxtExpr $ (wrapGenSpan (mkExpandedStmt stmt ( @@ -1332,36 +1338,32 @@ expand_do_stmts do_or_lc expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) -mk_failable_expr_tcm :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +mk_failable_expr :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) -- checks the pattern `pat`for irrefutability which decides if we need to decorate it with a fail block -mk_failable_expr_tcm pat@(L loc _) lexpr fail_op = +mk_failable_expr pat@(L loc _) expr fail_op = do { tc_env <- getGblEnv ; is_strict <- xoptM LangExt.Strict ; irrf_pat <- isIrrefutableHsPatRn' tc_env is_strict pat - ; traceTc "mk_fail_lexpr_tcm" (vcat [ ppr pat - , text "lexpr:" <+> ppr lexpr - , text "isIrrefutable:" <+> ppr irrf_pat - ]) + ; traceTc "mk_fail_expr" (vcat [ text "pat:" <+> ppr pat + , text "isIrrefutable:" <+> ppr irrf_pat + ]) ; if irrf_pat - -- don't decorate with fail statement if + -- don't decorate with fail block if -- the pattern is irrefutable - then return $ let (L _ e) = genHsLamDoExp [pat] lexpr - in L loc e - else mk_fail_block pat lexpr fail_op + then return $ genHsLamDoExp [pat] expr + else L loc <$> mk_fail_block pat expr fail_op } --- makes the fail block --- TODO: check the discussion around MonadFail.fail type signature. --- Should we really say `mkHsString "fail pattern"`? if yes, maybe a better error message would help -mk_fail_block :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn) +-- makes the fail block with a given fail_op +mk_fail_block :: LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (HsExpr GhcRn) mk_fail_block pat e (Just (SyntaxExprRn fail_op)) = do dflags <- getDynFlags - return $ wrapGenSpan (HsLam noExtField $ mkMatchGroup doExpansionOrigin -- \ + return $ HsLam noExtField $ mkMatchGroup doExpansionOrigin -- \ (wrapGenSpan [ genHsCaseAltDoExp pat e -- pat -> expr , genHsCaseAltDoExp (wrapGenSpan (WildPat noExtField)) -- _ -> fail "fail pattern" $ wrapGenSpan (genHsApp (wrapGenSpan fail_op) (mk_fail_msg_expr dflags pat)) - ])) + ]) where mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn mk_fail_msg_expr dflags pat ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -85,6 +85,7 @@ module GHC.Tc.Utils.Monad( -- * Context management for the type checker getErrCtxt, setErrCtxt, addErrCtxt, addErrCtxtM, addLandmarkErrCtxt, + debugErrCtxt, addLandmarkErrCtxtM, popErrCtxt, getCtLocM, setCtLocM, mkCtLocEnv, -- * Diagnostic message generation (type checker) @@ -1269,7 +1270,8 @@ updCtxt ctxt env | otherwise = addLclEnvErrCtxt ctxt env popErrCtxt :: TcM a -> TcM a -popErrCtxt = updLclEnv (\env -> setLclEnvErrCtxt (pop $ getLclEnvErrCtxt env) env) +popErrCtxt thing_inside = updLclEnv (\env -> setLclEnvErrCtxt (pop $ getLclEnvErrCtxt env) env) $ + debugErrCtxt $ thing_inside where pop [] = [] pop (_:msgs) = msgs @@ -1301,6 +1303,19 @@ setCtLocM (CtLoc { ctl_env = lcl }) thing_inside $ env) thing_inside + +debugErrCtxt :: TcRn a -> TcRn a +debugErrCtxt thing_inside + = do { err_ctxt <- getErrCtxt + ; env0 <- liftZonkM tcInitTidyEnv + ; err_info <- mkErrInfo env0 err_ctxt + ; traceTc "debugErrCtxt" err_info + ; thing_inside + } + + + + {- ********************************************************************* * * Error recovery and exceptions ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.hs ===================================== @@ -6,7 +6,7 @@ module DoExpansion2 where getVal :: Int -> IO String getVal _ = return "x" -ffff1, ffff2, ffff3, ffff4, ffff5 :: IO Int +ffff1, ffff2, ffff3, ffff4, ffff5, ffff6 :: IO Int ffff1 = do x <- getChar @@ -26,3 +26,6 @@ ffff4 = do Just x <- getChar -- should error here ffff5 = do x <- getChar Just x <- getChar -- should error here return x + +ffff6 = do _ <- (getVal 1) + return () -- should error here ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.stderr ===================================== @@ -39,8 +39,15 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ • In the pattern: Just x In a stmt of a 'do' block: Just x <- getChar - In an equation for ‘ffff5’: - ffff5 - = do x <- getChar - Just x <- getChar - return x + In the expression: + do x <- getChar + Just x <- getChar + return x + +DoExpansion2.hs:31:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type ‘Int’ with actual type ‘()’ + • In the first argument of ‘return’, namely ‘()’ + In a stmt of a 'do' block: return () + In the expression: + do _ <- (getVal 1) + return () ===================================== testsuite/tests/typecheck/should_fail/DoExpansion3.stderr ===================================== @@ -29,3 +29,18 @@ DoExpansion3.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul In the expression: do Just x <- getChar return x + +DoExpansion3.hs:33:3: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘()’ with ‘Int’ + Expected: IO Int + Actual: IO () + • In a stmt of a 'do' block: putStrLn $ a + "" + In the expression: + do let z :: Int = 3 + let a = 1 + putStrLn $ a + "" + In an equation for ‘gggg5’: + gggg5 + = do let z :: Int = ... + let a = ... + putStrLn $ a + "" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc7db422d0b6f2d54c9808a7041e63dd44d4783a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc7db422d0b6f2d54c9808a7041e63dd44d4783a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 00:08:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 20:08:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22941 Message-ID: <64bf1295d6e6a_17b24eb80107030ad@gitlab.mail> Ben Gamari pushed new branch wip/T22941 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22941 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 00:12:27 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 24 Jul 2023 20:12:27 -0400 Subject: [Git][ghc/ghc][wip/T22941] 31 commits: Remove unused files in .gitlab Message-ID: <64bf136bc4574_17b24eb809c7067e3@gitlab.mail> Ben Gamari pushed to branch wip/T22941 at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 316266d3 by Ben Gamari at 2023-07-24T20:12:17-04:00 linker/PEi386: Don't sign-extend symbol section number Previously we incorrectly interpreted PE section numbers as signed values. However, this isn't the case; rather, it's an unsigned 16-bit number with a few special bit-patterns (0xffff and 0xfffe). This resulted in #22941 as the linker would conclude that the sections were invalid. Fixing this required quite a bit of refactoring. Closes #22941. - - - - - 30 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e84d8a6c8524b7292f917017e158344dfa2c74f...316266d3cd235a260129769b1c225eda297b0f96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e84d8a6c8524b7292f917017e158344dfa2c74f...316266d3cd235a260129769b1c225eda297b0f96 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 07:50:35 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 25 Jul 2023 03:50:35 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian/werror-ci Message-ID: <64bf7ecb6efa0_17b24e95bb0b3076497e@gitlab.mail> Matthew Pickering pushed new branch wip/hadrian/werror-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian/werror-ci You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 07:54:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 25 Jul 2023 03:54:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Kill off gen_bytearray_addr_access_ops.py Message-ID: <64bf7fc58f985_17b24eb8038765165@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 58ca4def by Matthew Pickering at 2023-07-25T03:54:41-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - 9b530737 by Matthew Pickering at 2023-07-25T03:54:41-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - ec1392f1 by Matthew Pickering at 2023-07-25T03:54:41-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 18 changed files: - .gitlab-ci.yml - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bc0c36754f086d0b65a39a558e1391b0ac67ffa...ec1392f124e1de39c9a9ef5564f266faa6d69058 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bc0c36754f086d0b65a39a558e1391b0ac67ffa...ec1392f124e1de39c9a9ef5564f266faa6d69058 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 08:01:26 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 25 Jul 2023 04:01:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-toolchain-revert Message-ID: <64bf815647a5e_17b24eb809c77047b@gitlab.mail> Matthew Pickering pushed new branch wip/ghc-toolchain-revert at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-toolchain-revert You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 08:10:21 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 25 Jul 2023 04:10:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bootstrap-full-ci Message-ID: <64bf836d98099_17b24eb80607774aa@gitlab.mail> Matthew Pickering pushed new branch wip/bootstrap-full-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bootstrap-full-ci You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 08:45:10 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 25 Jul 2023 04:45:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/fix-toolchain-selection Message-ID: <64bf8b96436ab_17b24e289f3ad079132c@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/fix-toolchain-selection at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/fix-toolchain-selection You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 08:48:54 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 25 Jul 2023 04:48:54 -0400 Subject: [Git][ghc/ghc][wip/romes/fix-toolchain-selection] 46 commits: Do primop rep-poly checks when instantiating Message-ID: <64bf8c75e97d0_17b24eb7ffc7949a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fix-toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - b82d3e63 by Rodrigo Mesquita at 2023-07-25T09:48:43+01:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - 24 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f78e6a79573fb0c4a7abb9789cc19457cdd47f0b...b82d3e637739667a0f4e4938941d0b9fe2da79fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f78e6a79573fb0c4a7abb9789cc19457cdd47f0b...b82d3e637739667a0f4e4938941d0b9fe2da79fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 10:11:26 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 25 Jul 2023 06:11:26 -0400 Subject: [Git][ghc/ghc][wip/romes/fix-toolchain-selection] configure: Default missing options to False when preparing ghc-toolchain Targets Message-ID: <64bf9fce5cd6f_17b24eb80748330de@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fix-toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 31677778 by Rodrigo Mesquita at 2023-07-25T11:11:19+01:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - 1 changed file: - m4/prep_target_file.m4 Changes: ===================================== m4/prep_target_file.m4 ===================================== @@ -58,7 +58,8 @@ AC_DEFUN([PREP_BOOLEAN],[ $1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + $1Bool=False ;; esac AC_SUBST([$1Bool]) @@ -78,7 +79,8 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ Not$1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + Not$1Bool=False ;; esac AC_SUBST([Not$1Bool]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/316777785b0b7e374060d5e55c20aa983bd79ccf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/316777785b0b7e374060d5e55c20aa983bd79ccf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 10:42:28 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 25 Jul 2023 06:42:28 -0400 Subject: [Git][ghc/ghc][wip/mo-touch] 8 commits: ghc-toolchain: Initial commit Message-ID: <64bfa7141b8c1_17b24eb8038846399@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/mo-touch at Glasgow Haskell Compiler / GHC Commits: 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 1e35e981 by Krzysztof Gogolewski at 2023-07-25T12:41:54+02:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 30 changed files: - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - + hadrian/cfg/default.host.target.in - + hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Flavour.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e0166f9ede913de23a127587b2ddb93920a4cca...1e35e981023a3ca02937cef886ba4371bce58b00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e0166f9ede913de23a127587b2ddb93920a4cca...1e35e981023a3ca02937cef886ba4371bce58b00 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 11:16:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 25 Jul 2023 07:16:22 -0400 Subject: [Git][ghc/ghc][wip/T22404] 61 commits: Remove unused files in .gitlab Message-ID: <64bfaf0630358_17b24eb80388526f2@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - ec134f82 by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Work in progress on #22404 Very much not ready! - - - - - a914bb7f by Sebastian Graf at 2023-07-25T12:14:53+01:00 Partition into OneOccs and ManyOccs - - - - - 91969a8a by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Wibbles - - - - - c2438a73 by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Refactor WithTailJoinDetails - - - - - 0461729f by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Wibbles - - - - - fb0821c6 by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Wibbles - - - - - 1abd234a by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Major wibbles - - - - - bd2e1d66 by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Wibble - - - - - 472654c7 by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Vital fix to alt_env - - - - - 5186c596 by Simon Peyton Jones at 2023-07-25T12:14:53+01:00 Comments - - - - - a91d09ae by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Another crucial change Fixing a wrongly-zapped occ_join_points ..and a DEBUG check to catch it if it happens again - - - - - ebb786cf by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Fast path for addInScope - - - - - 09850e5d by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Tiny fix - - - - - 87ebe6b5 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Simplify the shadowing case - - - - - 66b807ee by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 More efficient now - - - - - 3a033c24 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Wibbles - - - - - d5a63fd1 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Wibble - - - - - 6ac2a104 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Wibbles - - - - - 1322ffab by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Comments only - - - - - 24af9cdb by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Wibbles - - - - - df61beea by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Sundry perf improvements - - - - - 17f68c84 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Wibbles to efficiency Esp simplify occ_join_points - - - - - 4a132596 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Further wibbles - - - - - 1e21593a by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 More wibbles - - - - - b87e40bd by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Remove the in-scope set from OccAnal - - - - - 42eeb695 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Fix stupid bug - - - - - b8f903e3 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Try effect of removing fast path in occAnalBind - - - - - df37aa3b by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Try to get benefits of fast path with less duplication - - - - - 00c4a874 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 More performance tuning - - - - - 5446f588 by Simon Peyton Jones at 2023-07-25T12:14:54+01:00 Dealing with lambdas again - - - - - eaa4fc6b by Simon Peyton Jones at 2023-07-25T12:15:24+01:00 Try the effect of a special case in occAnalRhs for non-rules functions - - - - - 14 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/DmdAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/702dc152cad9d894ce34ef2f398fabac6764de91...eaa4fc6b1c1e3f10cec06fb9a9d100826ff4c34b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/702dc152cad9d894ce34ef2f398fabac6764de91...eaa4fc6b1c1e3f10cec06fb9a9d100826ff4c34b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 12:07:30 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Tue, 25 Jul 2023 08:07:30 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_immediates] Aarch64 NCG: Use encoded immediates for literals. Message-ID: <64bfbb02b9d5c_17b24e289f3ad0862090@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_immediates at Glasgow Haskell Compiler / GHC Commits: be3d2837 by Andreas Klebinger at 2023-07-25T13:57:37+02:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 4 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -372,6 +372,97 @@ getSomeReg expr = do Fixed rep reg code -> return (reg, rep, code) +{- Note [Aarch64 immediates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Aarch64 with it's fixed width instruction encoding uses leftover space for +immediates. +If you want the full rundown consult the arch reference document: +"Arm® Architecture Reference Manual" - "C3.4 Data processing - immediate" + +The gist of it is that different instructions allow for different immediate encodings. +The ones we care about for better code generation are: + +* Simple but potentially repeated bit-patterns for logic instructions. +* 16bit numbers shifted by multiples of 16. +* 12 bit numbers optionally shifted by 12 bits. + +It might seem like the ISA allows for 64bit immediates but this isn't the case. +Rather there are some instruction aliases which allow for large unencoded immediates +which will then be transalted to one of the immediate encodings implicitly. + +For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, lsl #16 +-} + +-- | Move (wide immediate) +-- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. +-- Used with MOVZ,MOVN, MOVK +-- See Note [Aarch64 immediates] +getMovWideImm :: Integer -> Width -> Maybe Operand +getMovWideImm n w + -- TODO: Handle sign extension/negatives + | n <= 0 + = Nothing + -- Fits in 16 bits + | sized_n < 2^(16 :: Int) + = Just $ OpImm (ImmInteger truncated) + + -- 0x0000 0000 xxxx 0000 + | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 16) SLSL 16 + + -- 0x 0000 xxxx 0000 0000 + | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 32) SLSL 32 + + -- 0x xxxx 0000 0000 0000 + | trailing_zeros >= 48 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 48) SLSL 48 + + | otherwise + = Nothing + where + truncated = narrowU w n + sized_n = fromIntegral truncated :: Word64 + trailing_zeros = countTrailingZeros sized_n + +-- | Arithmetic(immediate) +-- Allows for 12bit immediates which can be shifted by 0 or 12 bits. +-- Used with ADD, ADDS, SUB, SUBS, CMP, CMN +-- See Note [Aarch64 immediates] +getArithImm :: Integer -> Width -> Maybe Operand +getArithImm n w + -- TODO: Handle sign extension + | n <= 0 + = Nothing + -- Fits in 16 bits + -- Fits in 12 bits + | sized_n < 2^(12::Int) + = Just $ OpImm (ImmInteger truncated) + + -- 12 bits shifted by 12 places. + | trailing_zeros >= 12 && sized_n < 2^(24::Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 12) SLSL 12 + + | otherwise + = Nothing + where + sized_n = fromIntegral truncated :: Word64 + truncated = narrowU w n + trailing_zeros = countTrailingZeros sized_n + +-- | Logical (immediate) +-- Allows encoding of some repeated bitpatterns +-- Used with AND, ANDS, EOR, ORR, TST +-- and their aliases which includes at least MOV (bitmask immediate) +-- See Note [Aarch64 immediates] +getBitmaskImm :: Integer -> Width -> Maybe Operand +getBitmaskImm n w + | isAArch64Bitmask truncated = Just $ OpImm (ImmInteger truncated) + | otherwise = Nothing + where + truncated = narrowU w n + + -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) @@ -494,8 +585,14 @@ getRegister' config plat expr CmmLit lit -> case lit of - -- TODO handle CmmInt 0 specially, use wzr or xzr. - + -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move. + -- TODO: Reenable after https://gitlab.haskell.org/ghc/ghc/-/issues/23632 is fixed. + -- CmmInt 0 W32 -> do + -- let format = intFormat W32 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) + -- CmmInt 0 W64 -> do + -- let format = intFormat W64 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) CmmInt i W16 | i >= 0 -> do @@ -510,8 +607,13 @@ getRegister' config plat expr -- Those need the upper bits set. We'd either have to explicitly sign -- or figure out something smarter. Lowered to -- `MOV dst XZR` + CmmInt i w | i >= 0 + , Just imm_op <- getMovWideImm i w -> do + return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op))) + CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger i))))) + CmmInt i w | isNbitEncodeable 32 i, i >= 0 -> do let half0 = fromIntegral (fromIntegral i :: Word16) half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16) @@ -586,7 +688,6 @@ getRegister' config plat expr (op, imm_code) <- litToImm' lit let rep = cmmLitType plat lit format = cmmTypeFormat rep - -- width = typeWidth rep return (Any format (\dst -> imm_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op)) CmmLabelOff lbl off -> do @@ -791,17 +892,51 @@ getRegister' config plat expr -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op -- A "plain" operation. - bitOp w op = do + bitOpImm w op encode_imm = do -- compute x <- x -- compute x <- y -- x, x, x (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, format_y, code_y) <- getSomeReg y - massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOp: incompatible" + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n w + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOpImm: incompatible" return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` - op (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) + op (OpReg w dst) (OpReg w reg_x) op_y) + + -- A (potentially signed) integer operation. + -- In the case of 8- and 16-bit signed arithmetic we must first + -- sign-extend both arguments to 32-bits. + -- See Note [Signed arithmetic on AArch64]. + intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) + intOpImm {- is signed -} True w op _encode_imm = intOp True w op + intOpImm False w op encode_imm = do + -- compute x <- x + -- compute x <- y + -- x, x, x + (reg_x, format_x, code_x) <- getSomeReg x + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n w + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" + -- This is the width of the registers on which the operation + -- should be performed. + let w' = opRegWidth w + return $ Any (intFormat w) $ \dst -> + code_x `appOL` + code_y `appOL` + op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL` + truncateReg w' w dst -- truncate back to the operand's original width -- A (potentially signed) integer operation. -- In the case of 8- and 16-bit signed arithmetic we must first @@ -847,9 +982,9 @@ getRegister' config plat expr case op of -- Integer operations -- Add/Sub should only be Integer Options. - MO_Add w -> intOp False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) + MO_Add w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) getArithImm -- TODO: Handle sub-word case - MO_Sub w -> intOp False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) + MO_Sub w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) getArithImm -- Note [CSET] -- ~~~~~~~~~~~ @@ -891,8 +1026,8 @@ getRegister' config plat expr -- N.B. We needn't sign-extend sub-word size (in)equality comparisons -- since we don't care about ordering. - MO_Eq w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d EQ ]) - MO_Ne w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d NE ]) + MO_Eq w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d EQ ]) getArithImm + MO_Ne w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d NE ]) getArithImm -- Signed multiply/divide MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) @@ -921,10 +1056,10 @@ getRegister' config plat expr MO_S_Lt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLT ]) -- Unsigned comparisons - MO_U_Ge w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) - MO_U_Le w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) - MO_U_Gt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) - MO_U_Lt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) + MO_U_Ge w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm + MO_U_Le w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm + MO_U_Gt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm + MO_U_Lt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm -- Floating point arithmetic MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) @@ -947,9 +1082,9 @@ getRegister' config plat expr MO_F_Lt w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OLT ]) -- x < y <=> y >= x -- Bitwise operations - MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) + MO_And w -> bitOpImm w (\d x y -> unitOL $ AND d x y) getBitmaskImm + MO_Or w -> bitOpImm w (\d x y -> unitOL $ ORR d x y) getBitmaskImm + MO_Xor w -> bitOpImm w (\d x y -> unitOL $ EOR d x y) getBitmaskImm MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) @@ -999,7 +1134,7 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool - isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) + isNbitEncodeable n_bits i = let shift = n_bits - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -110,6 +110,7 @@ regUsageOfInstr platform instr = case instr of LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) + MOVZ dst src -> usage (regOp src, regOp dst) MVN dst src -> usage (regOp src, regOp dst) ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -251,6 +252,7 @@ patchRegsOfInstr instr env = case instr of LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) + MOVZ o1 o2 -> MOVZ (patchOp o1) (patchOp o2) MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) @@ -381,9 +383,8 @@ mkSpillInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) + mkIp0SpillAddr imm = ANN (text "Spill: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkStrSp imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) mkStrIp0 imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) @@ -408,9 +409,7 @@ mkLoadInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) mkIp0SpillAddr imm = ANN (text "Reload: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkLdrSp imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) @@ -619,7 +618,7 @@ data Instr | MOV Operand Operand -- rd = rn or rd = #i | MOVK Operand Operand -- | MOVN Operand Operand - -- | MOVZ Operand Operand + | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 | ORR Operand Operand Operand -- rd = rn | op2 @@ -708,6 +707,7 @@ instrCon i = LSR{} -> "LSR" MOV{} -> "MOV" MOVK{} -> "MOVK" + MOVZ{} -> "MOVZ" MVN{} -> "MVN" ORN{} -> "ORN" ORR{} -> "ORR" @@ -782,6 +782,9 @@ wzr = OpReg W32 (RegReal (RealRegSingle (-1))) sp = OpReg W64 (RegReal (RealRegSingle 31)) ip0 = OpReg W64 (RegReal (RealRegSingle 16)) +reg_zero :: Reg +reg_zero = RegReal (RealRegSingle (-1)) + _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) x0, x1, x2, x3, x4, x5, x6, x7 :: Operand ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -417,6 +417,7 @@ pprInstr platform instr = case instr of | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 | otherwise -> op2 (text "\tmov") o1 o2 MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 + MOVZ o1 o2 -> op2 (text "\tmovz") o1 o2 MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3 ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -77,6 +77,8 @@ litToImm (CmmInt i w) = ImmInteger (narrowS w i) -- narrow to the width: a CmmInt might be out of -- range, but we assume that ImmInteger only contains -- in-range values. A signed value should be fine here. + -- AK: We do call this with out of range values, however + -- it just truncates as we would expect. litToImm (CmmFloat f W32) = ImmFloat f litToImm (CmmFloat f W64) = ImmDouble f litToImm (CmmLabel l) = ImmCLbl l @@ -147,6 +149,13 @@ classOfRealReg (RealRegSingle i) | i < 32 = RcInteger | otherwise = RcDouble +fmtOfRealReg :: RealReg -> Format +fmtOfRealReg real_reg = + case classOfRealReg real_reg of + RcInteger -> II64 + RcDouble -> FF64 + RcFloat -> panic "No float regs on arm" + regDotColor :: RealReg -> SDoc regDotColor reg = case classOfRealReg reg of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be3d2837eaba0b089a10700e7e75adac437cc15b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be3d2837eaba0b089a10700e7e75adac437cc15b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 12:17:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 08:17:59 -0400 Subject: [Git][ghc/ghc][wip/T22941] linker/PEi386: Don't sign-extend symbol section number Message-ID: <64bfbd77ac3a6_17b24eb8060871392@gitlab.mail> Ben Gamari pushed to branch wip/T22941 at Glasgow Haskell Compiler / GHC Commits: 4bf336ca by Ben Gamari at 2023-07-25T08:17:53-04:00 linker/PEi386: Don't sign-extend symbol section number Previously we incorrectly interpreted PE section numbers as signed values. However, this isn't the case; rather, it's an unsigned 16-bit number with a few special bit-patterns (0xffff and 0xfffe). This resulted in #22941 as the linker would conclude that the sections were invalid. Fixing this required quite a bit of refactoring. Closes #22941. - - - - - 2 changed files: - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/linker/PEi386.c ===================================== @@ -697,8 +697,16 @@ size_t getSymbolSize ( COFF_HEADER_INFO *info ) } } +// Constants which may be returned by getSymSectionNumber. +// See https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#section-number-values +#define PE_SECTION_UNDEFINED ((uint32_t) 0) +#define PE_SECTION_ABSOLUTE ((uint32_t) -1) +#define PE_SECTION_DEBUG ((uint32_t) -2) + +// Returns either PE_SECTION_{UNDEFINED,ABSOLUTE,DEBUG} or the (one-based) +// section number of the given symbol. __attribute__ ((always_inline)) inline -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); @@ -707,7 +715,13 @@ int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) case COFF_ANON_BIG_OBJ: return sym->ex.SectionNumber; default: - return sym->og.SectionNumber; + // Take care to only sign-extend reserved values; see #22941. + switch (sym->og.SectionNumber) { + case IMAGE_SYM_UNDEFINED: return PE_SECTION_UNDEFINED; + case IMAGE_SYM_ABSOLUTE : return PE_SECTION_ABSOLUTE; + case IMAGE_SYM_DEBUG: return PE_SECTION_DEBUG; + default: return (uint16_t) sym->og.SectionNumber; + } } } @@ -1652,7 +1666,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) StgWord globalBssSize = 0; for (unsigned int i=0; i < info->numberOfSymbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - if (getSymSectionNumber (info, sym) == IMAGE_SYM_UNDEFINED + if (getSymSectionNumber (info, sym) == PE_SECTION_UNDEFINED && getSymValue (info, sym) > 0 && getSymStorageClass (info, sym) != IMAGE_SYM_CLASS_SECTION) { globalBssSize += getSymValue (info, sym); @@ -1685,21 +1699,39 @@ ocGetNames_PEi386 ( ObjectCode* oc ) for (unsigned int i = 0; i < (uint32_t)oc->n_symbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - int32_t secNumber = getSymSectionNumber (info, sym); uint32_t symValue = getSymValue (info, sym); uint8_t symStorageClass = getSymStorageClass (info, sym); - SymbolAddr *addr = NULL; bool isWeak = false; SymbolName *sname = get_sym_name (getSymShortName (info, sym), oc); - Section *section = secNumber > 0 ? &oc->sections[secNumber-1] : NULL; + + uint32_t secNumber = getSymSectionNumber (info, sym); + Section *section; + switch (secNumber) { + case PE_SECTION_UNDEFINED: + // N.B. This may be a weak symbol + section = NULL; + break; + case PE_SECTION_ABSOLUTE: + IF_DEBUG(linker, debugBelch("symbol %s is ABSOLUTE, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + case PE_SECTION_DEBUG: + IF_DEBUG(linker, debugBelch("symbol %s is DEBUG, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + default: + CHECK(secNumber < (uint32_t) oc->n_sections); + section = &oc->sections[secNumber-1]; + } SymType type; switch (getSymType(oc->info->ch_info, sym)) { case 0x00: type = SYM_TYPE_DATA; break; case 0x20: type = SYM_TYPE_CODE; break; default: - debugBelch("Invalid symbol type: 0x%x\n", getSymType(oc->info->ch_info, sym)); + debugBelch("Symbol %s has invalid type 0x%x\n", + sname, getSymType(oc->info->ch_info, sym)); return 1; } @@ -1730,8 +1762,18 @@ ocGetNames_PEi386 ( ObjectCode* oc ) CHECK(symValue == 0); COFF_symbol_aux_weak_external *aux = (COFF_symbol_aux_weak_external *) (sym+1); COFF_symbol* targetSym = &oc->info->symbols[aux->TagIndex]; - int32_t targetSecNumber = getSymSectionNumber (info, targetSym); - Section *targetSection = targetSecNumber > 0 ? &oc->sections[targetSecNumber-1] : NULL; + + uint32_t targetSecNumber = getSymSectionNumber (info, targetSym); + Section *targetSection; + switch (targetSecNumber) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + targetSection = NULL; + break; + default: + targetSection = &oc->sections[targetSecNumber-1]; + } addr = (SymbolAddr*) ((size_t) targetSection->start + getSymValue(info, targetSym)); } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { @@ -1850,6 +1892,9 @@ ocGetNames_PEi386 ( ObjectCode* oc ) return false; break; + } else if (secNumber == PE_SECTION_UNDEFINED) { + IF_DEBUG(linker, debugBelch("symbol %s is UNDEFINED, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); } if ((addr != NULL || isWeak) @@ -1976,7 +2021,19 @@ ocResolve_PEi386 ( ObjectCode* oc ) debugBelch("'\n" )); if (getSymStorageClass (info, sym) == IMAGE_SYM_CLASS_STATIC) { - Section section = oc->sections[getSymSectionNumber (info, sym)-1]; + uint32_t sect_n = getSymSectionNumber (info, sym); + switch (sect_n) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + errorBelch(" | %" PATH_FMT ": symbol `%s' has invalid section number %02x", + oc->fileName, symbol, sect_n); + return false; + default: + break; + } + CHECK(sect_n < (uint32_t) oc->n_sections); + Section section = oc->sections[sect_n - 1]; S = ((size_t)(section.start)) + ((size_t)(getSymValue (info, sym))); } else { ===================================== rts/linker/PEi386.h ===================================== @@ -143,7 +143,7 @@ struct _Alignments { COFF_OBJ_TYPE getObjectType ( char* image, pathchar* fileName ); COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc ); size_t getSymbolSize ( COFF_HEADER_INFO *info ); -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint32_t getSymValue ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymStorageClass ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymNumberOfAuxSymbols ( COFF_HEADER_INFO *info, COFF_symbol* sym ); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bf336ca9fc237fb94c281910a883e7d43b16390 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bf336ca9fc237fb94c281910a883e7d43b16390 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 12:28:53 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 08:28:53 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8-forward-ports] 28 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64bfc0059072b_17b24eb80748789ed@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8-forward-ports at Glasgow Haskell Compiler / GHC Commits: c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 0a7bf935 by Ben Gamari at 2023-07-25T08:28:38-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 8395f7aa by Ben Gamari at 2023-07-25T08:28:39-04:00 Bump deepseq submodule to 1.5. And bump bounds (cherry picked from commit 1228d3a4a08d30eaf0138a52d1be25b38339ef0b) - - - - - 6f750cd1 by Ben Gamari at 2023-07-25T08:28:39-04:00 configure: Bump minimal boot GHC version to 9.4 (cherry picked from commit d3ffdaf9137705894d15ccc3feff569d64163e8e) - - - - - a2c48785 by Ben Gamari at 2023-07-25T08:28:39-04:00 template-haskell: Bump version to 2.21.0.0 (cherry picked from commit bf57fc9aea1196f97f5adb72c8b56434ca4b87cb) - - - - - 98fbf984 by Ben Gamari at 2023-07-25T08:28:39-04:00 base: Bump version to 4.19 Updates all boot library submodules. (cherry picked from commit 433d99a3c24a55b14ec09099395e9b9641430143) - - - - - ba0c549e by Ben Gamari at 2023-07-25T08:28:39-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. (cherry picked from commit 024861af51aee807d800e01e122897166a65ea93) - - - - - 506ebd4a by Ben Gamari at 2023-07-25T08:28:39-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. (cherry picked from commit c046a2382420f2be2c4a657c56f8d95f914ea47b) - - - - - b7a999f1 by Ben Gamari at 2023-07-25T08:28:39-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. (cherry picked from commit f356a7e8ec8ec3d6b2b30fd175598b9b80065d87) - - - - - 2bafe31f by Ben Gamari at 2023-07-25T08:28:39-04:00 Update generate_bootstrap_plans (cherry picked from commit c86a40553b37ba24d53586b3fe1f081ee32fae90) - - - - - f2b158b3 by Ben Gamari at 2023-07-25T08:28:39-04:00 hadrian/bootstrap: Drop GHC 9.2 plans (cherry picked from commit d58049efefd632e668b276357d6469b270587209) - - - - - 1d0fa085 by Ben Gamari at 2023-07-25T08:28:39-04:00 hadrian/bootstrap: Add 9.6.2 plans (cherry picked from commit a79d1806ed887a64f79fea25921711caef2ae108) - - - - - dc04412b by Ben Gamari at 2023-07-25T08:28:39-04:00 hadrian/bootstrap: Regenerate existing plans (cherry picked from commit 4f142ee9ab0cca0274c33df6c49972cb40744a6c) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/365660fba9660933924215c541913218b687a003...dc04412be27a62a3cdc7a2f286cab39f8010d12b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/365660fba9660933924215c541913218b687a003...dc04412be27a62a3cdc7a2f286cab39f8010d12b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 12:43:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 08:43:09 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8-forward-ports] 9 commits: template-haskell: Bump version to 2.21.0.0 Message-ID: <64bfc35d2961f_17b24e624d8ee48874a@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8-forward-ports at Glasgow Haskell Compiler / GHC Commits: 872cde71 by Ben Gamari at 2023-07-25T08:40:18-04:00 template-haskell: Bump version to 2.21.0.0 Bumps exceptions submodule. (cherry picked from commit bf57fc9aea1196f97f5adb72c8b56434ca4b87cb) - - - - - d967d9da by Ben Gamari at 2023-07-25T08:40:27-04:00 base: Bump version to 4.19 Updates all boot library submodules. (cherry picked from commit 433d99a3c24a55b14ec09099395e9b9641430143) - - - - - ff34fe12 by Ben Gamari at 2023-07-25T08:40:27-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. (cherry picked from commit 024861af51aee807d800e01e122897166a65ea93) - - - - - b302bce7 by Ben Gamari at 2023-07-25T08:40:27-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. (cherry picked from commit c046a2382420f2be2c4a657c56f8d95f914ea47b) - - - - - 8ca968c5 by Ben Gamari at 2023-07-25T08:40:27-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. (cherry picked from commit f356a7e8ec8ec3d6b2b30fd175598b9b80065d87) - - - - - 5902c46a by Ben Gamari at 2023-07-25T08:40:27-04:00 Update generate_bootstrap_plans (cherry picked from commit c86a40553b37ba24d53586b3fe1f081ee32fae90) - - - - - 637dd242 by Ben Gamari at 2023-07-25T08:40:27-04:00 hadrian/bootstrap: Drop GHC 9.2 plans (cherry picked from commit d58049efefd632e668b276357d6469b270587209) - - - - - 65805cc0 by Ben Gamari at 2023-07-25T08:40:27-04:00 hadrian/bootstrap: Add 9.6.2 plans (cherry picked from commit a79d1806ed887a64f79fea25921711caef2ae108) - - - - - 3f4768ef by Ben Gamari at 2023-07-25T08:40:27-04:00 hadrian/bootstrap: Regenerate existing plans (cherry picked from commit 4f142ee9ab0cca0274c33df6c49972cb40744a6c) - - - - - 12 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/ghc.cabal.in - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc04412be27a62a3cdc7a2f286cab39f8010d12b...3f4768efb9c857cfc97a12fa8ce568d71e5bbe65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dc04412be27a62a3cdc7a2f286cab39f8010d12b...3f4768efb9c857cfc97a12fa8ce568d71e5bbe65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 12:45:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 25 Jul 2023 08:45:19 -0400 Subject: [Git][ghc/ghc][master] Fix pretty printing of WARNING pragmas Message-ID: <64bfc3df8a87_17b24eb8038896523@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - 8 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Unit/Module/Warnings.hs - testsuite/tests/printer/Makefile - + testsuite/tests/printer/Test23464.hs - testsuite/tests/printer/all.T - + testsuite/tests/warnings/should_compile/T23465.hs - + testsuite/tests/warnings/should_compile/T23465.stderr - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1234,7 +1234,7 @@ instance OutputableBndrId p <+> ppr txt where ppr_category = case txt of - WarningTxt (Just cat) _ _ -> text "[" <> ppr (unLoc cat) <> text "]" + WarningTxt (Just cat) _ _ -> text "in" <+> doubleQuotes (ppr cat) _ -> empty {- ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -222,10 +222,13 @@ deriving instance Eq (IdP pass) => Eq (WarningTxt pass) deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass) instance Outputable (WarningTxt pass) where - ppr (WarningTxt _ lsrc ws) + ppr (WarningTxt mcat lsrc ws) = case unLoc lsrc of - NoSourceText -> pp_ws ws - SourceText src -> ftext src <+> pp_ws ws <+> text "#-}" + NoSourceText -> pp_ws ws + SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}" + where + ctg_doc = maybe empty (\ctg -> text "in" <+> doubleQuotes (ppr ctg)) mcat + ppr (DeprecatedTxt lsrc ds) = case unLoc lsrc of ===================================== testsuite/tests/printer/Makefile ===================================== @@ -790,3 +790,8 @@ Test22765: Test22771: $(CHECK_PPR) $(LIBDIR) Test22771.hs $(CHECK_EXACT) $(LIBDIR) Test22771.hs + +.PHONY: Test23464 +Test23465: + $(CHECK_PPR) $(LIBDIR) Test23464.hs + $(CHECK_EXACT) $(LIBDIR) Test23464.hs ===================================== testsuite/tests/printer/Test23464.hs ===================================== @@ -0,0 +1,4 @@ +module T23465 {-# WaRNING in "x-a" "b" #-} where + +{-# WARNInG in "x-c" e "d" #-} +e = e ===================================== testsuite/tests/printer/all.T ===================================== @@ -190,3 +190,4 @@ test('T20531_red_ticks', extra_files(['T20531_defs.hs']), ghci_script, ['T20531_ test('HsDocTy', [ignore_stderr, req_ppr_deps], makefile_test, ['HsDocTy']) test('Test22765', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22765']) test('Test22771', [ignore_stderr, req_ppr_deps], makefile_test, ['Test22771']) +test('Test23464', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23464']) ===================================== testsuite/tests/warnings/should_compile/T23465.hs ===================================== @@ -0,0 +1,4 @@ +module T23465 {-# WaRNING in "x-a" "b" #-} where + +{-# WARNInG in "x-c" e "d" #-} +e = e ===================================== testsuite/tests/warnings/should_compile/T23465.stderr ===================================== @@ -0,0 +1,9 @@ + +==================== Parser ==================== +module T23465 +{-# WaRNING in "x-a" "b" #-} +where +{-# WARNInG in "x-c" e "d" #-} +e = e + + ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -66,3 +66,4 @@ test('T22702a', normal, compile, ['']) test('T22702b', normal, compile, ['']) test('T22826', normal, compile, ['']) test('T23573', [extra_files(["T23573.hs", "T23573A.hs", "T23573B.hs"])], multimod_compile, ['T23573', '-v0']) +test('T23465', normal, compile, ['-ddump-parsed']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/822ef66b54bd48df7c01fcafb99b7694952cae28 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/822ef66b54bd48df7c01fcafb99b7694952cae28 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 12:45:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 25 Jul 2023 08:45:50 -0400 Subject: [Git][ghc/ghc][master] 2 commits: ci-images: Bump to commit which has 9.6 image Message-ID: <64bfc3fedc8cb_17b24eb7ffc89972a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 5 changed files: - .gitlab-ci.yml - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/822ef66b54bd48df7c01fcafb99b7694952cae28...bb4089363c55bcba7248c0518758ecacf824ca0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/822ef66b54bd48df7c01fcafb99b7694952cae28...bb4089363c55bcba7248c0518758ecacf824ca0d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 12:55:33 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 25 Jul 2023 08:55:33 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-full-ci] 4 commits: Fix pretty printing of WARNING pragmas Message-ID: <64bfc64569d67_17b24eb807491199a@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-full-ci at Glasgow Haskell Compiler / GHC Commits: 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - f7b16d0f by Matthew Pickering at 2023-07-25T12:55:31+00:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 7 changed files: - .gitlab-ci.yml - compiler/GHC/Hs/Decls.hs - compiler/GHC/Unit/Module/Warnings.hs - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baa7cfff2298200e573672394cfe76bcf1aae51a...f7b16d0f77bae4e295088cc3d1baeec19899e584 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/baa7cfff2298200e573672394cfe76bcf1aae51a...f7b16d0f77bae4e295088cc3d1baeec19899e584 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 13:29:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 09:29:46 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8-forward-ports] 23 commits: ghc-toolchain: Initial commit Message-ID: <64bfce4aee5a2_17b24eb809c9337f@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8-forward-ports at Glasgow Haskell Compiler / GHC Commits: 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - a7e7b83b by Ben Gamari at 2023-07-25T09:25:58-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 251e7852 by Ben Gamari at 2023-07-25T09:26:02-04:00 Bump deepseq submodule to 1.5. And bump bounds (cherry picked from commit 1228d3a4a08d30eaf0138a52d1be25b38339ef0b) - - - - - 2aaafb94 by Ben Gamari at 2023-07-25T09:26:02-04:00 configure: Bump minimal boot GHC version to 9.4 (cherry picked from commit d3ffdaf9137705894d15ccc3feff569d64163e8e) - - - - - f84ac0d2 by Ben Gamari at 2023-07-25T09:26:02-04:00 template-haskell: Bump version to 2.21.0.0 (cherry picked from commit bf57fc9aea1196f97f5adb72c8b56434ca4b87cb) - - - - - 7adcac75 by Ben Gamari at 2023-07-25T09:26:02-04:00 base: Bump version to 4.19 Updates all boot library submodules. (cherry picked from commit 433d99a3c24a55b14ec09099395e9b9641430143) - - - - - c5c8f4d3 by Ben Gamari at 2023-07-25T09:26:02-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. (cherry picked from commit 024861af51aee807d800e01e122897166a65ea93) - - - - - 3e00f1f5 by Ben Gamari at 2023-07-25T09:26:02-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. (cherry picked from commit c046a2382420f2be2c4a657c56f8d95f914ea47b) - - - - - c8b51063 by Ben Gamari at 2023-07-25T09:26:02-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. (cherry picked from commit f356a7e8ec8ec3d6b2b30fd175598b9b80065d87) - - - - - 5946a39e by Ben Gamari at 2023-07-25T09:26:24-04:00 Update generate_bootstrap_plans (cherry picked from commit c86a40553b37ba24d53586b3fe1f081ee32fae90) - - - - - 6a242e4b by Ben Gamari at 2023-07-25T09:26:38-04:00 hadrian/bootstrap: Drop GHC 9.2 plans (cherry picked from commit d58049efefd632e668b276357d6469b270587209) - - - - - f318dec2 by Ben Gamari at 2023-07-25T09:27:09-04:00 hadrian/bootstrap: Add 9.6.2 plans (cherry picked from commit a79d1806ed887a64f79fea25921711caef2ae108) - - - - - c03d8b45 by Ben Gamari at 2023-07-25T09:28:07-04:00 hadrian/bootstrap: Regenerate existing plans (cherry picked from commit 4f142ee9ab0cca0274c33df6c49972cb40744a6c) - - - - - 5398fa6f by Ben Gamari at 2023-07-25T09:28:08-04:00 testsuite: Update base-exports - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - ghc/ghc-bin.cabal.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f4768efb9c857cfc97a12fa8ce568d71e5bbe65...5398fa6f924da36cf16c2b5544002344499108c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f4768efb9c857cfc97a12fa8ce568d71e5bbe65...5398fa6f924da36cf16c2b5544002344499108c8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 13:35:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 09:35:26 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8-forward-ports] 8 commits: base: Bump version to 4.19 Message-ID: <64bfcf9e47fe_17b24eb80609341f1@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8-forward-ports at Glasgow Haskell Compiler / GHC Commits: 46d29f51 by Ben Gamari at 2023-07-25T09:33:42-04:00 base: Bump version to 4.19 Updates all boot library submodules. (cherry picked from commit 433d99a3c24a55b14ec09099395e9b9641430143) - - - - - 41b7041f by Ben Gamari at 2023-07-25T09:33:42-04:00 testsuite: Normalise versions more aggressively In backpack hashes can contain `+` characters. (cherry picked from commit 024861af51aee807d800e01e122897166a65ea93) - - - - - 2906c71d by Ben Gamari at 2023-07-25T09:33:42-04:00 testsuite: Declare bkpcabal08 as fragile Due to spurious output changes described in #23648. (cherry picked from commit c046a2382420f2be2c4a657c56f8d95f914ea47b) - - - - - 568af831 by Ben Gamari at 2023-07-25T09:33:42-04:00 gitlab-ci: Only mark linker_unload_native as broken in static jobs This test passes on dynamically-linked Alpine. (cherry picked from commit f356a7e8ec8ec3d6b2b30fd175598b9b80065d87) - - - - - 16da9da2 by Ben Gamari at 2023-07-25T09:33:42-04:00 Update generate_bootstrap_plans (cherry picked from commit c86a40553b37ba24d53586b3fe1f081ee32fae90) - - - - - 45fbe72e by Ben Gamari at 2023-07-25T09:33:42-04:00 hadrian/bootstrap: Drop GHC 9.2 plans (cherry picked from commit d58049efefd632e668b276357d6469b270587209) - - - - - d355247e by Ben Gamari at 2023-07-25T09:34:55-04:00 hadrian/bootstrap: Add 9.6.2 plans (cherry picked from commit a79d1806ed887a64f79fea25921711caef2ae108) - - - - - 4f66fa47 by Ben Gamari at 2023-07-25T09:34:58-04:00 hadrian/bootstrap: Regenerate existing plans (cherry picked from commit 4f142ee9ab0cca0274c33df6c49972cb40744a6c) - - - - - 12 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/ghc.cabal.in - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5398fa6f924da36cf16c2b5544002344499108c8...4f66fa4766fd462c208881f0c9aa2f8704f0d3ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5398fa6f924da36cf16c2b5544002344499108c8...4f66fa4766fd462c208881f0c9aa2f8704f0d3ce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 14:13:12 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 25 Jul 2023 10:13:12 -0400 Subject: [Git][ghc/ghc][wip/expand-do] accepting new test output Message-ID: <64bfd8784a1c5_22c883b9a8c280f9@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 074e777f by Apoorv Ingle at 2023-07-25T09:12:57-05:00 accepting new test output - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - testsuite/tests/rebindable/rebindable6.stderr - testsuite/tests/typecheck/should_run/Typeable1.stderr Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -373,10 +373,6 @@ tcApp rn_expr exp_res_ty = do traceTc "tcApp" (vcat [text "VAExpansionStmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) setSrcSpan loc $ addStmtCtxt (text "tcApp VAExpansionStmt") stmt thing_inside - -- | XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _)) <- rn_fun - -- = do traceTc "tcApp" (vcat [text "RnFun stmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) - -- setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VAExpansion stmt") stmt - -- thing_inside | insideExpansion fun_ctxt = do traceTc "tcApp" (vcat [text "insideExpansion", ppr rn_fun, ppr fun_ctxt]) addHeadCtxt fun_ctxt thing_inside ===================================== testsuite/tests/rebindable/rebindable6.stderr ===================================== @@ -25,15 +25,15 @@ rebindable6.hs:110:17: error: [GHC-39999] return b rebindable6.hs:111:17: error: [GHC-39999] - • Ambiguous type variables ‘p0’, ‘t0’ arising from a do statement + • Ambiguous type variables ‘t1’, ‘t0’ arising from a do statement prevents the constraint ‘(HasBind - (IO (Maybe b) -> (Maybe b -> p0) -> t0))’ from being solved. + (IO (Maybe b) -> (Maybe b -> t1) -> t0))’ from being solved. (maybe you haven't applied a function to enough arguments?) Relevant bindings include g :: IO (Maybe b) (bound at rebindable6.hs:108:19) test_do :: IO a -> IO (Maybe b) -> IO b (bound at rebindable6.hs:108:9) - Probable fix: use a type annotation to specify what ‘p0’, + Probable fix: use a type annotation to specify what ‘t1’, ‘t0’ should be. Potentially matching instance: instance HasBind (IO a -> (a -> IO b) -> IO b) @@ -50,15 +50,15 @@ rebindable6.hs:111:17: error: [GHC-39999] return b rebindable6.hs:112:17: error: [GHC-39999] - • Ambiguous type variable ‘p0’ arising from a use of ‘return’ - prevents the constraint ‘(HasReturn (b -> p0))’ from being solved. + • Ambiguous type variable ‘t1’ arising from a use of ‘return’ + prevents the constraint ‘(HasReturn (b -> t1))’ from being solved. (maybe you haven't applied a function to enough arguments?) Relevant bindings include b :: b (bound at rebindable6.hs:111:23) g :: IO (Maybe b) (bound at rebindable6.hs:108:19) test_do :: IO a -> IO (Maybe b) -> IO b (bound at rebindable6.hs:108:9) - Probable fix: use a type annotation to specify what ‘p0’ should be. + Probable fix: use a type annotation to specify what ‘t1’ should be. Potentially matching instance: instance HasReturn (a -> IO a) -- Defined at rebindable6.hs:46:18 • In a stmt of a 'do' block: return b ===================================== testsuite/tests/typecheck/should_run/Typeable1.stderr ===================================== @@ -23,9 +23,3 @@ Typeable1.hs:22:5: error: [GHC-40564] [-Winaccessible-code (in -Wdefault), Werro • Relevant bindings include y :: TypeRep b2 (bound at Typeable1.hs:19:11) x :: TypeRep a2 (bound at Typeable1.hs:19:9) - -Typeable1.hs:22:5: error: [GHC-94210] [-Woverlapping-patterns (in -Wdefault), Werror=overlapping-patterns] - Pattern match has inaccessible right hand side - In a pattern binding in - a 'do' block: - App x y <- ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/074e777f3ca82a0e8506c66036778f6a8608ff05 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/074e777f3ca82a0e8506c66036778f6a8608ff05 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 14:48:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 25 Jul 2023 10:48:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Fix pretty printing of WARNING pragmas Message-ID: <64bfe0c295e36_22c883b9aa0572fc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 47955806 by Rodrigo Mesquita at 2023-07-25T10:48:28-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - 98a6e305 by Naïm Favier at 2023-07-25T10:48:31-04:00 docs: Fix typo - - - - - 7 changed files: - .gitlab-ci.yml - compiler/GHC/Hs/Decls.hs - compiler/GHC/Unit/Module/Warnings.hs - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec1392f124e1de39c9a9ef5564f266faa6d69058...98a6e305890c9cdc1b8d3481d15735ec1883c817 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec1392f124e1de39c9a9ef5564f266faa6d69058...98a6e305890c9cdc1b8d3481d15735ec1883c817 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 14:55:01 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Tue, 25 Jul 2023 10:55:01 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-with-fallback -finfo-table-map-with-stack Message-ID: <64bfe2451d50d_22c883b9ac872799@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: da89ae76 by Finley McIlwaine at 2023-07-25T08:54:24-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 16 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/phases.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da89ae76468b3f238d7cd153836ff759004f4b35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da89ae76468b3f238d7cd153836ff759004f4b35 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 14:55:27 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Tue, 25 Jul 2023 10:55:27 -0400 Subject: [Git][ghc/ghc][wip/t23702] 14 commits: Visible forall in types of terms: Part 1 (#22326) Message-ID: <64bfe25f34a07_22c883b9ab4731f@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 96816683 by Finley McIlwaine at 2023-07-25T08:55:17-06:00 Add -dipe-stats flag This is useful for seeing which info tables have information. - - - - - 27a472d4 by Finley McIlwaine at 2023-07-25T08:55:17-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/Static.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/da89ae76468b3f238d7cd153836ff759004f4b35...27a472d4a34e3c0d287c6079335abeb4df41530a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/da89ae76468b3f238d7cd153836ff759004f4b35...27a472d4a34e3c0d287c6079335abeb4df41530a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 15:43:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 11:43:10 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23726 Message-ID: <64bfed8e25acd_22c883b9a3c11201c@gitlab.mail> Ben Gamari pushed new branch wip/T23726 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23726 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 15:53:59 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Tue, 25 Jul 2023 11:53:59 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-with-fallback -finfo-table-map-with-stack Message-ID: <64bff0175c0d4_22c883b9a7811408@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 2e7f7466 by Finley McIlwaine at 2023-07-25T09:53:48-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 16 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/phases.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e7f7466ab330a309045c74c9f3b82165c750f3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2e7f7466ab330a309045c74c9f3b82165c750f3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 16:15:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 12:15:59 -0400 Subject: [Git][ghc/ghc][wip/T23726] configure: Derive library version from ghc-prim.cabal.in Message-ID: <64bff53f6574c_2fb451b9a3c5599@gitlab.mail> Ben Gamari pushed to branch wip/T23726 at Glasgow Haskell Compiler / GHC Commits: fc952a27 by Ben Gamari at 2023-07-25T12:15:54-04:00 configure: Derive library version from ghc-prim.cabal.in Since ghc-prim.cabal is now generated by Hadrian, we cannot depend upon it. Closes #23726. - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -1139,11 +1139,11 @@ dnl The packages below should include all packages needed by dnl doc/users_guide/ghc_config.py.in. LIBRARY_VERSION(base) LIBRARY_VERSION(Cabal, Cabal/Cabal/Cabal.cabal) -dnl template-haskell.cabal is generated later -dnl but the .in file already has the version +dnl template-haskell.cabal and ghc-prim.cabal are generated later +dnl by Hadrian but the .in files already have the version LIBRARY_VERSION(template-haskell, template-haskell/template-haskell.cabal.in) LIBRARY_VERSION(array) -LIBRARY_VERSION(ghc-prim) +LIBRARY_VERSION(ghc-prim, ghc-prim/ghc-prim.cabal.in) LIBRARY_VERSION(ghc-compact) LIBRARY_ghc_VERSION="$ProjectVersion" AC_SUBST(LIBRARY_ghc_VERSION) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc952a273a9d81af5f742afc52a9acb58fdcbb57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fc952a273a9d81af5f742afc52a9acb58fdcbb57 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 16:57:28 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 25 Jul 2023 12:57:28 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 27 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64bffef8e026d_2fb451b9a78206d5@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - a162252c by Apoorv Ingle at 2023-07-25T11:47:20-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - Aligning expand stmt context pushing on error stack. - Pop error context while checking do expansion generated GRHSs inside HsLam so that we do not print the previous statement error context - makes template haskell happy - some fix for let expansions - accepting new test output for some tests: Typeable1, hpc_fork, tough, tough2 etc. preserve the expansion stmts right until desugaring - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/074e777f3ca82a0e8506c66036778f6a8608ff05...a162252c7fb1426ceed815fa3e5657a83cf1f33a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/074e777f3ca82a0e8506c66036778f6a8608ff05...a162252c7fb1426ceed815fa3e5657a83cf1f33a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 16:58:13 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 12:58:13 -0400 Subject: [Git][ghc/ghc][ghc-9.8] linker/PEi386: Don't sign-extend symbol section number Message-ID: <64bfff25ac5ea_2fb451b9a50214fb@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 877ec97b by Ben Gamari at 2023-07-25T12:57:55-04:00 linker/PEi386: Don't sign-extend symbol section number Previously we incorrectly interpreted PE section numbers as signed values. However, this isn't the case; rather, it's an unsigned 16-bit number with a few special bit-patterns (0xffff and 0xfffe). This resulted in #22941 as the linker would conclude that the sections were invalid. Fixing this required quite a bit of refactoring. Closes #22941. - - - - - 2 changed files: - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== rts/linker/PEi386.c ===================================== @@ -697,8 +697,16 @@ size_t getSymbolSize ( COFF_HEADER_INFO *info ) } } +// Constants which may be returned by getSymSectionNumber. +// See https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#section-number-values +#define PE_SECTION_UNDEFINED ((uint32_t) 0) +#define PE_SECTION_ABSOLUTE ((uint32_t) -1) +#define PE_SECTION_DEBUG ((uint32_t) -2) + +// Returns either PE_SECTION_{UNDEFINED,ABSOLUTE,DEBUG} or the (one-based) +// section number of the given symbol. __attribute__ ((always_inline)) inline -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); @@ -707,7 +715,13 @@ int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) case COFF_ANON_BIG_OBJ: return sym->ex.SectionNumber; default: - return sym->og.SectionNumber; + // Take care to only sign-extend reserved values; see #22941. + switch (sym->og.SectionNumber) { + case IMAGE_SYM_UNDEFINED: return PE_SECTION_UNDEFINED; + case IMAGE_SYM_ABSOLUTE : return PE_SECTION_ABSOLUTE; + case IMAGE_SYM_DEBUG: return PE_SECTION_DEBUG; + default: return (uint16_t) sym->og.SectionNumber; + } } } @@ -1652,7 +1666,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) StgWord globalBssSize = 0; for (unsigned int i=0; i < info->numberOfSymbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - if (getSymSectionNumber (info, sym) == IMAGE_SYM_UNDEFINED + if (getSymSectionNumber (info, sym) == PE_SECTION_UNDEFINED && getSymValue (info, sym) > 0 && getSymStorageClass (info, sym) != IMAGE_SYM_CLASS_SECTION) { globalBssSize += getSymValue (info, sym); @@ -1685,21 +1699,39 @@ ocGetNames_PEi386 ( ObjectCode* oc ) for (unsigned int i = 0; i < (uint32_t)oc->n_symbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - int32_t secNumber = getSymSectionNumber (info, sym); uint32_t symValue = getSymValue (info, sym); uint8_t symStorageClass = getSymStorageClass (info, sym); - SymbolAddr *addr = NULL; bool isWeak = false; SymbolName *sname = get_sym_name (getSymShortName (info, sym), oc); - Section *section = secNumber > 0 ? &oc->sections[secNumber-1] : NULL; + + uint32_t secNumber = getSymSectionNumber (info, sym); + Section *section; + switch (secNumber) { + case PE_SECTION_UNDEFINED: + // N.B. This may be a weak symbol + section = NULL; + break; + case PE_SECTION_ABSOLUTE: + IF_DEBUG(linker, debugBelch("symbol %s is ABSOLUTE, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + case PE_SECTION_DEBUG: + IF_DEBUG(linker, debugBelch("symbol %s is DEBUG, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + default: + CHECK(secNumber < (uint32_t) oc->n_sections); + section = &oc->sections[secNumber-1]; + } SymType type; switch (getSymType(oc->info->ch_info, sym)) { case 0x00: type = SYM_TYPE_DATA; break; case 0x20: type = SYM_TYPE_CODE; break; default: - debugBelch("Invalid symbol type: 0x%x\n", getSymType(oc->info->ch_info, sym)); + debugBelch("Symbol %s has invalid type 0x%x\n", + sname, getSymType(oc->info->ch_info, sym)); return 1; } @@ -1730,8 +1762,18 @@ ocGetNames_PEi386 ( ObjectCode* oc ) CHECK(symValue == 0); COFF_symbol_aux_weak_external *aux = (COFF_symbol_aux_weak_external *) (sym+1); COFF_symbol* targetSym = &oc->info->symbols[aux->TagIndex]; - int32_t targetSecNumber = getSymSectionNumber (info, targetSym); - Section *targetSection = targetSecNumber > 0 ? &oc->sections[targetSecNumber-1] : NULL; + + uint32_t targetSecNumber = getSymSectionNumber (info, targetSym); + Section *targetSection; + switch (targetSecNumber) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + targetSection = NULL; + break; + default: + targetSection = &oc->sections[targetSecNumber-1]; + } addr = (SymbolAddr*) ((size_t) targetSection->start + getSymValue(info, targetSym)); } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { @@ -1850,6 +1892,9 @@ ocGetNames_PEi386 ( ObjectCode* oc ) return false; break; + } else if (secNumber == PE_SECTION_UNDEFINED) { + IF_DEBUG(linker, debugBelch("symbol %s is UNDEFINED, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); } if ((addr != NULL || isWeak) @@ -1976,7 +2021,19 @@ ocResolve_PEi386 ( ObjectCode* oc ) debugBelch("'\n" )); if (getSymStorageClass (info, sym) == IMAGE_SYM_CLASS_STATIC) { - Section section = oc->sections[getSymSectionNumber (info, sym)-1]; + uint32_t sect_n = getSymSectionNumber (info, sym); + switch (sect_n) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + errorBelch(" | %" PATH_FMT ": symbol `%s' has invalid section number %02x", + oc->fileName, symbol, sect_n); + return false; + default: + break; + } + CHECK(sect_n < (uint32_t) oc->n_sections); + Section section = oc->sections[sect_n - 1]; S = ((size_t)(section.start)) + ((size_t)(getSymValue (info, sym))); } else { ===================================== rts/linker/PEi386.h ===================================== @@ -143,7 +143,7 @@ struct _Alignments { COFF_OBJ_TYPE getObjectType ( char* image, pathchar* fileName ); COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc ); size_t getSymbolSize ( COFF_HEADER_INFO *info ); -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint32_t getSymValue ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymStorageClass ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymNumberOfAuxSymbols ( COFF_HEADER_INFO *info, COFF_symbol* sym ); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/877ec97b75b23f564eba544213ea822359c23d17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/877ec97b75b23f564eba544213ea822359c23d17 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 17:33:58 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 25 Jul 2023 13:33:58 -0400 Subject: [Git][ghc/ghc][wip/expand-do] some fixes after rebasing and doc changes Message-ID: <64c007864e8e8_2fb451b9ab428263@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: edfcfc2b by Apoorv Ingle at 2023-07-25T12:33:45-05:00 some fixes after rebasing and doc changes - - - - - 3 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Tc/Gen/Pat.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -462,9 +462,11 @@ type instance XXExpr GhcTc = XXExprGhcTc data XXExprGhcRn = ExpandedExpr - {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcRn)) + {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) -- Original source expression + (HsExpr GhcRn)) -- Expanded expression | ExpandedStmt - {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (HsExpr GhcRn)) + {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) -- Original source do statement with location + (HsExpr GhcRn)) -- Expanded expression | PopErrCtxt {-# UNPACK #-} !(LHsExpr GhcRn) -- Placeholder for identifying generated source locations in GhcRn phase @@ -479,15 +481,15 @@ mkPopErrCtxtExpr a = XExpr (PopErrCtxt a) -- and the two components of the expansion: original and -- desugared expressions. mkExpandedExpr - :: HsExpr GhcRn -- ^ source expression - -> HsExpr GhcRn -- ^ expanded expression - -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' + :: HsExpr GhcRn -- ^ source expression + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedExpr a b = XExpr (ExpandedExpr (HsExpanded a b)) mkExpandedStmt - :: ExprLStmt GhcRn -- ^ source statement + :: ExprLStmt GhcRn -- ^ source statement -> HsExpr GhcRn -- ^ expanded expression - -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' + -> HsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' mkExpandedStmt a b = XExpr (ExpandedStmt (HsExpanded a b)) data XXExprGhcTc @@ -495,10 +497,12 @@ data XXExprGhcTc {-# UNPACK #-} !(HsWrap HsExpr) | ExpansionExpr -- See Note [Rebindable syntax and HsExpansion] below - {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) (HsExpr GhcTc)) + {-# UNPACK #-} !(HsExpansion (HsExpr GhcRn) -- Original source expression + (HsExpr GhcTc)) -- Expanded expression typechecked - | ExpansionStmt -- See Note [Rebindable syntax and HsExpansion] below - {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) (HsExpr GhcTc)) + | ExpansionStmt -- See Note [Expanding HsDo with HsExpansion] below + {-# UNPACK #-} !(HsExpansion (ExprLStmt GhcRn) -- Original source do statement with location + (HsExpr GhcTc)) -- Expanded expression typechecked | ConLikeTc -- Result of typechecking a data-con -- See Note [Typechecking data constructors] in ===================================== compiler/GHC/Hs/Pat.hs ===================================== @@ -618,7 +618,7 @@ isSimplePat p = case unLoc p of _ -> Nothing -- | Is this pattern boring from the perspective of pattern-match checking, --- i.e. introduces no new pieces of long-dinstance information +-- i.e. introduces no new pieces of long-distance information -- which could influence pattern-match checking? -- -- See Note [Boring patterns]. ===================================== compiler/GHC/Tc/Gen/Pat.hs ===================================== @@ -1655,7 +1655,7 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs -- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on type checking --- does depend on the type environment however +-- It does depend on the type environment however as we need to check ConPat case in more detail isIrrefutableHsPatRn' :: TcGblEnv -> Bool -> LPat GhcRn -> TcM Bool isIrrefutableHsPatRn' tc_env is_strict pat = goL pat where @@ -1707,5 +1707,9 @@ isIrrefutableHsPatRn' tc_env is_strict pat = goL pat -- since we cannot know until the splice is evaluated. go (SplicePat {}) = return False + -- The behavior of this case is unimportant, as GHC will throw an error shortly + -- after reaching this case for other reasons (see TcRnIllegalTypePattern). + go (EmbTyPat {}) = return True + go (XPat ext) = case ext of HsPatExpanded _ pat -> go pat View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edfcfc2b8f952f4c5ef6dd13eac8ca299bedc8be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edfcfc2b8f952f4c5ef6dd13eac8ca299bedc8be You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 18:08:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 14:08:16 -0400 Subject: [Git][ghc/ghc][wip/T23726] 2 commits: nativeGen/AArch64: Fix sign extension in MulMayOflo Message-ID: <64c00f90254aa_2fb451b9aa0342fd@gitlab.mail> Ben Gamari pushed to branch wip/T23726 at Glasgow Haskell Compiler / GHC Commits: e995abb0 by Ben Gamari at 2023-07-25T13:07:10-04:00 nativeGen/AArch64: Fix sign extension in MulMayOflo When evaluating MulMayOflo of a product of sub-word-size operands, we must Fixes #23721. - - - - - 82ef316a by Ben Gamari at 2023-07-25T14:08:02-04:00 hihih - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1003,7 +1003,7 @@ getRegister' config plat expr -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register - do_mul_may_oflo w at W64 x y = do + do_mul_may_oflo W64 x y = do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y lo <- getNewRegNat II64 @@ -1015,31 +1015,44 @@ getRegister' config plat expr SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y) `snocOL` CMP (OpReg w hi) (OpRegShift w lo SASR 63) `snocOL` CSET (OpReg w dst) NE) + + do_mul_may_oflo W32 x y + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + tmp1 <- getNewRegNat II64 + tmp2 <- getNewRegNat II64 + return $ Any (intFormat w) (\dst -> + code_x `appOL` + code_y `snocOL` + SMULL (OpReg W64 tmp1) (OpReg W32 reg_x) (OpReg W32 reg_y) `snocOL` + ASR (OpReg W64 tmp2) (OpReg W64 tmp1) (OpImm (ImmInt 31)) `snocOL` + CMP (OpReg W32 tmp2) (OpRegShift W32 tmp1 SASR 31) `snocOL` + CSET (OpReg W32 dst) NE) + do_mul_may_oflo w x y = do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - let tmp_w = case w of - W32 -> W64 - W16 -> W32 - W8 -> W32 - _ -> panic "do_mul_may_oflo: impossible" - -- This will hold the product - tmp <- getNewRegNat (intFormat tmp_w) - let ext_mode = case w of - W32 -> ESXTW - W16 -> ESXTH - W8 -> ESXTB - _ -> panic "do_mul_may_oflo: impossible" - mul = case w of - W32 -> SMULL - W16 -> MUL - W8 -> MUL - _ -> panic "do_mul_may_oflo: impossible" + tmp1 <- getNewRegNat II32 + tmp2 <- getNewRegNat II32 + let extend dst arg = + case w of + W16 -> SXTH (OpReg W32 dst) (OpReg W32 arg) + W8 -> SXTB (OpReg W32 dst) (OpReg W32 arg) + width = widthInBits w + cmp_ext_mode = + case w of + W16 -> EUXTH + W8 -> EUXTB + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` - mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` + extend tmp1 reg_x `snocOL` + extend tmp2 reg_y `snocOL` + MUL (OpReg W32 tmp1) (OpReg W32 tmp1) (OpReg W32 tmp2) `snocOL` + SBFX (OpReg W64 tmp2) (OpReg W64 tmp1) (OpImm $ ImmInt $ width - 1) 1 `snocOL` + UBFM (OpReg W64 tmp1) (OpReg W64 tmp1) (OpImm $ ImmInt width) (OpImm $ ImmInt width) `snocOL` + CMP (OpReg W32 tmp1) (OpRegExt W32 tmp2 cmp_ext_mode 0) `snocOL` CSET (OpReg w dst) NE) -- | Is a given number encodable as a bitmask immediate? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc952a273a9d81af5f742afc52a9acb58fdcbb57...82ef316a107c0618cfd6870a880eaf0f860e6f64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc952a273a9d81af5f742afc52a9acb58fdcbb57...82ef316a107c0618cfd6870a880eaf0f860e6f64 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 19:31:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 15:31:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23721 Message-ID: <64c0230689ed2_2fb451b9aa042714@gitlab.mail> Ben Gamari pushed new branch wip/T23721 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23721 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 19:31:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 25 Jul 2023 15:31:39 -0400 Subject: [Git][ghc/ghc][wip/T23721] nativeGen/AArch64: Fix sign extension in MulMayOflo Message-ID: <64c0231b9ada3_2fb451b9a64429d3@gitlab.mail> Ben Gamari pushed to branch wip/T23721 at Glasgow Haskell Compiler / GHC Commits: d3550730 by Ben Gamari at 2023-07-25T15:31:12-04:00 nativeGen/AArch64: Fix sign extension in MulMayOflo Previously the 32-bit implementations of MulMayOflo would use the a non-sensical sign-extension mode. Rewrite these to reflect what gcc 11 produces. Also similarly rework the 16- and 8-bit cases. This now passes the MulMayOflo tests in ghc/test-primops> in all four widths. Fixes #23721. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1015,31 +1015,47 @@ getRegister' config plat expr SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y) `snocOL` CMP (OpReg w hi) (OpRegShift w lo SASR 63) `snocOL` CSET (OpReg w dst) NE) + + do_mul_may_oflo W32 x y = do + (reg_x, _format_x, code_x) <- getSomeReg x + (reg_y, _format_y, code_y) <- getSomeReg y + tmp1 <- getNewRegNat II64 + tmp2 <- getNewRegNat II64 + return $ Any (intFormat W32) (\dst -> + code_x `appOL` + code_y `snocOL` + SMULL (OpReg W64 tmp1) (OpReg W32 reg_x) (OpReg W32 reg_y) `snocOL` + ASR (OpReg W64 tmp2) (OpReg W64 tmp1) (OpImm (ImmInt 31)) `snocOL` + CMP (OpReg W32 tmp2) (OpRegShift W32 tmp1 SASR 31) `snocOL` + CSET (OpReg W32 dst) NE) + do_mul_may_oflo w x y = do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - let tmp_w = case w of - W32 -> W64 - W16 -> W32 - W8 -> W32 - _ -> panic "do_mul_may_oflo: impossible" - -- This will hold the product - tmp <- getNewRegNat (intFormat tmp_w) - let ext_mode = case w of - W32 -> ESXTW - W16 -> ESXTH - W8 -> ESXTB - _ -> panic "do_mul_may_oflo: impossible" - mul = case w of - W32 -> SMULL - W16 -> MUL - W8 -> MUL - _ -> panic "do_mul_may_oflo: impossible" + tmp1 <- getNewRegNat II32 + tmp2 <- getNewRegNat II32 + let extend dst arg = + case w of + W16 -> SXTH (OpReg W32 dst) (OpReg W32 arg) + W8 -> SXTB (OpReg W32 dst) (OpReg W32 arg) + _ -> panic "unreachable" + cmp_ext_mode = + case w of + W16 -> EUXTH + W8 -> EUXTB + _ -> panic "unreachable" + width = widthInBits w + opInt = OpImm . ImmInt + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` - mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CMP (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) `snocOL` + extend tmp1 reg_x `snocOL` + extend tmp2 reg_y `snocOL` + MUL (OpReg W32 tmp1) (OpReg W32 tmp1) (OpReg W32 tmp2) `snocOL` + SBFX (OpReg W64 tmp2) (OpReg W64 tmp1) (opInt $ width - 1) (opInt 1) `snocOL` + LSR (OpReg W32 tmp1) (OpReg W32 tmp1) (opInt width) `snocOL` + CMP (OpReg W32 tmp1) (OpRegExt W32 tmp2 cmp_ext_mode 0) `snocOL` CSET (OpReg w dst) NE) -- | Is a given number encodable as a bitmask immediate? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d35507303af1d19a62fceb04ec87c2f54c1a3919 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d35507303af1d19a62fceb04ec87c2f54c1a3919 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 20:09:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 25 Jul 2023 16:09:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c02bfe82344_2fb451b9a7858044@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 27b30cf0 by Alan Zimmerman at 2023-07-25T16:08:59-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 2dc412fa by Krzysztof Gogolewski at 2023-07-25T16:08:59-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - affdbcbb by Rodrigo Mesquita at 2023-07-25T16:08:59-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - cee00306 by Naïm Favier at 2023-07-25T16:09:02-04:00 docs: Fix typo - - - - - 4 changed files: - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Parser.y - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - m4/prep_target_file.m4 Changes: ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -181,6 +181,9 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease +genCall (PrimTarget MO_Touch) _ _ = + return (nilOL, []) + genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,7 +1026,7 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> @@ -1034,7 +1034,7 @@ export :: { OrdList (LIE GhcPs) } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> - in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } + in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } : '{-# DEPRECATED' strings '#-}' @@ -1079,7 +1079,7 @@ qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } qcname_ext :: { LocatedA ImpExpQcSpec } : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 - ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} + ; return $ sLLa $1 $> (ImpExpQcType (glAA $1) n) }} qcname :: { LocatedN RdrName } -- Variable or type constructor : qvar { $1 } -- Things which look like functions @@ -1134,7 +1134,7 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $ + ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 @@ -1211,7 +1211,7 @@ importlist1 :: { OrdList (LIE GhcPs) } import :: { OrdList (LIE GhcPs) } : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1314,7 +1314,7 @@ ty_decl :: { LTyClDecl GhcPs } where_type_family -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkFamDecl (comb5 $1 (reLoc $3) $4 $5 $6) (snd $ unLoc $6) TopLevel $3 + {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3 (snd $ unLoc $4) (snd $ unLoc $5) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4) ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) } @@ -1576,13 +1576,13 @@ opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} @@ -1592,7 +1592,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] - , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } + , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, -- which takes the form @@ -2128,7 +2128,7 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } sigktype :: { LHsSigType GhcPs } : sigtype { $1 } | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + sLLa $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2172,7 +2172,7 @@ ktype :: { LHsType GhcPs } -- A ctype is a for-all type ctype :: { LHsType GhcPs } - : forall_telescope ctype { reLocA $ sLL $1 (reLoc $>) $ + : forall_telescope ctype { sLLa $1 $> $ HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } @@ -2305,13 +2305,13 @@ atype :: { LHsType GhcPs } -- so you have to quote those.) | '[' ktype ',' comma_types1 ']' {% do { h <- addTrailingCommaA $2 (gl $3) ; acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mos $1,mcs $5] cs) NotPromoted (h:$4)) }} - | INTEGER { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) + | INTEGER { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) (il_value (getINTEGER $1)) } - | CHAR { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) + | CHAR { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) (getCHAR $1) } - | STRING { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) + | STRING { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) (getSTRING $1) } - | '_' { reLocA $ sL1 $1 $ mkAnonWildCardTy } + | '_' { sL1a $1 $ mkAnonWildCardTy } -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer. -- We let it pass the parser because the renamer can generate a better error message. | QVARID {% let qname = mkQual tvName (getQVARID $1) @@ -2470,8 +2470,8 @@ constrs1 :: { Located [LConDecl GhcPs] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff {% acsA (\cs -> let (con,details) = unLoc $4 in - (L (comb4 $1 (reLoc $2) $3 $4) (mkConDeclH98 - (EpAnn (spanAsAnchor (comb4 $1 (reLoc $2) $3 $4)) + (L (comb4 $1 $2 $3 $4) (mkConDeclH98 + (EpAnn (spanAsAnchor (comb4 $1 $2 $3 $4)) (mu AnnDarrow $3:(fst $ unLoc $1)) cs) con (snd $ unLoc $1) @@ -2763,7 +2763,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (sLLa $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2877,8 +2877,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLL $1 $> - [reLocA $ sLL $1 $> + (sLLa $1 $> + [sLLa $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2934,7 +2934,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -2951,7 +2951,7 @@ aexp1 :: { ECP } | aexp1 TIGHT_INFIX_PROJ field {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> - let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in + let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } @@ -3037,8 +3037,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3062,7 +3062,7 @@ cmdargs :: { [LHsCmdTop GhcPs] } acmd :: { LHsCmdTop GhcPs } : aexp {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) -> runPV (checkCmdBlockArguments cmd) >>= \ _ -> - return (sL1a (reLoc cmd) $ HsCmdTop noExtField cmd) } + return (sL1a cmd $ HsCmdTop noExtField cmd) } cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 @@ -3098,7 +3098,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } + sLLa $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3350,7 +3350,7 @@ ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> - return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } + return $ sLL gdpats gdpat (gdpat : unLoc gdpats) } | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to @@ -3517,7 +3517,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3562,11 +3562,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } + ; return (sLLa $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLL (head $1) (last $1) (And ($1)) } + { sLLa (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -4099,15 +4099,15 @@ comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` combineSrcSpans (getHasLoc a) (combineHasLocs b c) -comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan +comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) (getLoc d)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) (getHasLoc d)) -comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ combineSrcSpans (getHasLoc d) (getHasLoc e)) -- strict constructor version: {-# INLINE sL #-} @@ -4138,7 +4138,7 @@ sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} -sLLa :: Located a -> Located b -> c -> LocatedAn t c +sLLa :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -687,7 +687,7 @@ instance heads which unify with @nm tys@, they need not actually be satisfiable. @B@ themselves implement 'Eq' - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available - instance of 'Eq' + instance of 'Show' There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given). ===================================== m4/prep_target_file.m4 ===================================== @@ -58,7 +58,8 @@ AC_DEFUN([PREP_BOOLEAN],[ $1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + $1Bool=False ;; esac AC_SUBST([$1Bool]) @@ -78,7 +79,8 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ Not$1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + Not$1Bool=False ;; esac AC_SUBST([Not$1Bool]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98a6e305890c9cdc1b8d3481d15735ec1883c817...cee00306344746d2c6a74cc791dc43828331f365 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/98a6e305890c9cdc1b8d3481d15735ec1883c817...cee00306344746d2c6a74cc791dc43828331f365 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Jul 25 22:08:38 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 25 Jul 2023 18:08:38 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 5 commits: Fixes #18324 #23147 #20020 Message-ID: <64c047e6b8db7_2fb451b9a8c7833a@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: b4ace9bb by Apoorv Ingle at 2023-07-25T12:36:55-05:00 Fixes #18324 #23147 #20020 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - Aligning expand stmt context pushing on error stack. - Pop error context while checking do expansion generated GRHSs inside HsLam so that we do not print the previous statement error context - makes template haskell happy - some fix for let expansions - accepting new test output for some tests: Typeable1, hpc_fork, tough, tough2 etc. preserve the expansion stmts right until desugaring - - - - - b6df469e by Apoorv Ingle at 2023-07-25T12:39:37-05:00 some fixes after rebasing and doc changes - - - - - 879ca05f by Apoorv Ingle at 2023-07-25T13:26:25-05:00 Fixes #22788 #15598 #22086. Added testcases for each - - - - - 78a54d25 by Apoorv Ingle at 2023-07-25T15:23:14-05:00 fix the body statement error context - - - - - ae14cf96 by Apoorv Ingle at 2023-07-25T17:04:35-05:00 fix warnings for non-exhausitive patterns location blame and discarded values in do block statements - - - - - 30 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Zonk/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/edfcfc2b8f952f4c5ef6dd13eac8ca299bedc8be...ae14cf9631538c2c89bc0d4cf96ee6e09e0c1a82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/edfcfc2b8f952f4c5ef6dd13eac8ca299bedc8be...ae14cf9631538c2c89bc0d4cf96ee6e09e0c1a82 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 01:50:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 25 Jul 2023 21:50:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c07bf5e668f_2fb451b9a8c125411@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cfd285b1 by Alan Zimmerman at 2023-07-25T21:49:51-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - d8daa365 by Gavin Zhao at 2023-07-25T21:49:56-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 4cce0fce by Krzysztof Gogolewski at 2023-07-25T21:49:57-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 433bcbd9 by Rodrigo Mesquita at 2023-07-25T21:49:57-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - 354e0f56 by Naïm Favier at 2023-07-25T21:50:00-04:00 docs: Fix typo - - - - - 6 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Parser.y - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - m4/prep_target_file.m4 Changes: ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -170,7 +170,7 @@ nativeCodeGen logger ts config modLoc h us cmms ArchLoongArch64->panic "nativeCodeGen: No NCG for LoongArch64" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" - ArchWasm32 -> Wasm32.ncgWasm platform ts us modLoc h cmms + ArchWasm32 -> Wasm32.ncgWasm logger platform ts us modLoc h cmms -- | Data accumulated during code generation. Mostly about statistics, -- but also collects debug data for DWARF generation. ===================================== compiler/GHC/CmmToAsm/Wasm.hs ===================================== @@ -5,6 +5,7 @@ module GHC.CmmToAsm.Wasm (ncgWasm) where import Data.ByteString.Builder +import Data.ByteString.Lazy.Char8 (unpack) import Data.Maybe import Data.Semigroup import GHC.Cmm @@ -12,15 +13,18 @@ import GHC.CmmToAsm.Wasm.Asm import GHC.CmmToAsm.Wasm.FromCmm import GHC.CmmToAsm.Wasm.Types import GHC.Data.Stream (Stream, StreamS (..), runStream) +import GHC.Driver.DynFlags import GHC.Platform import GHC.Prelude import GHC.Settings import GHC.Types.Unique.Supply import GHC.Unit -import GHC.Utils.CliOption +import GHC.Utils.Logger +import GHC.Utils.Outputable (text) import System.IO ncgWasm :: + Logger -> Platform -> ToolSettings -> UniqSupply -> @@ -28,15 +32,24 @@ ncgWasm :: Handle -> Stream IO RawCmmGroup a -> IO a -ncgWasm platform ts us loc h cmms = do +ncgWasm logger platform ts us loc h cmms = do (r, s) <- streamCmmGroups platform us cmms - hPutBuilder h $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" - hPutBuilder h $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s + outputWasm $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" + outputWasm $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s pure r where -- See Note [WasmTailCall] do_tail_call = doTailCall ts + outputWasm builder = do + putDumpFileMaybe + logger + Opt_D_dump_asm + "Asm Code" + FormatASM + (text . unpack $ toLazyByteString builder) + hPutBuilder h builder + streamCmmGroups :: Platform -> UniqSupply -> ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -181,6 +181,9 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease +genCall (PrimTarget MO_Touch) _ _ = + return (nilOL, []) + genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,7 +1026,7 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> @@ -1034,7 +1034,7 @@ export :: { OrdList (LIE GhcPs) } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> - in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } + in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } : '{-# DEPRECATED' strings '#-}' @@ -1079,7 +1079,7 @@ qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } qcname_ext :: { LocatedA ImpExpQcSpec } : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 - ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} + ; return $ sLLa $1 $> (ImpExpQcType (glAA $1) n) }} qcname :: { LocatedN RdrName } -- Variable or type constructor : qvar { $1 } -- Things which look like functions @@ -1134,7 +1134,7 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $ + ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 @@ -1211,7 +1211,7 @@ importlist1 :: { OrdList (LIE GhcPs) } import :: { OrdList (LIE GhcPs) } : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1314,7 +1314,7 @@ ty_decl :: { LTyClDecl GhcPs } where_type_family -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkFamDecl (comb5 $1 (reLoc $3) $4 $5 $6) (snd $ unLoc $6) TopLevel $3 + {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3 (snd $ unLoc $4) (snd $ unLoc $5) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4) ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) } @@ -1576,13 +1576,13 @@ opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} @@ -1592,7 +1592,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] - , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } + , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, -- which takes the form @@ -2128,7 +2128,7 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } sigktype :: { LHsSigType GhcPs } : sigtype { $1 } | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + sLLa $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2172,7 +2172,7 @@ ktype :: { LHsType GhcPs } -- A ctype is a for-all type ctype :: { LHsType GhcPs } - : forall_telescope ctype { reLocA $ sLL $1 (reLoc $>) $ + : forall_telescope ctype { sLLa $1 $> $ HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } @@ -2305,13 +2305,13 @@ atype :: { LHsType GhcPs } -- so you have to quote those.) | '[' ktype ',' comma_types1 ']' {% do { h <- addTrailingCommaA $2 (gl $3) ; acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mos $1,mcs $5] cs) NotPromoted (h:$4)) }} - | INTEGER { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) + | INTEGER { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) (il_value (getINTEGER $1)) } - | CHAR { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) + | CHAR { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) (getCHAR $1) } - | STRING { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) + | STRING { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) (getSTRING $1) } - | '_' { reLocA $ sL1 $1 $ mkAnonWildCardTy } + | '_' { sL1a $1 $ mkAnonWildCardTy } -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer. -- We let it pass the parser because the renamer can generate a better error message. | QVARID {% let qname = mkQual tvName (getQVARID $1) @@ -2470,8 +2470,8 @@ constrs1 :: { Located [LConDecl GhcPs] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff {% acsA (\cs -> let (con,details) = unLoc $4 in - (L (comb4 $1 (reLoc $2) $3 $4) (mkConDeclH98 - (EpAnn (spanAsAnchor (comb4 $1 (reLoc $2) $3 $4)) + (L (comb4 $1 $2 $3 $4) (mkConDeclH98 + (EpAnn (spanAsAnchor (comb4 $1 $2 $3 $4)) (mu AnnDarrow $3:(fst $ unLoc $1)) cs) con (snd $ unLoc $1) @@ -2763,7 +2763,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (sLLa $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2877,8 +2877,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLL $1 $> - [reLocA $ sLL $1 $> + (sLLa $1 $> + [sLLa $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2934,7 +2934,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -2951,7 +2951,7 @@ aexp1 :: { ECP } | aexp1 TIGHT_INFIX_PROJ field {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> - let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in + let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } @@ -3037,8 +3037,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3062,7 +3062,7 @@ cmdargs :: { [LHsCmdTop GhcPs] } acmd :: { LHsCmdTop GhcPs } : aexp {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) -> runPV (checkCmdBlockArguments cmd) >>= \ _ -> - return (sL1a (reLoc cmd) $ HsCmdTop noExtField cmd) } + return (sL1a cmd $ HsCmdTop noExtField cmd) } cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 @@ -3098,7 +3098,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } + sLLa $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3350,7 +3350,7 @@ ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> - return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } + return $ sLL gdpats gdpat (gdpat : unLoc gdpats) } | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to @@ -3517,7 +3517,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3562,11 +3562,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } + ; return (sLLa $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLL (head $1) (last $1) (And ($1)) } + { sLLa (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -4099,15 +4099,15 @@ comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` combineSrcSpans (getHasLoc a) (combineHasLocs b c) -comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan +comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) (getLoc d)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) (getHasLoc d)) -comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ combineSrcSpans (getHasLoc d) (getHasLoc e)) -- strict constructor version: {-# INLINE sL #-} @@ -4138,7 +4138,7 @@ sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} -sLLa :: Located a -> Located b -> c -> LocatedAn t c +sLLa :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -687,7 +687,7 @@ instance heads which unify with @nm tys@, they need not actually be satisfiable. @B@ themselves implement 'Eq' - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available - instance of 'Eq' + instance of 'Show' There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given). ===================================== m4/prep_target_file.m4 ===================================== @@ -58,7 +58,8 @@ AC_DEFUN([PREP_BOOLEAN],[ $1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + $1Bool=False ;; esac AC_SUBST([$1Bool]) @@ -78,7 +79,8 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ Not$1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + Not$1Bool=False ;; esac AC_SUBST([Not$1Bool]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cee00306344746d2c6a74cc791dc43828331f365...354e0f563d1e51d24eb3a47be69ff17f9a15838a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cee00306344746d2c6a74cc791dc43828331f365...354e0f563d1e51d24eb3a47be69ff17f9a15838a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 06:11:36 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?SmFrb2IgQnLDvG5rZXIgKEBKYWtvYkJydWVua2VyKQ==?=) Date: Wed, 26 Jul 2023 02:11:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/jbruenker/foreach Message-ID: <64c0b91884496_2fb451b9a3c16532a@gitlab.mail> Jakob Brünker pushed new branch wip/jbruenker/foreach at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/jbruenker/foreach You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 06:54:49 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 26 Jul 2023 02:54:49 -0400 Subject: [Git][ghc/ghc][wip/T22404] Add test T22404 Message-ID: <64c0c33970b3e_2fb451b9a78170812@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 7bc65cd6 by Simon Peyton Jones at 2023-07-26T07:54:31+01:00 Add test T22404 - - - - - 3 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - + testsuite/tests/simplCore/should_compile/T22404.hs - + testsuite/tests/simplCore/should_compile/T22404.stderr Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -621,14 +621,25 @@ like to inline `v1 in just the same way as in (P1). But if we "andUDs" the usage from j's RHS and its body, we'll get ManyOccs for `v`. Important optimisation lost! +Solving this problem makes the Simplifier less fragile. For example, +the Simplifier might inline `j`, and convert (P2) into (P1)... or it might +not, depending in a perhaps-fragile way on the size of the join point. +I was motivated to implement this feature of the occurrence analyser +when trying to make optimisation join points simpler and more robust +(see # + The occurrence analyser therefore has clever code that behaves just as -if you inlined `j` at all its call sites. Here is a tricky variant (P3) +if you inlined `j` at all its call sites. Here is a tricky variant to keep in mind: + + Program (P3) + ------------------------------- join j = case v of (a,b) -> a in case f v of A -> j B -> j C -> [] + If you mentally inline `j` you'll see that `v` is used twice on the path through A, so it should have ManyOcc. Bear this caes in mind! @@ -638,7 +649,7 @@ through A, so it should have ManyOcc. Bear this caes in mind! that we discover for the first time in this sweep of the occurrence analyser. -* In occ_env, the new (occ_join_points :: IdEnv UsageDetails) maps +* In occ_env, the new (occ_join_points :: IdEnv OccInfoEnv) maps each in-scope non-recursive join point, such as `j` above, to a "zeroed form" of its RHS's usage details. The "zeroed form" * deletes ManyOccs @@ -689,11 +700,13 @@ There are a couple of tricky wrinkles UsageDetails mentions `v`. Instead, just `andUDs` all that usage in right here. - This is done by `add_bad_joins`` in `addInScope`; we use - `partitionVarEnv` to identify the `bad_joins` (the ones whose - UsageDetails mention the newly bound variables); then for any of /those/ - that are /actually mentioned/ in the body, use `andUDs` to add their - UsageDetails to the returned UsageDetails. Tricky! + This requires work in two places. + * In `preprocess_env`, we detect if the newly-bound variables intersect + the free vars of occ_join_points. (These free vars are conveniently + simply the domain of the OccInfoEnv for that join point.) If so, + we zap the entire occ_join_points. + * In `postprcess_uds`, we add the chucked-out join points to the + returned UsageDetails, with `andUDs`. (W3) Consider this example, which shadows `j`, but this time in an argument join j = rhs @@ -701,7 +714,7 @@ There are a couple of tricky wrinkles We can zap the entire occ_join_points when looking at the argument, because `j` can't posibly occur -- it's a join point! And the smaller occ_join_points is, the better. Smaller to look up in mkOneOcc, and - more important, less looking-up when partitioning in (W2), in addInScope. + more important, less looking-up when checking (W2). This is done in setNonTailCtxt. It's important /not/ to do this for join-point RHS's because of course `j` can occur there! @@ -971,33 +984,6 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine (combine [NonRec (tagNonRecBinder lvl occ bndr') rhs'] body) -{- - -- Fast path for top level, non-recursive bindings, with no rules - -- This is a very common case. Semantically though, you can delete this - -- entire equation and fall through to the general case - -- Fast path: - -- * Top level so cannot be a join point - -- * Top level so no binder swap, so no need to update unfolding - -- * No rules so no faffing with them - | TopLevel <- lvl - , not (idHasRules bndr || (bndr `elemVarEnv` ire)) - = let !(WUD body_uds (tagged_bndr, body)) = occAnalNonRecBody env bndr thing_inside - in if isDeadBinder tagged_bndr -- Drop dead code; see Note [Dead code] - then WUD body_uds body - else let - unf = idUnfolding bndr - rhs_env = addOneShotsFromDmd bndr $ - setNonTailCtxt (mkNonRecRhsCtxt tagged_bndr unf) env - !rhs_wuds@(WTUD _ rhs') = occAnalLamTail rhs_env rhs - !(WTUD (TUD _ unf_uds) _) = occAnalUnfolding rhs_env unf - rhs_uds = adjustTailUsage Nothing rhs_wuds - full_rhs_uds | isStableUnfolding unf = rhs_uds `andUDs` markAllNonTail unf_uds - | otherwise = rhs_uds - - in WUD (full_rhs_uds `andUDs` body_uds) -- Note `andUDs` - (combine [NonRec tagged_bndr rhs'] body) --} - -- The normal case, including newly-discovered join points -- Analyse the body and /then/ the RHS | otherwise @@ -1032,8 +1018,10 @@ occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity -> Id -> CoreExpr -> ([UsageDetails], Id, CoreExpr) occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs - | null rules, null imp_rule_infos -- Fast path for common case - = ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs ) + | null rules, null imp_rule_infos + = -- Fast path for common case of no rules. This is only worth + -- 0.1% perf on average, but it's also only a line or two of code + ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs ) | otherwise = (adj_rhs_uds : adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs ) where @@ -1088,8 +1076,6 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs [ l `andUDs` adjustTailArity mb_join r | (_,l,r) <- rules_w_uds ] - - ---------- mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl mkNonRecRhsCtxt bndr unf | certainly_inline = OccVanilla -- See Note [Cascading inlines] ===================================== testsuite/tests/simplCore/should_compile/T22404.hs ===================================== @@ -0,0 +1,28 @@ +module T22404 where + +{-# NOINLINE foo #-} +foo :: [a] -> (a,a) +foo [x,y] = (x,y) +foo (x:xs) = foo xs + +data T = A | B | C | D + +-- The point of this test is that 'v' ought +-- not to be a thunk in the optimised program +-- It is used only once in each branch. But we +-- need a clever occurrence analyser to spot it; +-- see Note [Occurrence analysis for join points] +-- in GHC.Core.Opt.OccurAnoa + +f x xs = let v = foo xs in + + let {-# NOINLINE j #-} + j True = case v of (a,b) -> a + j False = case v of (a,b) -> b + in + + case x of + A -> j True + B -> j False + C -> case v of (a,b) -> b + D -> x ===================================== testsuite/tests/simplCore/should_compile/T22404.stderr ===================================== View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bc65cd604496451bf3c4190e260fbfd55e9d10b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bc65cd604496451bf3c4190e260fbfd55e9d10b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 06:56:02 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 26 Jul 2023 02:56:02 -0400 Subject: [Git][ghc/ghc][wip/T22404] Add all.T file Message-ID: <64c0c382ce15a_2fb451b9ab417135a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 48f5afa3 by Simon Peyton Jones at 2023-07-26T07:55:39+01:00 Add all.T file - - - - - 1 changed file: - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -492,3 +492,6 @@ test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], m test('T23074', normal, compile, ['-O -ddump-rules']) test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0']) + +# The -ddump-simpl of T22404 should have no let-bindings +test('T22404', [only_ways(['optasm']), check_errmsg(r'let') ], compile, ['-ddump-simpl -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f5afa3cdaff3211fc30ff1fdee37e38e3428ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f5afa3cdaff3211fc30ff1fdee37e38e3428ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 09:27:38 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 26 Jul 2023 05:27:38 -0400 Subject: [Git][ghc/ghc][wip/T22404] 4 commits: Fix pretty printing of WARNING pragmas Message-ID: <64c0e70aad06b_2fb451b9a281988e0@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 6ae42f56 by Simon Peyton Jones at 2023-07-26T10:27:25+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 1% CoOpt_Read(normal) ghc/alloc 766,003,076 748,985,544 -2.2% GOOD T10858(normal) ghc/alloc 120,782,748 118,735,744 -1.7% T11545(normal) ghc/alloc 79,829,332 78,722,128 -1.4% T12150(optasm) ghc/alloc 73,881,192 72,854,208 -1.4% T13056(optasm) ghc/alloc 294,495,436 290,226,600 -1.4% T13253(normal) ghc/alloc 364,663,144 361,043,432 -1.0% T13253-spj(normal) ghc/alloc 118,248,796 59,996,856 -49.3% GOOD T15164(normal) ghc/alloc 1,102,607,920 1,087,375,984 -1.4% T15304(normal) ghc/alloc 1,196,061,524 1,155,296,336 -3.4% T15630(normal) ghc/alloc 148,707,300 147,104,768 -1.1% T17516(normal) ghc/alloc 1,657,993,132 1,626,735,192 -1.9% T17836(normal) ghc/alloc 395,306,932 391,219,640 -1.0% T18140(normal) ghc/alloc 71,948,496 73,206,920 +1.7% T18282(normal) ghc/alloc 129,090,864 131,483,440 +1.9% T18698b(normal) ghc/alloc 230,313,396 233,017,416 +1.2% BAD T4801(normal) ghc/alloc 247,568,452 250,836,624 +1.3% T9233(normal) ghc/alloc 709,634,020 685,363,720 -3.4% GOOD T9630(normal) ghc/alloc 965,838,132 942,010,984 -2.5% GOOD T9675(optasm) ghc/alloc 444,583,940 429,417,416 -3.4% GOOD T9961(normal) ghc/alloc 303,041,544 307,384,192 +1.4% BAD WWRec(normal) ghc/alloc 503,706,372 495,554,224 -1.6% geo. mean -1.0% minimum -49.3% maximum +1.9% The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 Metric Increase: T18698b T9961 - - - - - 13 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Unit/Module/Warnings.hs - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48f5afa3cdaff3211fc30ff1fdee37e38e3428ca...6ae42f562de3dbc5d80e1323523bfd83f317ad6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48f5afa3cdaff3211fc30ff1fdee37e38e3428ca...6ae42f562de3dbc5d80e1323523bfd83f317ad6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 09:57:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 05:57:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c0ee0a7badc_2fb451b9adc222965@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 356217ad by Alan Zimmerman at 2023-07-26T05:57:15-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 99ce67de by Gavin Zhao at 2023-07-26T05:57:19-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - e67c07de by Krzysztof Gogolewski at 2023-07-26T05:57:19-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 46b94728 by Rodrigo Mesquita at 2023-07-26T05:57:19-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - a96933f7 by Naïm Favier at 2023-07-26T05:57:22-04:00 docs: Fix typo - - - - - 6 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Parser.y - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - m4/prep_target_file.m4 Changes: ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -170,7 +170,7 @@ nativeCodeGen logger ts config modLoc h us cmms ArchLoongArch64->panic "nativeCodeGen: No NCG for LoongArch64" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" - ArchWasm32 -> Wasm32.ncgWasm platform ts us modLoc h cmms + ArchWasm32 -> Wasm32.ncgWasm logger platform ts us modLoc h cmms -- | Data accumulated during code generation. Mostly about statistics, -- but also collects debug data for DWARF generation. ===================================== compiler/GHC/CmmToAsm/Wasm.hs ===================================== @@ -5,6 +5,7 @@ module GHC.CmmToAsm.Wasm (ncgWasm) where import Data.ByteString.Builder +import Data.ByteString.Lazy.Char8 (unpack) import Data.Maybe import Data.Semigroup import GHC.Cmm @@ -12,15 +13,18 @@ import GHC.CmmToAsm.Wasm.Asm import GHC.CmmToAsm.Wasm.FromCmm import GHC.CmmToAsm.Wasm.Types import GHC.Data.Stream (Stream, StreamS (..), runStream) +import GHC.Driver.DynFlags import GHC.Platform import GHC.Prelude import GHC.Settings import GHC.Types.Unique.Supply import GHC.Unit -import GHC.Utils.CliOption +import GHC.Utils.Logger +import GHC.Utils.Outputable (text) import System.IO ncgWasm :: + Logger -> Platform -> ToolSettings -> UniqSupply -> @@ -28,15 +32,24 @@ ncgWasm :: Handle -> Stream IO RawCmmGroup a -> IO a -ncgWasm platform ts us loc h cmms = do +ncgWasm logger platform ts us loc h cmms = do (r, s) <- streamCmmGroups platform us cmms - hPutBuilder h $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" - hPutBuilder h $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s + outputWasm $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" + outputWasm $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s pure r where -- See Note [WasmTailCall] do_tail_call = doTailCall ts + outputWasm builder = do + putDumpFileMaybe + logger + Opt_D_dump_asm + "Asm Code" + FormatASM + (text . unpack $ toLazyByteString builder) + hPutBuilder h builder + streamCmmGroups :: Platform -> UniqSupply -> ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -181,6 +181,9 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease +genCall (PrimTarget MO_Touch) _ _ = + return (nilOL, []) + genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,7 +1026,7 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> @@ -1034,7 +1034,7 @@ export :: { OrdList (LIE GhcPs) } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> - in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } + in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } : '{-# DEPRECATED' strings '#-}' @@ -1079,7 +1079,7 @@ qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } qcname_ext :: { LocatedA ImpExpQcSpec } : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 - ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} + ; return $ sLLa $1 $> (ImpExpQcType (glAA $1) n) }} qcname :: { LocatedN RdrName } -- Variable or type constructor : qvar { $1 } -- Things which look like functions @@ -1134,7 +1134,7 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $ + ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 @@ -1211,7 +1211,7 @@ importlist1 :: { OrdList (LIE GhcPs) } import :: { OrdList (LIE GhcPs) } : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1314,7 +1314,7 @@ ty_decl :: { LTyClDecl GhcPs } where_type_family -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkFamDecl (comb5 $1 (reLoc $3) $4 $5 $6) (snd $ unLoc $6) TopLevel $3 + {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3 (snd $ unLoc $4) (snd $ unLoc $5) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4) ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) } @@ -1576,13 +1576,13 @@ opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} @@ -1592,7 +1592,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] - , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } + , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, -- which takes the form @@ -2128,7 +2128,7 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } sigktype :: { LHsSigType GhcPs } : sigtype { $1 } | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + sLLa $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2172,7 +2172,7 @@ ktype :: { LHsType GhcPs } -- A ctype is a for-all type ctype :: { LHsType GhcPs } - : forall_telescope ctype { reLocA $ sLL $1 (reLoc $>) $ + : forall_telescope ctype { sLLa $1 $> $ HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } @@ -2305,13 +2305,13 @@ atype :: { LHsType GhcPs } -- so you have to quote those.) | '[' ktype ',' comma_types1 ']' {% do { h <- addTrailingCommaA $2 (gl $3) ; acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mos $1,mcs $5] cs) NotPromoted (h:$4)) }} - | INTEGER { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) + | INTEGER { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) (il_value (getINTEGER $1)) } - | CHAR { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) + | CHAR { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) (getCHAR $1) } - | STRING { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) + | STRING { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) (getSTRING $1) } - | '_' { reLocA $ sL1 $1 $ mkAnonWildCardTy } + | '_' { sL1a $1 $ mkAnonWildCardTy } -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer. -- We let it pass the parser because the renamer can generate a better error message. | QVARID {% let qname = mkQual tvName (getQVARID $1) @@ -2470,8 +2470,8 @@ constrs1 :: { Located [LConDecl GhcPs] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff {% acsA (\cs -> let (con,details) = unLoc $4 in - (L (comb4 $1 (reLoc $2) $3 $4) (mkConDeclH98 - (EpAnn (spanAsAnchor (comb4 $1 (reLoc $2) $3 $4)) + (L (comb4 $1 $2 $3 $4) (mkConDeclH98 + (EpAnn (spanAsAnchor (comb4 $1 $2 $3 $4)) (mu AnnDarrow $3:(fst $ unLoc $1)) cs) con (snd $ unLoc $1) @@ -2763,7 +2763,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (sLLa $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2877,8 +2877,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLL $1 $> - [reLocA $ sLL $1 $> + (sLLa $1 $> + [sLLa $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2934,7 +2934,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -2951,7 +2951,7 @@ aexp1 :: { ECP } | aexp1 TIGHT_INFIX_PROJ field {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> - let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in + let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } @@ -3037,8 +3037,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3062,7 +3062,7 @@ cmdargs :: { [LHsCmdTop GhcPs] } acmd :: { LHsCmdTop GhcPs } : aexp {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) -> runPV (checkCmdBlockArguments cmd) >>= \ _ -> - return (sL1a (reLoc cmd) $ HsCmdTop noExtField cmd) } + return (sL1a cmd $ HsCmdTop noExtField cmd) } cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 @@ -3098,7 +3098,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } + sLLa $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3350,7 +3350,7 @@ ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> - return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } + return $ sLL gdpats gdpat (gdpat : unLoc gdpats) } | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to @@ -3517,7 +3517,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3562,11 +3562,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } + ; return (sLLa $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLL (head $1) (last $1) (And ($1)) } + { sLLa (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -4099,15 +4099,15 @@ comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` combineSrcSpans (getHasLoc a) (combineHasLocs b c) -comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan +comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) (getLoc d)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) (getHasLoc d)) -comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ combineSrcSpans (getHasLoc d) (getHasLoc e)) -- strict constructor version: {-# INLINE sL #-} @@ -4138,7 +4138,7 @@ sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} -sLLa :: Located a -> Located b -> c -> LocatedAn t c +sLLa :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -687,7 +687,7 @@ instance heads which unify with @nm tys@, they need not actually be satisfiable. @B@ themselves implement 'Eq' - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available - instance of 'Eq' + instance of 'Show' There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given). ===================================== m4/prep_target_file.m4 ===================================== @@ -58,7 +58,8 @@ AC_DEFUN([PREP_BOOLEAN],[ $1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + $1Bool=False ;; esac AC_SUBST([$1Bool]) @@ -78,7 +79,8 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ Not$1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + Not$1Bool=False ;; esac AC_SUBST([Not$1Bool]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/354e0f563d1e51d24eb3a47be69ff17f9a15838a...a96933f78e99fee2e27b3cf7f129a04a3c94cdc2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/354e0f563d1e51d24eb3a47be69ff17f9a15838a...a96933f78e99fee2e27b3cf7f129a04a3c94cdc2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 10:07:43 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 26 Jul 2023 06:07:43 -0400 Subject: [Git][ghc/ghc][wip/T20155] 1700 commits: Fix arityType: -fpedantic-bottoms, join points, etc Message-ID: <64c0f06f4798d_2fb451b9a8c244480@gitlab.mail> sheaf pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: a90298cc by Simon Peyton Jones at 2022-08-25T08:38:16+01:00 Fix arityType: -fpedantic-bottoms, join points, etc This MR fixes #21694, #21755. It also makes sure that #21948 and fix to #21694. * For #21694 the underlying problem was that we were calling arityType on an expression that had free join points. This is a Bad Bad Idea. See Note [No free join points in arityType]. * To make "no free join points in arityType" work out I had to avoid trying to use eta-expansion for runRW#. This entailed a few changes in the Simplifier's treatment of runRW#. See GHC.Core.Opt.Simplify.Iteration Note [No eta-expansion in runRW#] * I also made andArityType work correctly with -fpedantic-bottoms; see Note [Combining case branches: andWithTail]. * Rewrote Note [Combining case branches: optimistic one-shot-ness] * arityType previously treated join points differently to other let-bindings. This patch makes them unform; arityType analyses the RHS of all bindings to get its ArityType, and extends am_sigs. I realised that, now we have am_sigs giving the ArityType for let-bound Ids, we don't need the (pre-dating) special code in arityType for join points. But instead we need to extend the env for Rec bindings, which weren't doing before. More uniform now. See Note [arityType for let-bindings]. This meant we could get rid of ae_joins, and in fact get rid of EtaExpandArity altogether. Simpler. * And finally, it was the strange treatment of join-point Ids in arityType (involving a fake ABot type) that led to a serious bug: #21755. Fixed by this refactoring, which treats them uniformly; but without breaking #18328. In fact, the arity for recursive join bindings is pretty tricky; see the long Note [Arity for recursive join bindings] in GHC.Core.Opt.Simplify.Utils. That led to more refactoring, including deciding that an Id could have an Arity that is bigger than its JoinArity; see Note [Invariants on join points], item 2(b) in GHC.Core * Make sure that the "demand threshold" for join points in DmdAnal is no bigger than the join-arity. In GHC.Core.Opt.DmdAnal see Note [Demand signatures are computed for a threshold arity based on idArity] * I moved GHC.Core.Utils.exprIsDeadEnd into GHC.Core.Opt.Arity, where it more properly belongs. * Remove an old, redundant hack in FloatOut. The old Note was Note [Bottoming floats: eta expansion] in GHC.Core.Opt.SetLevels. Compile time improves very slightly on average: Metrics: compile_time/bytes allocated --------------------------------------------------------------------------------------- T18223(normal) ghc/alloc 725,808,720 747,839,216 +3.0% BAD T6048(optasm) ghc/alloc 105,006,104 101,599,472 -3.2% GOOD geo. mean -0.2% minimum -3.2% maximum +3.0% For some reason Windows was better T10421(normal) ghc/alloc 125,888,360 124,129,168 -1.4% GOOD T18140(normal) ghc/alloc 85,974,520 83,884,224 -2.4% GOOD T18698b(normal) ghc/alloc 236,764,568 234,077,288 -1.1% GOOD T18923(normal) ghc/alloc 75,660,528 73,994,512 -2.2% GOOD T6048(optasm) ghc/alloc 112,232,512 108,182,520 -3.6% GOOD geo. mean -0.6% I had a quick look at T18223 but it is knee deep in coercions and the size of everything looks similar before and after. I decided to accept that 3% increase in exchange for goodness elsewhere. Metric Decrease: T10421 T18140 T18698b T18923 T6048 Metric Increase: T18223 - - - - - 909edcfc by Ben Gamari at 2022-08-25T10:03:34-04:00 upload_ghc_libs: Add means of passing Hackage credentials - - - - - 28402eed by M Farkas-Dyck at 2022-08-25T10:04:17-04:00 Scrub some partiality in `CommonBlockElim`. - - - - - 54affbfa by Ben Gamari at 2022-08-25T20:05:31-04:00 hadrian: Fix whitespace Previously this region of Settings.Packages was incorrectly indented. - - - - - c4bba0f0 by Ben Gamari at 2022-08-25T20:05:31-04:00 validate: Drop --legacy flag In preparation for removal of the legacy `make`-based build system. - - - - - 822b0302 by Ben Gamari at 2022-08-25T20:05:31-04:00 gitlab-ci: Drop make build validation jobs In preparation for removal of the `make`-based build system - - - - - 6fd9b0a1 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop make build system Here we at long last remove the `make`-based build system, it having been replaced with the Shake-based Hadrian build system. Users are encouraged to refer to the documentation in `hadrian/doc` and this [1] blog post for details on using Hadrian. Closes #17527. [1] https://www.haskell.org/ghc/blog/20220805-make-to-hadrian.html - - - - - dbb004b0 by Ben Gamari at 2022-08-25T20:05:31-04:00 Remove testsuite/tests/perf/haddock/.gitignore As noted in #16802, this is no longer needed. Closes #16802. - - - - - fe9d824d by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop hc-build script This has not worked for many, many years and relied on the now-removed `make`-based build system. - - - - - 659502bc by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mkdirhier This is only used by nofib's dead `dist` target - - - - - 4a426924 by Ben Gamari at 2022-08-25T20:05:31-04:00 Drop mk/{build,install,config}.mk.in - - - - - 46924b75 by Ben Gamari at 2022-08-25T20:05:31-04:00 compiler: Drop comment references to make - - - - - d387f687 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add inits1 and tails1 to Data.List.NonEmpty See https://github.com/haskell/core-libraries-committee/issues/67 - - - - - 8603c921 by Harry Garrood at 2022-08-25T20:06:10-04:00 Add since annotations and changelog entries - - - - - 6b47aa1c by Krzysztof Gogolewski at 2022-08-25T20:06:46-04:00 Fix redundant import This fixes a build error on x86_64-linux-alpine3_12-validate. See the function 'loadExternalPlugins' defined in this file. - - - - - 4786acf7 by sheaf at 2022-08-26T15:05:23-04:00 Pmc: consider any 2 dicts of the same type equal This patch massages the keys used in the `TmOracle` `CoreMap` to ensure that dictionaries of coherent classes give the same key. That is, whenever we have an expression we want to insert or lookup in the `TmOracle` `CoreMap`, we first replace any dictionary `$dict_abcd :: ct` with a value of the form `error @ct`. This allows us to common-up view pattern functions with required constraints whose arguments differed only in the uniques of the dictionaries they were provided, thus fixing #21662. This is a rather ad-hoc change to the keys used in the `TmOracle` `CoreMap`. In the long run, we would probably want to use a different representation for the keys instead of simply using `CoreExpr` as-is. This more ambitious plan is outlined in #19272. Fixes #21662 Updates unix submodule - - - - - f5e0f086 by Krzysztof Gogolewski at 2022-08-26T15:06:01-04:00 Remove label style from printing context Previously, the SDocContext used for code generation contained information whether the labels should use Asm or C style. However, at every individual call site, this is known statically. This removes the parameter to 'PprCode' and replaces every 'pdoc' used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'. The OutputableP instance is now used only for dumps. The output of T15155 changes, it now uses the Asm style (which is faithful to what actually happens). - - - - - 1007829b by Cheng Shao at 2022-08-26T15:06:40-04:00 boot: cleanup legacy args Cleanup legacy boot script args, following removal of the legacy make build system. - - - - - 95fe09da by Simon Peyton Jones at 2022-08-27T00:29:02-04:00 Improve SpecConstr for evals As #21763 showed, we were over-specialising in some cases, when the function involved was doing a simple 'eval', but not taking the value apart, or branching on it. This MR fixes the problem. See Note [Do not specialise evals]. Nofib barely budges, except that spectral/cichelli allocates about 3% less. Compiler bytes-allocated improves a bit geo. mean -0.1% minimum -0.5% maximum +0.0% The -0.5% is on T11303b, for what it's worth. - - - - - 565a8ec8 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Revert "Revert "Refactor SpecConstr to use treat bindings uniformly"" This reverts commit 851d8dd89a7955864b66a3da8b25f1dd88a503f8. This commit was originally reverted due to an increase in space usage. This was diagnosed as because the SCE increased in size and that was being retained by another leak. See #22102 - - - - - 82ce1654 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Avoid retaining bindings via ModGuts held on the stack It's better to overwrite the bindings fields of the ModGuts before starting an iteration as then all the old bindings can be collected as soon as the simplifier has processed them. Otherwise we end up with the old bindings being alive until right at the end of the simplifier pass as the mg_binds field is only modified right at the end. - - - - - 64779dcd by Matthew Pickering at 2022-08-27T00:29:39-04:00 Force imposs_deflt_cons in filterAlts This fixes a pretty serious space leak as the forced thunk would retain `Alt b` values which would then contain reference to a lot of old bindings and other simplifier gunk. The OtherCon unfolding was not forced on subsequent simplifier runs so more and more old stuff would be retained until the end of simplification. Fixing this has a drastic effect on maximum residency for the mmark package which goes from ``` 45,005,401,056 bytes allocated in the heap 17,227,721,856 bytes copied during GC 818,281,720 bytes maximum residency (33 sample(s)) 9,659,144 bytes maximum slop 2245 MiB total memory in use (0 MB lost due to fragmentation) ``` to ``` 45,039,453,304 bytes allocated in the heap 13,128,181,400 bytes copied during GC 331,546,608 bytes maximum residency (40 sample(s)) 7,471,120 bytes maximum slop 916 MiB total memory in use (0 MB lost due to fragmentation) ``` See #21993 for some more discussion. - - - - - a3b23a33 by Matthew Pickering at 2022-08-27T00:29:39-04:00 Use Solo to avoid retaining the SCE but to avoid performing the substitution The use of Solo here allows us to force the selection into the SCE to obtain the Subst but without forcing the substitution to be applied. The resulting thunk is placed into a lazy field which is rarely forced, so forcing it regresses peformance. - - - - - 161a6f1f by Simon Peyton Jones at 2022-08-27T00:30:14-04:00 Fix a nasty loop in Tidy As the remarkably-simple #22112 showed, we were making a black hole in the unfolding of a self-recursive binding. Boo! It's a bit tricky. Documented in GHC.Iface.Tidy, Note [tidyTopUnfolding: avoiding black holes] - - - - - 68e6786f by Giles Anderson at 2022-08-29T00:01:35+02:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Class (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnIllegalHsigDefaultMethods TcRnBadGenericMethod TcRnWarningMinimalDefIncomplete TcRnDefaultMethodForPragmaLacksBinding TcRnIgnoreSpecialisePragmaOnDefMethod TcRnBadMethodErr TcRnNoExplicitAssocTypeOrDefaultDeclaration - - - - - cbe51ac5 by Simon Peyton Jones at 2022-08-29T04:18:57-04:00 Fix a bug in anyInRnEnvR This bug was a subtle error in anyInRnEnvR, introduced by commit d4d3fe6e02c0eb2117dbbc9df72ae394edf50f06 Author: Andreas Klebinger <klebinger.andreas at gmx.at> Date: Sat Jul 9 01:19:52 2022 +0200 Rule matching: Don't compute the FVs if we don't look at them. The net result was #22028, where a rewrite rule would wrongly match on a lambda. The fix to that function is easy. - - - - - 0154bc80 by sheaf at 2022-08-30T06:05:41-04:00 Various Hadrian bootstrapping fixes - Don't always produce a distribution archive (#21629) - Use correct executable names for ghc-pkg and hsc2hs on windows (we were missing the .exe file extension) - Fix a bug where we weren't using the right archive format on Windows when unpacking the bootstrap sources. Fixes #21629 - - - - - 451b1d90 by Matthew Pickering at 2022-08-30T06:06:16-04:00 ci: Attempt using normal submodule cloning strategy We do not use any recursively cloned submodules, and this protects us from flaky upstream remotes. Fixes #22121 - - - - - 9d5ad7c4 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: stray "--" - - - - - 3a002632 by Pi Delport at 2022-08-30T22:40:46+00:00 Fix typo in Any docs: syntatic -> syntactic - - - - - 7f490b13 by Simon Peyton Jones at 2022-08-31T03:53:54-04:00 Add a missing trimArityType This buglet was exposed by #22114, a consequence of my earlier refactoring of arity for join points. - - - - - e6fc820f by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump binary submodule to 0.8.9.1 - - - - - 4c1e7b22 by Ben Gamari at 2022-08-31T13:16:01+01:00 Bump stm submodule to 2.5.1.0 - - - - - 837472b4 by Ben Gamari at 2022-08-31T13:16:01+01:00 users-guide: Document system-cxx-std-lib - - - - - f7a9947a by Douglas Wilson at 2022-08-31T13:16:01+01:00 Update submodule containers to 0.6.6 - - - - - 4ab1c2ca by Douglas Wilson at 2022-08-31T13:16:02+01:00 Update submodule process to 1.6.15.0 - - - - - 1309ea1e by Ben Gamari at 2022-08-31T13:16:02+01:00 Bump directory submodule to 1.3.7.1 - - - - - 7962a33a by Douglas Wilson at 2022-08-31T13:16:02+01:00 Bump text submodule to 2.0.1 - - - - - fd8d80c3 by Ben Gamari at 2022-08-31T13:26:52+01:00 Bump deepseq submodule to 1.4.8.0 - - - - - a9baafac by Ben Gamari at 2022-08-31T13:26:52+01:00 Add dates to base, ghc-prim changelogs - - - - - 2cee323c by Ben Gamari at 2022-08-31T13:26:52+01:00 Update autoconf scripts Scripts taken from autoconf 02ba26b218d3d3db6c56e014655faf463cefa983 - - - - - e62705ff by Ben Gamari at 2022-08-31T13:26:53+01:00 Bump bytestring submodule to 0.11.3.1 - - - - - f7b4dcbd by Douglas Wilson at 2022-08-31T13:26:53+01:00 Update submodule Cabal to tag Cabal-v3.8.1.0 closes #21931 - - - - - e8eaf807 by Matthew Pickering at 2022-08-31T18:27:57-04:00 Refine in-tree compiler args for --test-compiler=stage1 Some of the logic to calculate in-tree arguments was not correct for the stage1 compiler. Namely we were not correctly reporting whether we were building static or dynamic executables and whether debug assertions were enabled. Fixes #22096 - - - - - 6b2f7ffe by Matthew Pickering at 2022-08-31T18:27:57-04:00 Make ghcDebugAssertions into a Stage predicate (Stage -> Bool) We also care whether we have debug assertions enabled for a stage one compiler, but the way which we turned on the assertions was quite different from the stage2 compiler. This makes the logic for turning on consistent across both and has the advantage of being able to correct determine in in-tree args whether a flavour enables assertions or not. Ticket #22096 - - - - - 15111af6 by Zubin Duggal at 2022-09-01T01:18:50-04:00 Add regression test for #21550 This was fixed by ca90ffa321a31842a32be1b5b6e26743cd677ec5 "Use local instances with least superclass depth" - - - - - 7d3a055d by Krzysztof Gogolewski at 2022-09-01T01:19:26-04:00 Minor cleanup - Remove mkHeteroCoercionType, sdocImpredicativeTypes, isStateType (unused), isCoVar_maybe (duplicated by getCoVar_maybe) - Replace a few occurrences of voidPrimId with (# #). void# is a deprecated synonym for the unboxed tuple. - Use showSDoc in :show linker. This makes it consistent with the other :show commands - - - - - 31a8989a by Tommy Bidne at 2022-09-01T12:01:20-04:00 Change Ord defaults per CLC proposal Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/24#issuecomment-1233331267 - - - - - 7f527f01 by Matthew Pickering at 2022-09-01T12:01:56-04:00 Fix bootstrap with ghc-9.0 It turns out Solo is a very recent addition to base, so for older GHC versions we just defined it inline here the one place we use it in the compiler. - - - - - d2be80fd by Sebastian Graf at 2022-09-05T23:12:14-04:00 DmdAnal: Don't panic in addCaseBndrDmd (#22039) Rather conservatively return Top. See Note [Untyped demand on case-alternative binders]. I also factored `addCaseBndrDmd` into two separate functions `scrutSubDmd` and `fieldBndrDmds`. Fixes #22039. - - - - - 25f68ace by Ben Gamari at 2022-09-05T23:12:50-04:00 gitlab-ci: Ensure that ghc derivation is in scope Previously the lint-ci job attempted to use cabal-install (specifically `cabal update`) without a GHC in PATH. However, cabal-install-3.8 appears to want GHC, even for `cabal update`. - - - - - f37b621f by sheaf at 2022-09-06T11:51:53+00:00 Update instances.rst, clarifying InstanceSigs Fixes #22103 - - - - - d4f908f7 by Jan Hrček at 2022-09-06T15:36:58-04:00 Fix :add docs in user guide - - - - - 808bb793 by Cheng Shao at 2022-09-06T15:37:35-04:00 ci: remove unused build_make/test_make in ci script - - - - - d0a2efb2 by Eric Lindblad at 2022-09-07T16:42:45-04:00 typo - - - - - fac0098b by Eric Lindblad at 2022-09-07T16:42:45-04:00 typos - - - - - a581186f by Eric Lindblad at 2022-09-07T16:42:45-04:00 whitespace - - - - - 04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00 CmmToAsm: remove unused ModLocation from NatM_State - - - - - ee1cfaa9 by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Minor SDoc cleanup Change calls to renderWithContext with showSDocOneLine; it's more efficient and explanatory. Remove polyPatSig (unused) - - - - - 7918265d by Krzysztof Gogolewski at 2022-09-07T16:43:58-04:00 Remove Outputable Char instance Use 'text' instead of 'ppr'. Using 'ppr' on the list "hello" rendered as "h,e,l,l,o". - - - - - 77209ab3 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Export liftA2 from Prelude Changes: In order to be warning free and compatible, we hide Applicative(..) from Prelude in a few places and instead import it directly from Control.Applicative. Please see the migration guide at https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md for more details. This means that Applicative is now exported in its entirety from Prelude. Motivation: This change is motivated by a few things: * liftA2 is an often used function, even more so than (<*>) for some people. * When implementing Applicative, the compiler will prompt you for either an implementation of (<*>) or of liftA2, but trying to use the latter ends with an error, without further imports. This could be confusing for newbies. * For teaching, it is often times easier to introduce liftA2 first, as it is a natural generalisation of fmap. * This change seems to have been unanimously and enthusiastically accepted by the CLC members, possibly indicating a lot of love for it. * This change causes very limited breakage, see the linked issue below for an investigation on this. See https://github.com/haskell/core-libraries-committee/issues/50 for the surrounding discussion and more details. - - - - - 442a94e8 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Add changelog entry for liftA2 export from Prelude - - - - - fb968680 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule containers to one with liftA2 warnings fixed - - - - - f54ff818 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Bump submodule Cabal to one with liftA2 warnings fixed - - - - - a4b34808 by Georgi Lyubenov at 2022-09-08T17:14:36+03:00 Isolate some Applicative hidings to GHC.Prelude By reexporting the entirety of Applicative from GHC.Prelude, we can save ourselves some `hiding` and importing of `Applicative` in consumers of GHC.Prelude. This also has the benefit of isolating this type of change to GHC.Prelude, so that people in the future don't have to think about it. - - - - - 9c4ea90c by Cheng Shao at 2022-09-08T17:49:47-04:00 CmmToC: enable 64-bit CallishMachOp on 32-bit targets Normally, the unregisterised builds avoid generating 64-bit CallishMachOp in StgToCmm, so CmmToC doesn't support these. However, there do exist cases where we'd like to invoke cmmToC for other cmm inputs which may contain such CallishMachOps, and it's a rather low effort to add support for these since they only require calling into existing ghc-prim cbits. - - - - - 04062510 by Alexis King at 2022-09-11T11:30:32+02:00 Add native delimited continuations to the RTS This patch implements GHC proposal 313, "Delimited continuation primops", by adding native support for delimited continuations to the GHC RTS. All things considered, the patch is relatively small. It almost exclusively consists of changes to the RTS; the compiler itself is essentially unaffected. The primops come with fairly extensive Haddock documentation, and an overview of the implementation strategy is given in the Notes in rts/Continuation.c. This first stab at the implementation prioritizes simplicity over performance. Most notably, every continuation is always stored as a single, contiguous chunk of stack. If one of these chunks is particularly large, it can result in poor performance, as the current implementation does not attempt to cleverly squeeze a subset of the stack frames into the existing stack: it must fit all at once. If this proves to be a performance issue in practice, a cleverer strategy would be a worthwhile target for future improvements. - - - - - ee471dfb by Cheng Shao at 2022-09-12T07:07:33-04:00 rts: fix missing dirty_MVAR argument in stg_writeIOPortzh - - - - - a5f9c35f by Cheng Shao at 2022-09-12T13:29:05-04:00 ci: enable parallel compression for xz - - - - - 3a815f30 by Ryan Scott at 2022-09-12T13:29:41-04:00 Windows: Always define _UCRT when compiling C code As seen in #22159, this is required to ensure correct behavior when MinGW-w64 headers are in the `C_INCLUDE_PATH`. Fixes #22159. - - - - - 65a0bd69 by sheaf at 2022-09-13T10:27:52-04:00 Add diagnostic codes This MR adds diagnostic codes, assigning unique numeric codes to error and warnings, e.g. error: [GHC-53633] Pattern match is redundant This is achieved as follows: - a type family GhcDiagnosticCode that gives the diagnostic code for each diagnostic constructor, - a type family ConRecursInto that specifies whether to recur into an argument of the constructor to obtain a more fine-grained code (e.g. different error codes for different 'deriving' errors), - generics machinery to generate the value-level function assigning each diagnostic its error code; see Note [Diagnostic codes using generics] in GHC.Types.Error.Codes. The upshot is that, to add a new diagnostic code, contributors only need to modify the two type families mentioned above. All logic relating to diagnostic codes is thus contained to the GHC.Types.Error.Codes module, with no code duplication. This MR also refactors error message datatypes a bit, ensuring we can derive Generic for them, and cleans up the logic around constraint solver reports by splitting up 'TcSolverReportInfo' into separate datatypes (see #20772). Fixes #21684 - - - - - 362cca13 by sheaf at 2022-09-13T10:27:53-04:00 Diagnostic codes: acccept test changes The testsuite output now contains diagnostic codes, so many tests need to be updated at once. We decided it was best to keep the diagnostic codes in the testsuite output, so that contributors don't inadvertently make changes to the diagnostic codes. - - - - - 08f6730c by Adam Gundry at 2022-09-13T10:28:29-04:00 Allow imports to reference multiple fields with the same name (#21625) If a module `M` exports two fields `f` (using DuplicateRecordFields), we can still accept import M (f) import M hiding (f) and treat `f` as referencing both of them. This was accepted in GHC 9.0, but gave rise to an ambiguity error in GHC 9.2. See #21625. This patch also documents this behaviour in the user's guide, and updates the test for #16745 which is now treated differently. - - - - - c14370d7 by Cheng Shao at 2022-09-13T10:29:07-04:00 ci: remove unused appveyor config - - - - - dc6af9ed by Cheng Shao at 2022-09-13T10:29:45-04:00 compiler: remove unused lazy state monad - - - - - 646d15ad by Eric Lindblad at 2022-09-14T03:13:56-04:00 Fix typos This fixes various typos and spelling mistakes in the compiler. Fixes #21891 - - - - - 7d7e71b0 by Matthew Pickering at 2022-09-14T03:14:32-04:00 hadrian: Bump index state This bumps the index state so a build plan can also be found when booting with 9.4. Fixes #22165 - - - - - 98b62871 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Use a stamp file to record when a package is built in a certain way Before this patch which library ways we had built wasn't recorded directly. So you would run into issues if you build the .conf file with some library ways before switching the library ways which you wanted to build. Now there is one stamp file for each way, so in order to build a specific way you can need that specific stamp file rather than going indirectly via the .conf file. - - - - - b42cedbe by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Inplace/Final package databases There are now two different package databases per stage. An inplace package database contains .conf files which point directly into the build directories. The final package database contains .conf files which point into the installed locations. The inplace .conf files are created before any building happens and have fake ABI hash values. The final .conf files are created after a package finished building and contains the proper ABI has. The motivation for this is to make the dependency structure more fine-grained when building modules. Now a module depends just depends directly on M.o from package p rather than the .conf file depend on the .conf file for package p. So when all of a modules direct dependencies have finished building we can start building it rather than waiting for the whole package to finish. The secondary motivation is that the multi-repl doesn't need to build everything before starting the multi-repl session. We can just configure the inplace package-db and use that in order to start the repl. - - - - - 6515c32b by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add some more packages to multi-cradle The main improvement here is to pass `-this-unit-id` for executables so that they can be added to the multi-cradle if desired as well as normal library packages. - - - - - e470e91f by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Need builders needed by Cabal Configure in parallel Because of the use of withStaged (which needs the necessary builder) when configuring a package, the builds of stage1:exe:ghc-bin and stage1:exe:ghc-pkg where being linearised when building a specific target like `binary-dist-dir`. Thankfully the fix is quite local, to supply all the `withStaged` arguments together so the needs can be batched together and hence performed in parallel. Fixes #22093 - - - - - c4438347 by Matthew Pickering at 2022-09-14T17:17:04-04:00 Remove stage1:exe:ghc-bin pre-build from CI script CI builds stage1:exe:ghc-bin before the binary-dist target which introduces some quite bad linearisation (see #22093) because we don't build stage1 compiler in parallel with anything. Then when the binary-dist target is started we have to build stage1:exe:ghc-pkg before doing anything. Fixes #22094 - - - - - 71d8db86 by Matthew Pickering at 2022-09-14T17:17:04-04:00 hadrian: Add extra implicit dependencies from DeriveLift ghc -M should know that modules which use DeriveLift (or TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have to add these extra edges manually or the modules will be compiled before TH.Lib.Internal is compiled which leads to a desugarer error. - - - - - 43e574f0 by Greg Steuck at 2022-09-14T17:17:43-04:00 Repair c++ probing on OpenBSD Failure without this change: ``` checking C++ standard library flavour... libc++ checking for linkage against 'c++ c++abi'... failed checking for linkage against 'c++ cxxrt'... failed configure: error: Failed to find C++ standard library ``` - - - - - 534b39ee by Douglas Wilson at 2022-09-14T17:18:21-04:00 libraries: template-haskell: vendor filepath differently Vendoring with ../ in hs-source-dirs prevents upload to hackage. (cherry picked from commit 1446be7586ba70f9136496f9b67f792955447842) - - - - - bdd61cd6 by M Farkas-Dyck at 2022-09-14T22:39:34-04:00 Unbreak Hadrian with Cabal 3.8. - - - - - df04d6ec by Krzysztof Gogolewski at 2022-09-14T22:40:09-04:00 Fix typos - - - - - d6ea8356 by Andreas Klebinger at 2022-09-15T10:12:41+02:00 Tag inference: Fix #21954 by retaining tagsigs of vars in function position. For an expression like: case x of y Con z -> z If we also retain the tag sig for z we can generate code to immediately return it rather than calling out to stg_ap_0_fast. - - - - - 7cce7007 by Andreas Klebinger at 2022-09-15T10:12:42+02:00 Stg.InferTags.Rewrite - Avoid some thunks. - - - - - 88c4cbdb by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: enable -fprof-late only for profiling ways - - - - - d7235831 by Cheng Shao at 2022-09-16T13:57:56-04:00 hadrian: add late_ccs flavour transformer - - - - - ce203753 by Cheng Shao at 2022-09-16T13:58:34-04:00 configure: remove unused program checks - - - - - 9b4c1056 by Pierre Le Marre at 2022-09-16T13:59:16-04:00 Update to Unicode 15.0 - - - - - c6e9b89a by Bodigrim at 2022-09-16T13:59:55-04:00 Avoid partial head and tail in ghc-heap; replace with total pattern-matching - - - - - 616afde3 by Cheng Shao at 2022-09-16T14:00:33-04:00 hadrian: relax Cabal upper bound to allow building with Cabal-3.8 A follow up of !8910. - - - - - df35d994 by Alexis King at 2022-09-16T14:01:11-04:00 Add links to the continuations haddocks in the docs for each primop fixes #22176 - - - - - 383f7549 by Matthew Pickering at 2022-09-16T21:42:10-04:00 -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice See the examples in #22057 which show we have to traverse deeply into a pattern to determine whether it contains a splice or not. The original implementation pointed this out but deemed this very shallow traversal "too expensive". Fixes #22057 I also fixed an oversight in !7821 which meant we lost a warning which was present in 9.2.2. Fixes #22067 - - - - - 5031bf49 by sheaf at 2022-09-16T21:42:49-04:00 Hadrian: Don't try to build terminfo on Windows Commit b42cedbe introduced a dependency on terminfo on Windows, but that package isn't available on Windows. - - - - - c9afe221 by M Farkas-Dyck at 2022-09-17T06:44:47-04:00 Clean up some. In particular: • Delete some dead code, largely under `GHC.Utils`. • Clean up a few definitions in `GHC.Utils.(Misc, Monad)`. • Clean up `GHC.Types.SrcLoc`. • Derive stock `Functor, Foldable, Traversable` for more types. • Derive more instances for newtypes. Bump haddock submodule. - - - - - 85431ac3 by Cheng Shao at 2022-09-17T06:45:25-04:00 driver: pass original Cmm filename in ModLocation When compiling Cmm, the ml_hs_file field is used to indicate Cmm filename when later generating DWARF information. We should pass the original filename here, otherwise for preprocessed Cmm files, the filename will be a temporary filename which is confusing. - - - - - 63aa0069 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: remove legacy logging cabal flag - - - - - bd0f4184 by Cheng Shao at 2022-09-17T06:46:04-04:00 rts: make threaded ways optional For certain targets (e.g. wasm32-wasi), the threaded rts is known not to work. This patch adds a "threaded" cabal flag to rts to make threaded rts ways optional. Hadrian enables this flag iff the flavour rtsWays contains threaded ways. - - - - - 8a666ad2 by Ryan Scott at 2022-09-18T08:00:44-04:00 DeriveFunctor: Check for last type variables using dataConUnivTyVars Previously, derived instances of `Functor` (as well as the related classes `Foldable`, `Traversable`, and `Generic1`) would determine which constraints to infer by checking for fields that contain the last type variable. The problem was that this last type variable was taken from `tyConTyVars`. For GADTs, the type variables in each data constructor are _not_ the same type variables as in `tyConTyVars`, leading to #22167. This fixes the issue by instead checking for the last type variable using `dataConUnivTyVars`. (This is very similar in spirit to the fix for #21185, which also replaced an errant use of `tyConTyVars` with type variables from each data constructor.) Fixes #22167. - - - - - 78037167 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: pass updated buffer to actions (#22201) In the lexer, predicates have the following type: { ... } :: user -- predicate state -> AlexInput -- input stream before the token -> Int -- length of the token -> AlexInput -- input stream after the token -> Bool -- True <=> accept the token This is documented in the Alex manual. There is access to the input stream both before and after the token. But when the time comes to construct the token, GHC passes only the initial string buffer to the lexer action. This patch fixes it: - type Action = PsSpan -> StringBuffer -> Int -> P (PsLocated Token) + type Action = PsSpan -> StringBuffer -> Int -> StringBuffer -> P (PsLocated Token) Now lexer actions have access to the string buffer both before and after the token, just like the predicates. It's just a matter of passing an additional function parameter throughout the lexer. - - - - - 75746594 by Vladislav Zavialov at 2022-09-18T08:01:20-04:00 Lexer: define varsym without predicates (#22201) Before this patch, the varsym lexing rules were defined as follows: <0> { @varsym / { precededByClosingToken `alexAndPred` followedByOpeningToken } { varsym_tight_infix } @varsym / { followedByOpeningToken } { varsym_prefix } @varsym / { precededByClosingToken } { varsym_suffix } @varsym { varsym_loose_infix } } Unfortunately, this meant that the predicates 'precededByClosingToken' and 'followedByOpeningToken' were recomputed several times before we could figure out the whitespace context. With this patch, we check for whitespace context directly in the lexer action: <0> { @varsym { with_op_ws varsym } } The checking for opening/closing tokens happens in 'with_op_ws' now, which is part of the lexer action rather than the lexer predicate. - - - - - c1f81b38 by M Farkas-Dyck at 2022-09-19T09:07:05-04:00 Scrub partiality about `NewOrData`. Rather than a list of constructors and a `NewOrData` flag, we define `data DataDefnCons a = NewTypeCon a | DataTypeCons [a]`, which enforces a newtype to have exactly one constructor. Closes #22070. Bump haddock submodule. - - - - - 1e1ed8c5 by Cheng Shao at 2022-09-19T09:07:43-04:00 CmmToC: emit __builtin_unreachable() after noreturn ccalls Emit a __builtin_unreachable() call after a foreign call marked as CmmNeverReturns. This is crucial to generate correctly typed code for wasm; as for other archs, this is also beneficial for the C compiler optimizations. - - - - - 19f45a25 by Jan Hrček at 2022-09-20T03:49:29-04:00 Document :unadd GHCi command in user guide - - - - - 545ff490 by sheaf at 2022-09-20T03:50:06-04:00 Hadrian: merge archives even in stage 0 We now always merge .a archives when ar supports -L. This change is necessary in order to bootstrap GHC using GHC 9.4 on Windows, as nested archives aren't supported. Not doing so triggered bug #21990 when trying to use the Win32 package, with errors such as: Not a x86_64 PE+ file. Unknown COFF 4 type in getHeaderInfo. ld.lld: error: undefined symbol: Win32zm2zi12zi0zi0_SystemziWin32ziConsoleziCtrlHandler_withConsoleCtrlHandler1_info We have to be careful about which ar is meant: in stage 0, the check should be done on the system ar (system-ar in system.config). - - - - - 59fe128c by Vladislav Zavialov at 2022-09-20T03:50:42-04:00 Fix -Woperator-whitespace for consym (part of #19372) Due to an oversight, the initial specification and implementation of -Woperator-whitespace focused on varsym exclusively and completely ignored consym. This meant that expressions such as "x+ y" would produce a warning, while "x:+ y" would not. The specification was corrected in ghc-proposals pull request #404, and this patch updates the implementation accordingly. Regression test included. - - - - - c4c2cca0 by John Ericson at 2022-09-20T13:11:49-04:00 Add `Eq` and `Ord` instances for `Generically1` These are needed so the subsequent commit overhauling the `*1` classes type-checks. - - - - - 7beb356e by John Ericson at 2022-09-20T13:11:50-04:00 Relax instances for Functor combinators; put superclass on Class1 and Class2 to make non-breaking This change is approved by the Core Libraries commitee in https://github.com/haskell/core-libraries-committee/issues/10 The first change makes the `Eq`, `Ord`, `Show`, and `Read` instances for `Sum`, `Product`, and `Compose` match those for `:+:`, `:*:`, and `:.:`. These have the proper flexible contexts that are exactly what the instance needs: For example, instead of ```haskell instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 ``` we do ```haskell deriving instance Eq (f (g a)) => Eq (Compose f g a) ``` But, that change alone is rather breaking, because until now `Eq (f a)` and `Eq1 f` (and respectively the other classes and their `*1` equivalents too) are *incomparable* constraints. This has always been an annoyance of working with the `*1` classes, and now it would rear it's head one last time as an pesky migration. Instead, we give the `*1` classes superclasses, like so: ```haskell (forall a. Eq a => Eq (f a)) => Eq1 f ``` along with some laws that canonicity is preserved, like: ```haskell liftEq (==) = (==) ``` and likewise for `*2` classes: ```haskell (forall a. Eq a => Eq1 (f a)) => Eq2 f ``` and laws: ```haskell liftEq2 (==) = liftEq1 ``` The `*1` classes also have default methods using the `*2` classes where possible. What this means, as explained in the docs, is that `*1` classes really are generations of the regular classes, indicating that the methods can be split into a canonical lifting combined with a canonical inner, with the super class "witnessing" the laws[1] in a fashion. Circling back to the pragmatics of migrating, note that the superclass means evidence for the old `Sum`, `Product`, and `Compose` instances is (more than) sufficient, so breakage is less likely --- as long no instances are "missing", existing polymorphic code will continue to work. Breakage can occur when a datatype implements the `*1` class but not the corresponding regular class, but this is almost certainly an oversight. For example, containers made that mistake for `Tree` and `Ord`, which I fixed in https://github.com/haskell/containers/pull/761, but fixing the issue by adding `Ord1` was extremely *un*controversial. `Generically1` was also missing `Eq`, `Ord`, `Read,` and `Show` instances. It is unlikely this would have been caught without implementing this change. ----- [1]: In fact, someday, when the laws are part of the language and not only documentation, we might be able to drop the superclass field of the dictionary by using the laws to recover the superclass in an instance-agnostic manner, e.g. with a *non*-overloaded function with type: ```haskell DictEq1 f -> DictEq a -> DictEq (f a) ``` But I don't wish to get into optomizations now, just demonstrate the close relationship between the law and the superclass. Bump haddock submodule because of test output changing. - - - - - 6a8c6b5e by Tom Ellis at 2022-09-20T13:12:27-04:00 Add notes to ghc-prim Haddocks that users should not import it - - - - - ee9d0f5c by matoro at 2022-09-20T13:13:06-04:00 docs: clarify that LLVM codegen is not available in unregisterised mode The current docs are misleading and suggest that it is possible to use LLVM codegen from an unregisterised build. This is not the case; attempting to pass `-fllvm` to an unregisterised build warns: ``` when making flags consistent: warning: Target platform uses unregisterised ABI, so compiling via C ``` and uses the C codegen anyway. - - - - - 854224ed by Nicolas Trangez at 2022-09-20T20:14:29-04:00 rts: remove copy-paste error from `cabal.rts.in` This was, likely accidentally, introduced in 4bf542bf1c. See: 4bf542bf1cdf2fa468457fc0af21333478293476 - - - - - c8ae3add by Matthew Pickering at 2022-09-20T20:15:04-04:00 hadrian: Add extra_dependencies edges for all different ways The hack to add extra dependencies needed by DeriveLift extension missed the cases for profiles and dynamic ways. For the profiled way this leads to errors like: ``` GHC error in desugarer lookup in Data.IntSet.Internal: Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’ Perhaps you haven't installed the profiling libraries for package ‘template-haskell’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. ghc: panic! (the 'impossible' happened) GHC version 9.5.20220916: initDs ``` Therefore the fix is to add these extra edges in. Fixes #22197 - - - - - a971657d by Mon Aaraj at 2022-09-21T06:41:24+03:00 users-guide: fix incorrect ghcappdata folder for unix and windows - - - - - 06ccad0d by sheaf at 2022-09-21T08:28:49-04:00 Don't use isUnliftedType in isTagged The function GHC.Stg.InferTags.Rewrite.isTagged can be given the Id of a join point, which might be representation polymorphic. This would cause the call to isUnliftedType to crash. It's better to use typeLevity_maybe instead. Fixes #22212 - - - - - c0ba775d by Teo Camarasu at 2022-09-21T14:30:37-04:00 Add fragmentation statistic to GHC.Stats Implements #21537 - - - - - 2463df2f by Torsten Schmits at 2022-09-21T14:31:24-04:00 Rename Solo[constructor] to MkSolo Part of proposal 475 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0475-tuple-syntax.rst) Moves all tuples to GHC.Tuple.Prim Updates ghc-prim version (and bumps bounds in dependents) updates haddock submodule updates deepseq submodule updates text submodule - - - - - 9034fada by Matthew Pickering at 2022-09-22T09:25:29-04:00 Update filepath to filepath-1.4.100.0 Updates submodule * Always rely on vendored filepath * filepath must be built as stage0 dependency because it uses template-haskell. Towards #22098 - - - - - 615e2278 by Krzysztof Gogolewski at 2022-09-22T09:26:05-04:00 Minor refactor around Outputable * Replace 'text . show' and 'ppr' with 'int'. * Remove Outputable.hs-boot, no longer needed * Use pprWithCommas * Factor out instructions in AArch64 codegen - - - - - aeafdba5 by Sebastian Graf at 2022-09-27T15:14:54+02:00 Demand: Clear distinction between Call SubDmd and eval Dmd (#21717) In #21717 we saw a reportedly unsound strictness signature due to an unsound definition of plusSubDmd on Calls. This patch contains a description and the fix to the unsoundness as outlined in `Note [Call SubDemand vs. evaluation Demand]`. This fix means we also get rid of the special handling of `-fpedantic-bottoms` in eta-reduction. Thanks to less strict and actually sound strictness results, we will no longer eta-reduce the problematic cases in the first place, even without `-fpedantic-bottoms`. So fixing the unsoundness also makes our eta-reduction code simpler with less hacks to explain. But there is another, more unfortunate side-effect: We *unfix* #21085, but fortunately we have a new fix ready: See `Note [mkCall and plusSubDmd]`. There's another change: I decided to make `Note [SubDemand denotes at least one evaluation]` a lot simpler by using `plusSubDmd` (instead of `lubPlusSubDmd`) even if both argument demands are lazy. That leads to less precise results, but in turn rids ourselves from the need for 4 different `OpMode`s and the complication of `Note [Manual specialisation of lub*Dmd/plus*Dmd]`. The result is simpler code that is in line with the paper draft on Demand Analysis. I left the abandoned idea in `Note [Unrealised opportunity in plusDmd]` for posterity. The fallout in terms of regressions is negligible, as the testsuite and NoFib shows. ``` Program Allocs Instrs -------------------------------------------------------------------------------- hidden +0.2% -0.2% linear -0.0% -0.7% -------------------------------------------------------------------------------- Min -0.0% -0.7% Max +0.2% +0.0% Geometric Mean +0.0% -0.0% ``` Fixes #21717. - - - - - 9b1595c8 by Ross Paterson at 2022-09-27T14:12:01-04:00 implement proposal 106 (Define Kinds Without Promotion) (fixes #6024) includes corresponding changes to haddock submodule - - - - - c2d73cb4 by Andreas Klebinger at 2022-09-28T15:07:30-04:00 Apply some tricks to speed up core lint. Below are the noteworthy changes and if given their impact on compiler allocations for a type heavy module: * Use the oneShot trick on LintM * Use a unboxed tuple for the result of LintM: ~6% reduction * Avoid a thunk for the result of typeKind in lintType: ~5% reduction * lint_app: Don't allocate the error msg in the hot code path: ~4% reduction * lint_app: Eagerly force the in scope set: ~4% * nonDetCmpType: Try to short cut using reallyUnsafePtrEquality#: ~2% * lintM: Use a unboxed maybe for the `a` result: ~12% * lint_app: make go_app tail recursive to avoid allocating the go function as heap closure: ~7% * expandSynTyCon_maybe: Use a specialized data type For a less type heavy module like nofib/spectral/simple compiled with -O -dcore-lint allocations went down by ~24% and compile time by ~9%. ------------------------- Metric Decrease: T1969 ------------------------- - - - - - b74b6191 by sheaf at 2022-09-28T15:08:10-04:00 matchLocalInst: do domination analysis When multiple Given quantified constraints match a Wanted, and there is a quantified constraint that dominates all others, we now pick it to solve the Wanted. See Note [Use only the best matching quantified constraint]. For example: [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b [G] d2: forall a . C a Int => D a Int [W] {w}: D a Int When solving the Wanted, we find that both Givens match, but we pick the second, because it has a weaker precondition, C a Int, compared to (Eq a, Num Int, C a Int). We thus say that d2 dominates d1; see Note [When does a quantified instance dominate another?]. This domination test is done purely in terms of superclass expansion, in the function GHC.Tc.Solver.Interact.impliedBySCs. We don't attempt to do a full round of constraint solving; this simple check suffices for now. Fixes #22216 and #22223 - - - - - 2a53ac18 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Improve aggressive specialisation This patch fixes #21286, by not unboxing dictionaries in worker/wrapper (ever). The main payload is tiny: * In `GHC.Core.Opt.DmdAnal.finaliseArgBoxities`, do not unbox dictionaries in `get_dmd`. See Note [Do not unbox class dictionaries] in that module * I also found that imported wrappers were being fruitlessly specialised, so I fixed that too, in canSpecImport. See Note [Specialising imported functions] point (2). In doing due diligence in the testsuite I fixed a number of other things: * Improve Note [Specialising unfoldings] in GHC.Core.Unfold.Make, and Note [Inline specialisations] in GHC.Core.Opt.Specialise, and remove duplication between the two. The new Note describes how we specialise functions with an INLINABLE pragma. And simplify the defn of `spec_unf` in `GHC.Core.Opt.Specialise.specCalls`. * Improve Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. And (critially) make an actual change which is to propagate the user-written pragma from the original function to the wrapper; see `mkStrWrapperInlinePrag`. * Write new Note [Specialising imported functions] in GHC.Core.Opt.Specialise All this has a big effect on some compile times. This is compiler/perf, showing only changes over 1%: Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -50.2% GOOD ManyConstructors(normal) +1.0% MultiLayerModulesTH_OneShot(normal) +2.6% PmSeriesG(normal) -1.1% T10547(normal) -1.2% T11195(normal) -1.2% T11276(normal) -1.0% T11303b(normal) -1.6% T11545(normal) -1.4% T11822(normal) -1.3% T12150(optasm) -1.0% T12234(optasm) -1.2% T13056(optasm) -9.3% GOOD T13253(normal) -3.8% GOOD T15164(normal) -3.6% GOOD T16190(normal) -2.1% T16577(normal) -2.8% GOOD T16875(normal) -1.6% T17836(normal) +2.2% T17977b(normal) -1.0% T18223(normal) -33.3% GOOD T18282(normal) -3.4% GOOD T18304(normal) -1.4% T18698a(normal) -1.4% GOOD T18698b(normal) -1.3% GOOD T19695(normal) -2.5% GOOD T5837(normal) -2.3% T9630(normal) -33.0% GOOD WWRec(normal) -9.7% GOOD hard_hole_fits(normal) -2.1% GOOD hie002(normal) +1.6% geo. mean -2.2% minimum -50.2% maximum +2.6% I diligently investigated some of the big drops. * Caused by not doing w/w for dictionaries: T13056, T15164, WWRec, T18223 * Caused by not fruitlessly specialising wrappers LargeRecord, T9630 For runtimes, here is perf/should+_run: Metrics: runtime/bytes allocated -------------------------------- T12990(normal) -3.8% T5205(normal) -1.3% T9203(normal) -10.7% GOOD haddock.Cabal(normal) +0.1% haddock.base(normal) -1.1% haddock.compiler(normal) -0.3% lazy-bs-alloc(normal) -0.2% ------------------------------------------ geo. mean -0.3% minimum -10.7% maximum +0.1% I did not investigate exactly what happens in T9203. Nofib is a wash: +-------------------------------++--+-----------+-----------+ | || | tsv (rel) | std. err. | +===============================++==+===========+===========+ | real/anna || | -0.13% | 0.0% | | real/fem || | +0.13% | 0.0% | | real/fulsom || | -0.16% | 0.0% | | real/lift || | -1.55% | 0.0% | | real/reptile || | -0.11% | 0.0% | | real/smallpt || | +0.51% | 0.0% | | spectral/constraints || | +0.20% | 0.0% | | spectral/dom-lt || | +1.80% | 0.0% | | spectral/expert || | +0.33% | 0.0% | +===============================++==+===========+===========+ | geom mean || | | | +-------------------------------++--+-----------+-----------+ I spent quite some time investigating dom-lt, but it's pretty complicated. See my note on !7847. Conclusion: it's just a delicate inlining interaction, and we have plenty of those. Metric Decrease: LargeRecord T13056 T13253 T15164 T16577 T18223 T18282 T18698a T18698b T19695 T9630 WWRec hard_hole_fits T9203 - - - - - addeefc0 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 Refactor UnfoldingSource and IfaceUnfolding I finally got tired of the way that IfaceUnfolding reflected a previous structure of unfoldings, not the current one. This MR refactors UnfoldingSource and IfaceUnfolding to be simpler and more consistent. It's largely just a refactor, but in UnfoldingSource (which moves to GHC.Types.Basic, since it is now used in IfaceSyn too), I distinguish between /user-specified/ and /system-generated/ stable unfoldings. data UnfoldingSource = VanillaSrc | StableUserSrc -- From a user-specified pragma | StableSystemSrc -- From a system-generated unfolding | CompulsorySrc This has a minor effect in CSE (see the use of isisStableUserUnfolding in GHC.Core.Opt.CSE), which I tripped over when working on specialisation, but it seems like a Good Thing to know anyway. - - - - - 7be6f9a4 by Simon Peyton Jones at 2022-09-28T17:49:09-04:00 INLINE/INLINEABLE pragmas in Foreign.Marshal.Array Foreign.Marshal.Array contains many small functions, all of which are overloaded, and which are critical for performance. Yet none of them had pragmas, so it was a fluke whether or not they got inlined. This patch makes them all either INLINE (small ones) or INLINEABLE and hence specialisable (larger ones). See Note [Specialising array operations] in that module. - - - - - b0c89dfa by Jade Lovelace at 2022-09-28T17:49:49-04:00 Export OnOff from GHC.Driver.Session I was working on fixing an issue where HLS was trying to pass its DynFlags to HLint, but didn't pass any of the disabled language extensions, which HLint would then assume are on because of their default values. Currently it's not possible to get any of the "No" flags because the `DynFlags.extensions` field can't really be used since it is [OnOff Extension] and OnOff is not exported. So let's export it. - - - - - 2f050687 by Bodigrim at 2022-09-28T17:50:28-04:00 Avoid Data.List.group; prefer Data.List.NonEmpty.group This allows to avoid further partiality, e. g., map head . group is replaced by map NE.head . NE.group, and there are less panic calls. - - - - - bc0020fa by M Farkas-Dyck at 2022-09-28T22:51:59-04:00 Clean up `findWiredInUnit`. In particular, avoid `head`. - - - - - 6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00 Eliminate headFS, use unconsFS instead A small step towards #22185 to avoid partial functions + safe implementation of `startsWithUnderscore`. - - - - - 5a535172 by Sebastian Graf at 2022-09-29T17:04:20+02:00 Demand: Format Call SubDemands `Cn(sd)` as `C(n,sd)` (#22231) Justification in #22231. Short form: In a demand like `1C1(C1(L))` it was too easy to confuse which `1` belongs to which `C`. Now that should be more obvious. Fixes #22231 - - - - - ea0083bf by Bryan Richter at 2022-09-29T15:48:38-04:00 Revert "ci: enable parallel compression for xz" Combined wxth XZ_OPT=9, this blew the memory capacity of CI runners. This reverts commit a5f9c35f5831ef5108e87813a96eac62803852ab. - - - - - f5e8f493 by Sebastian Graf at 2022-09-30T18:42:13+02:00 Boxity: Don't update Boxity unless worker/wrapper follows (#21754) A small refactoring in our Core Opt pipeline and some new functions for transfering argument boxities from one signature to another to facilitate `Note [Don't change boxity without worker/wrapper]`. Fixes #21754. - - - - - 4baf7b1c by M Farkas-Dyck at 2022-09-30T17:45:47-04:00 Scrub various partiality involving empty lists. Avoids some uses of `head` and `tail`, and some panics when an argument is null. - - - - - 95ead839 by Alexis King at 2022-10-01T00:37:43-04:00 Fix a bug in continuation capture across multiple stack chunks - - - - - 22096652 by Bodigrim at 2022-10-01T00:38:22-04:00 Enforce internal invariant of OrdList and fix bugs in viewCons / viewSnoc `viewCons` used to ignore `Many` constructor completely, returning `VNothing`. `viewSnoc` violated internal invariant of `Many` being a non-empty list. - - - - - 48ab9ca5 by Nicolas Trangez at 2022-10-04T20:34:10-04:00 chore: extend `.editorconfig` for C files - - - - - b8df5c72 by Brandon Chinn at 2022-10-04T20:34:46-04:00 Fix docs for pattern synonyms - - - - - 463ffe02 by Oleg Grenrus at 2022-10-04T20:35:24-04:00 Use sameByteArray# in sameByteArray - - - - - fbe1e86e by Pierre Le Marre at 2022-10-05T15:58:43+02:00 Minor fixes following Unicode 15.0.0 update - Fix changelog for Unicode 15.0.0 - Fix the checksums of the downloaded Unicode files, in base's tool: "ucd2haskell". - - - - - 8a31d02e by Cheng Shao at 2022-10-05T20:40:41-04:00 rts: don't enforce aligned((8)) on 32-bit targets We simply need to align to the word size for pointer tagging to work. On 32-bit targets, aligned((8)) is wasteful. - - - - - 532de368 by Ryan Scott at 2022-10-06T07:45:46-04:00 Export symbolSing, SSymbol, and friends (CLC#85) This implements this Core Libraries Proposal: https://github.com/haskell/core-libraries-committee/issues/85 In particular, it: 1. Exposes the `symbolSing` method of `KnownSymbol`, 2. Exports the abstract `SSymbol` type used in `symbolSing`, and 3. Defines an API for interacting with `SSymbol`. This also makes corresponding changes for `natSing`/`KnownNat`/`SNat` and `charSing`/`KnownChar`/`SChar`. This fixes #15183 and addresses part (2) of #21568. - - - - - d83a92e6 by sheaf at 2022-10-07T07:36:30-04:00 Remove mention of make from README.md - - - - - 945e8e49 by Bodigrim at 2022-10-10T17:13:31-04:00 Add a newline before since pragma in Data.Array.Byte - - - - - 44fcdb04 by Vladislav Zavialov at 2022-10-10T17:14:06-04:00 Parser/PostProcess: rename failOp* functions There are three functions named failOp* in the parser: failOpNotEnabledImportQualifiedPost failOpImportQualifiedTwice failOpFewArgs Only the last one has anything to do with operators. The other two were named this way either by mistake or due to a misunderstanding of what "op" stands for. This small patch corrects this. - - - - - 96d32ff2 by Simon Peyton Jones at 2022-10-10T22:30:21+01:00 Make rewrite rules "win" over inlining If a rewrite rule and a rewrite rule compete in the simplifier, this patch makes sure that the rewrite rule "win". That is, in general a bit fragile, but it's a huge help when making specialisation work reliably, as #21851 and #22097 showed. The change is fairly straightforwad, and documented in Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration. Compile-times change, up and down a bit -- in some cases because we get better specialisation. But the payoff (more reliable specialisation) is large. Metrics: compile_time/bytes allocated ----------------------------------------------- T10421(normal) +3.7% BAD T10421a(normal) +5.5% T13253(normal) +1.3% T14052(ghci) +1.8% T15304(normal) -1.4% T16577(normal) +3.1% BAD T17516(normal) +2.3% T17836(normal) -1.9% T18223(normal) -1.8% T8095(normal) -1.3% T9961(normal) +2.5% BAD geo. mean +0.0% minimum -1.9% maximum +5.5% Nofib results are (bytes allocated) +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || +0.27% | | imaginary/rfib || -0.04% | | real/anna || +0.02% | | real/fem || -0.04% | | real/fluid || +1.68% | | real/gamteb || -0.34% | | real/gg || +1.54% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/infer || -0.03% | | real/prolog || +0.02% | | real/veritas || -0.47% | | shootout/fannkuch-redux || -0.03% | | shootout/k-nucleotide || -0.02% | | shootout/n-body || -0.06% | | shootout/spectral-norm || -0.01% | | spectral/cryptarithm2 || +1.25% | | spectral/fibheaps || +18.33% | | spectral/last-piece || -0.34% | +===============================++==========+ | geom mean || +0.17% | There are extensive notes in !8897 about the regressions. Briefly * fibheaps: there was a very delicately balanced inlining that tipped over the wrong way after this change. * cryptarithm2 and paraffins are caused by #22274, which is a separate issue really. (I.e. the right fix is *not* to make inlining "win" over rules.) So I'm accepting these changes Metric Increase: T10421 T16577 T9961 - - - - - ed4b5885 by Joachim Breitner at 2022-10-10T23:16:11-04:00 Utils.JSON: do not escapeJsonString in ToJson String instance as `escapeJsonString` is used in `renderJSON`, so the `JSString` constructor is meant to carry the unescaped string. - - - - - fbb88740 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Tidy implicit binds We want to put implicit binds into fat interface files, so the easiest thing to do seems to be to treat them uniformly with other binders. - - - - - e058b138 by Matthew Pickering at 2022-10-11T12:48:45-04:00 Interface Files with Core Definitions This commit adds three new flags * -fwrite-if-simplified-core: Writes the whole core program into an interface file * -fbyte-code-and-object-code: Generate both byte code and object code when compiling a file * -fprefer-byte-code: Prefer to use byte-code if it's available when running TH splices. The goal for including the core bindings in an interface file is to be able to restart the compiler pipeline at the point just after simplification and before code generation. Once compilation is restarted then code can be created for the byte code backend. This can significantly speed up start-times for projects in GHCi. HLS already implements its own version of these extended interface files for this reason. Preferring to use byte-code means that we can avoid some potentially expensive code generation steps (see #21700) * Producing object code is much slower than producing bytecode, and normally you need to compile with `-dynamic-too` to produce code in the static and dynamic way, the dynamic way just for Template Haskell execution when using a dynamically linked compiler. * Linking many large object files, which happens once per splice, can be quite expensive compared to linking bytecode. And you can get GHC to compile the necessary byte code so `-fprefer-byte-code` has access to it by using `-fbyte-code-and-object-code`. Fixes #21067 - - - - - 9789ea8e by Matthew Pickering at 2022-10-11T12:48:45-04:00 Teach -fno-code about -fprefer-byte-code This patch teachs the code generation logic of -fno-code about -fprefer-byte-code, so that if we need to generate code for a module which prefers byte code, then we generate byte code rather than object code. We keep track separately which modules need object code and which byte code and then enable the relevant code generation for each. Typically the option will be enabled globally so one of these sets should be empty and we will just turn on byte code or object code generation. We also fix the bug where we would generate code for a module which enables Template Haskell despite the fact it was unecessary. Fixes #22016 - - - - - caced757 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Don't keep exit join points so much We were religiously keeping exit join points throughout, which had some bad effects (#21148, #22084). This MR does two things: * Arranges that exit join points are inhibited from inlining only in /one/ Simplifier pass (right after Exitification). See Note [Be selective about not-inlining exit join points] in GHC.Core.Opt.Exitify It's not a big deal, but it shaves 0.1% off compile times. * Inline used-once non-recursive join points very aggressively Given join j x = rhs in joinrec k y = ....j x.... where this is the only occurrence of `j`, we want to inline `j`. (Unless sm_keep_exits is on.) See Note [Inline used-once non-recursive join points] in GHC.Core.Opt.Simplify.Utils This is just a tidy-up really. It doesn't change allocation, but getting rid of a binding is always good. Very effect on nofib -- some up and down. - - - - - 284cf387 by Simon Peyton Jones at 2022-10-11T12:49:21-04:00 Make SpecConstr bale out less often When doing performance debugging on #22084 / !8901, I found that the algorithm in SpecConstr.decreaseSpecCount was so aggressive that if there were /more/ specialisations available for an outer function, that could more or less kill off specialisation for an /inner/ function. (An example was in nofib/spectral/fibheaps.) This patch makes it a bit more aggressive, by dividing by 2, rather than by the number of outer specialisations. This makes the program bigger, temporarily: T19695(normal) ghc/alloc +11.3% BAD because we get more specialisation. But lots of other programs compile a bit faster and the geometric mean in perf/compiler is 0.0%. Metric Increase: T19695 - - - - - 66af1399 by Cheng Shao at 2022-10-11T12:49:59-04:00 CmmToC: emit explicit tail calls when the C compiler supports it Clang 13+ supports annotating a return statement using the musttail attribute, which guarantees that it lowers to a tail call if compilation succeeds. This patch takes advantage of that feature for the unregisterised code generator. The configure script tests availability of the musttail attribute, if it's available, the Cmm tail calls will become C tail calls that avoids the mini interpreter trampoline overhead. Nothing is affected if the musttail attribute is not supported. Clang documentation: https://clang.llvm.org/docs/AttributeReference.html#musttail - - - - - 7f0decd5 by Matthew Pickering at 2022-10-11T12:50:40-04:00 Don't include BufPos in interface files Ticket #22162 pointed out that the build directory was leaking into the ABI hash of a module because the BufPos depended on the location of the build tree. BufPos is only used in GHC.Parser.PostProcess.Haddock, and the information doesn't need to be propagated outside the context of a module. Fixes #22162 - - - - - dce9f320 by Cheng Shao at 2022-10-11T12:51:19-04:00 CLabel: fix isInfoTableLabel isInfoTableLabel does not take Cmm info table into account. This patch is required for data section layout of wasm32 NCG to work. - - - - - da679f2e by Bodigrim at 2022-10-11T18:02:59-04:00 Extend documentation for Data.List, mostly wrt infinite lists - - - - - 9c099387 by jwaldmann at 2022-10-11T18:02:59-04:00 Expand comment for Data.List.permutations - - - - - d3863cb7 by Bodigrim at 2022-10-11T18:03:37-04:00 ByteArray# is unlifted, not unboxed - - - - - f6260e8b by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Add missing declaration of stg_noDuplicate - - - - - 69ccec2c by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move CString, CStringLen to GHC.Foreign - - - - - f6e8feb4 by Ben Gamari at 2022-10-11T23:45:10-04:00 base: Move IPE helpers to GHC.InfoProv - - - - - 866c736e by Ben Gamari at 2022-10-11T23:45:10-04:00 rts: Refactor IPE tracing support - - - - - 6b0d2022 by Ben Gamari at 2022-10-11T23:45:10-04:00 Refactor IPE initialization Here we refactor the representation of info table provenance information in object code to significantly reduce its size and link-time impact. Specifically, we deduplicate strings and represent them as 32-bit offsets into a common string table. In addition, we rework the registration logic to eliminate allocation from the registration path, which is run from a static initializer where things like allocation are technically undefined behavior (although it did previously seem to work). For similar reasons we eliminate lock usage from registration path, instead relying on atomic CAS. Closes #22077. - - - - - 9b572d54 by Ben Gamari at 2022-10-11T23:45:10-04:00 Separate IPE source file from span The source file name can very often be shared across many IPE entries whereas the source coordinates are generally unique. Separate the two to exploit sharing of the former. - - - - - 27978ceb by Krzysztof Gogolewski at 2022-10-11T23:45:46-04:00 Make Cmm Lint messages use dump style Lint errors indicate an internal error in GHC, so it makes sense to use it instead of the user style. This is consistent with Core Lint and STG Lint: https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Core/Lint.hs#L429 https://gitlab.haskell.org/ghc/ghc/-/blob/22096652/compiler/GHC/Stg/Lint.hs#L144 Fixes #22218. - - - - - 64a390d9 by Bryan Richter at 2022-10-12T09:52:51+03:00 Mark T7919 as fragile On x86_64-linux, T7919 timed out ~30 times during July 2022. And again ~30 times in September 2022. - - - - - 481467a5 by Ben Gamari at 2022-10-12T08:08:37-04:00 rts: Don't hint inlining of appendToRunQueue These hints have resulted in compile-time warnings due to failed inlinings for quite some time. Moreover, it's quite unlikely that inlining them is all that beneficial given that they are rather sizeable functions. Resolves #22280. - - - - - 81915089 by Curran McConnell at 2022-10-12T16:32:26-04:00 remove name shadowing - - - - - 626652f7 by Tamar Christina at 2022-10-12T16:33:13-04:00 winio: do not re-translate input when handle is uncooked - - - - - 5172789a by Charles Taylor at 2022-10-12T16:33:57-04:00 Unrestricted OverloadedLabels (#11671) Implements GHC proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst - - - - - ce293908 by Andreas Klebinger at 2022-10-13T05:58:19-04:00 Add a perf test for the generics code pattern from #21839. This code showed a strong shift between compile time (got worse) and run time (got a lot better) recently which is perfectly acceptable. However it wasn't clear why the compile time regression was happening initially so I'm adding this test to make it easier to track such changes in the future. - - - - - 78ab7afe by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Consolidate initializer/finalizer handling Here we extend our treatment of initializer/finalizer priorities to include ELF and in so doing refactor things to share the implementation with PEi386. As well, I fix a subtle misconception of the ordering behavior for `.ctors`. Fixes #21847. - - - - - 44692713 by Ben Gamari at 2022-10-13T05:58:56-04:00 rts/linker: Add support for .fini sections - - - - - beebf546 by Simon Hengel at 2022-10-13T05:59:37-04:00 Update phases.rst (the name of the original source file is $1, not $2) - - - - - eda6c05e by Finley McIlwaine at 2022-10-13T06:00:17-04:00 Clearer error msg for newtype GADTs with defaulted kind When a newtype introduces GADT eq_specs due to a defaulted RuntimeRep, we detect this and print the error message with explicit kinds. This also refactors newtype type checking to use the new diagnostic infra. Fixes #21447 - - - - - 43ab435a by Pierre Le Marre at 2022-10-14T07:45:43-04:00 Add standard Unicode case predicates isUpperCase and isLowerCase. These predicates use the standard Unicode case properties and are more intuitive than isUpper and isLower. Approved by CLC in https://github.com/haskell/core-libraries-committee/issues/90#issuecomment-1276649403. Fixes #14589 - - - - - aec5a443 by Bodigrim at 2022-10-14T07:46:21-04:00 Add type signatures in where-clause of Data.List.permutations The type of interleave' is very much revealing, otherwise it's extremely tough to decipher. - - - - - ee0deb80 by Ben Gamari at 2022-10-14T18:29:20-04:00 rts: Use pthread_setname_np correctly on Darwin As noted in #22206, pthread_setname_np on Darwin only supports setting the name of the calling thread. Consequently we must introduce a trampoline which first sets the thread name before entering the thread entrypoint. - - - - - 8eff62a4 by Ben Gamari at 2022-10-14T18:29:57-04:00 testsuite: Add test for #22282 This will complement mpickering's more general port of foundation's numerical testsuite, providing a test for the specific case found in #22282. - - - - - 62a55001 by Ben Gamari at 2022-10-14T18:29:57-04:00 ncg/aarch64: Fix sub-word sign extension yet again In adc7f108141a973b6dcb02a7836eed65d61230e8 we fixed a number of issues to do with sign extension in the AArch64 NCG found by ghc/test-primops>. However, this patch made a critical error, assuming that getSomeReg would allocate a fresh register for the result of its evaluation. However, this is not the case as `getSomeReg (CmmReg r) == r`. Consequently, any mutation of the register returned by `getSomeReg` may have unwanted side-effects on other expressions also mentioning `r`. In the fix listed above, this manifested as the registers containing the operands of binary arithmetic operations being incorrectly sign-extended. This resulted in #22282. Sadly, the rather simple structure of the tests generated by `test-primops` meant that this particular case was not exercised. Even more surprisingly, none of our testsuite caught this case. Here we fix this by ensuring that intermediate sign extension is performed in a fresh register. Fixes #22282. - - - - - 54e41b16 by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: ensure we are below maxHeapSize after returning megablocks When the heap is heavily block fragmented the live byte size might be low while the memory usage is high. We want to ensure that heap overflow triggers in these cases. We do so by checking that we can return enough megablocks to under maxHeapSize at the end of GC. - - - - - 29bb90db by Teo Camarasu at 2022-10-15T18:09:24+01:00 rts: trigger a major collection if megablock usage exceeds maxHeapSize When the heap is suffering from block fragmentation, live bytes might be low while megablock usage is high. If megablock usage exceeds maxHeapSize, we want to trigger a major GC to try to recover some memory otherwise we will die from a heapOverflow at the end of the GC. Fixes #21927 - - - - - 4a4641ca by Teo Camarasu at 2022-10-15T18:11:29+01:00 Add realease note for #21927 - - - - - c1e5719a by Sebastian Graf at 2022-10-17T11:58:46-04:00 DmdAnal: Look through unfoldings of DataCon wrappers (#22241) Previously, the demand signature we computed upfront for a DataCon wrapper lacked boxity information and was much less precise than the demand transformer for the DataCon worker. In this patch we adopt the solution to look through unfoldings of DataCon wrappers during Demand Analysis, but still attach a demand signature for other passes such as the Simplifier. See `Note [DmdAnal for DataCon wrappers]` for more details. Fixes #22241. - - - - - 8c72411d by Gergo ERDI at 2022-10-17T19:20:04-04:00 Add `Enum (Down a)` instance that swaps `succ` and `pred` See https://github.com/haskell/core-libraries-committee/issues/51 for discussion. The key points driving the implementation are the following two ideas: * For the `Int` type, `comparing (complement @Int)` behaves exactly as an order-swapping `compare @Int`. * `enumFrom @(Down a)` can be implemented in terms of `enumFromThen @a`, if only the corner case of starting at the very end is handled specially - - - - - d80ad2f4 by Alan Zimmerman at 2022-10-17T19:20:40-04:00 Update the check-exact infrastructure to match ghc-exactprint GHC tests the exact print annotations using the contents of utils/check-exact. The same functionality is provided via https://github.com/alanz/ghc-exactprint The latter was updated to ensure it works with all of the files on hackage when 9.2 was released, as well as updated to ensure users of the library could work properly (apply-refact, retrie, etc). This commit brings the changes from ghc-exactprint into GHC/utils/check-exact, adapting for the changes to master. Once it lands, it will form the basis for the 9.4 version of ghc-exactprint. See also discussion around this process at #21355 - - - - - 08ab5419 by Andreas Klebinger at 2022-10-17T19:21:15-04:00 Avoid allocating intermediate lists for non recursive bindings. We do so by having an explicit folding function that doesn't need to allocate intermediate lists first. Fixes #22196 - - - - - ff6275ef by Andreas Klebinger at 2022-10-17T19:21:52-04:00 Testsuite: Add a new tables_next_to_code predicate. And use it to avoid T21710a failing on non-tntc archs. Fixes #22169 - - - - - abb82f38 by Eric Lindblad at 2022-10-17T19:22:33-04:00 example rewrite - - - - - 39beb801 by Eric Lindblad at 2022-10-17T19:22:33-04:00 remove redirect - - - - - 0d9fb651 by Eric Lindblad at 2022-10-17T19:22:33-04:00 use heredoc - - - - - 0fa2d185 by Matthew Pickering at 2022-10-17T19:23:10-04:00 testsuite: Fix typo when setting llvm_ways Since 2014 llvm_ways has been set to [] so none of the tests which use only_ways(llvm_ways) have worked as expected. Hopefully the tests still pass with this typo fix! - - - - - ced664a2 by Krzysztof Gogolewski at 2022-10-17T19:23:10-04:00 Fix T15155l not getting -fllvm - - - - - 0ac60423 by Andreas Klebinger at 2022-10-18T03:34:47-04:00 Fix GHCis interaction with tag inference. I had assumed that wrappers were not inlined in interactive mode. Meaning we would always execute the compiled wrapper which properly takes care of upholding the strict field invariant. This turned out to be wrong. So instead we now run tag inference even when we generate bytecode. In that case only for correctness not performance reasons although it will be still beneficial for runtime in some cases. I further fixed a bug where GHCi didn't tag nullary constructors properly when used as arguments. Which caused segfaults when calling into compiled functions which expect the strict field invariant to be upheld. Fixes #22042 and #21083 ------------------------- Metric Increase: T4801 Metric Decrease: T13035 ------------------------- - - - - - 9ecd1ac0 by M Farkas-Dyck at 2022-10-18T03:35:38-04:00 Make `Functor` a superclass of `TrieMap`, which lets us derive the `map` functions. - - - - - f60244d7 by Ben Gamari at 2022-10-18T03:36:15-04:00 configure: Bump minimum bootstrap GHC version Fixes #22245 - - - - - ba4bd4a4 by Matthew Pickering at 2022-10-18T03:36:55-04:00 Build System: Remove out-of-date comment about make build system Both make and hadrian interleave compilation of modules of different modules and don't respect the package boundaries. Therefore I just remove this comment which points out this "difference". Fixes #22253 - - - - - e1bbd368 by Matthew Pickering at 2022-10-18T16:15:49+02:00 Allow configuration of error message printing This MR implements the idea of #21731 that the printing of a diagnostic method should be configurable at the printing time. The interface of the `Diagnostic` class is modified from: ``` class Diagnostic a where diagnosticMessage :: a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` to ``` class Diagnostic a where type DiagnosticOpts a defaultDiagnosticOpts :: DiagnosticOpts a diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc diagnosticReason :: a -> DiagnosticReason diagnosticHints :: a -> [GhcHint] ``` and so each `Diagnostic` can implement their own configuration record which can then be supplied by a client in order to dictate how to print out the error message. At the moment this only allows us to implement #21722 nicely but in future it is more natural to separate the configuration of how much information we put into an error message and how much we decide to print out of it. Updates Haddock submodule - - - - - 99dc3e3d by Matthew Pickering at 2022-10-18T16:15:53+02:00 Add -fsuppress-error-contexts to disable printing error contexts in errors In many development environments, the source span is the primary means of seeing what an error message relates to, and the In the expression: and In an equation for: clauses are not particularly relevant. However, they can grow to be quite long, which can make the message itself both feel overwhelming and interact badly with limited-space areas. It's simple to implement this flag so we might as well do it and give the user control about how they see their messages. Fixes #21722 - - - - - 5b3a992f by Dai at 2022-10-19T10:45:45-04:00 Add VecSlot for unboxed sums of SIMD vectors This patch adds the missing `VecRep` case to `primRepSlot` function and all the necessary machinery to carry this new `VecSlot` through code generation. This allows programs involving unboxed sums of SIMD vectors to be written and compiled. Fixes #22187 - - - - - 6d7d9181 by sheaf at 2022-10-19T10:45:45-04:00 Remove SIMD conversions This patch makes it so that packing/unpacking SIMD vectors always uses the right sized types, e.g. unpacking a Word16X4# will give a tuple of Word16#s. As a result, we can get rid of the conversion instructions that were previously required. Fixes #22296 - - - - - 3be48877 by sheaf at 2022-10-19T10:45:45-04:00 Cmm Lint: relax SIMD register assignment check As noted in #22297, SIMD vector registers can be used to store different kinds of values, e.g. xmm1 can be used both to store integer and floating point values. The Cmm type system doesn't properly account for this, so we weaken the Cmm register assignment lint check to only compare widths when comparing a vector type with its allocated vector register. - - - - - f7b7a312 by sheaf at 2022-10-19T10:45:45-04:00 Disable some SIMD tests on non-X86 architectures - - - - - 83638dce by M Farkas-Dyck at 2022-10-19T10:46:29-04:00 Scrub various partiality involving lists (again). Lets us avoid some use of `head` and `tail`, and some panics. - - - - - c3732c62 by M Farkas-Dyck at 2022-10-19T10:47:13-04:00 Enforce invariant of `ListBag` constructor. - - - - - 488d3631 by Bodigrim at 2022-10-19T10:47:52-04:00 More precise types for fields of OverlappingInstances and UnsafeOverlap in TcSolverReportMsg It's clear from asserts in `GHC.Tc.Errors` that `overlappingInstances_matches` and `unsafeOverlapped` are supposed to be non-empty, and `unsafeOverlap_matches` contains a single instance, but these invariants are immediately lost afterwards and not encoded in types. This patch enforces the invariants by pattern matching and makes types more precise, avoiding asserts and partial functions such as `head`. - - - - - 607ce263 by sheaf at 2022-10-19T10:47:52-04:00 Rename unsafeOverlap_matches -> unsafeOverlap_match in UnsafeOverlap - - - - - 1fab9598 by Matthew Pickering at 2022-10-19T10:48:29-04:00 Add SpliceTypes test for hie files This test checks that typed splices and quotes get the right type information when used in hiefiles. See #21619 - - - - - a8b52786 by Jan Hrček at 2022-10-19T10:49:09-04:00 Small language fixes in 'Using GHC' - - - - - 1dab1167 by Gergő Érdi at 2022-10-19T10:49:51-04:00 Fix typo in `Opt_WriteIfSimplifiedCore`'s name - - - - - b17cfc9c by sheaf at 2022-10-19T10:50:37-04:00 TyEq:N assertion: only for saturated applications The assertion that checked TyEq:N in canEqCanLHSFinish incorrectly triggered in the case of an unsaturated newtype TyCon heading the RHS, even though we can't unwrap such an application. Now, we only trigger an assertion failure in case of a saturated application of a newtype TyCon. Fixes #22310 - - - - - ff6f2228 by M Farkas-Dyck at 2022-10-20T16:15:51-04:00 CoreToStg: purge `DynFlags`. - - - - - 1ebd521f by Matthew Pickering at 2022-10-20T16:16:27-04:00 ci: Make fat014 test robust For some reason I implemented this as a makefile test rather than a ghci_script test. Hopefully making it a ghci_script test makes it more robust. Fixes #22313 - - - - - 8cd6f435 by Curran McConnell at 2022-10-21T02:58:01-04:00 remove a no-warn directive from GHC.Cmm.ContFlowOpt This patch is motivated by the desire to remove the {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} directive at the top of GHC.Cmm.ContFlowOpt. (Based on the text in this coding standards doc, I understand it's a goal of the project to remove such directives.) I chose this task because I'm a new contributor to GHC, and it seemed like a good way to get acquainted with the patching process. In order to address the warning that arose when I removed the no-warn directive, I added a case to removeUnreachableBlocksProc to handle the CmmData constructor. Clearly, since this partial function has not been erroring out in the wild, its inputs are always in practice wrapped by the CmmProc constructor. Therefore the CmmData case is handled by a precise panic (which is an improvement over the partial pattern match from before). - - - - - a2af7c4c by Nicolas Trangez at 2022-10-21T02:58:39-04:00 build: get rid of `HAVE_TIME_H` As advertized by `autoreconf`: > All current systems provide time.h; it need not be checked for. Hence, remove the check for it in `configure.ac` and remove conditional inclusion of the header in `HAVE_TIME_H` blocks where applicable. The `time.h` header was being included in various source files without a `HAVE_TIME_H` guard already anyway. - - - - - 25cdc630 by Nicolas Trangez at 2022-10-21T02:58:39-04:00 rts: remove use of `TIME_WITH_SYS_TIME` `autoreconf` will insert an `m4_warning` when the obsolescent `AC_HEADER_TIME` macro is used: > Update your code to rely only on HAVE_SYS_TIME_H, > then remove this warning and the obsolete code below it. > All current systems provide time.h; it need not be checked for. > Not all systems provide sys/time.h, but those that do, all allow > you to include it and time.h simultaneously. Presence of `sys/time.h` was already checked in an earlier `AC_CHECK_HEADERS` invocation, so `AC_HEADER_TIME` can be dropped and guards relying on `TIME_WITH_SYS_TIME` can be reworked to (unconditionally) include `time.h` and include `sys/time.h` based on `HAVE_SYS_TIME_H`. Note the documentation of `AC_HEADER_TIME` in (at least) Autoconf 2.67 says > This macro is obsolescent, as current systems can include both files > when they exist. New programs need not use this macro. - - - - - 1fe7921c by Eric Lindblad at 2022-10-21T02:59:21-04:00 runhaskell - - - - - e3b3986e by David Feuer at 2022-10-21T03:00:00-04:00 Document how to quote certain names with spaces Quoting a name for Template Haskell is a bit tricky if the second character of that name is a single quote. The User's Guide falsely claimed that it was impossible. Document how to do it. Fixes #22236 - - - - - 0eba81e8 by Krzysztof Gogolewski at 2022-10-21T03:00:00-04:00 Fix syntax - - - - - a4dbd102 by Ben Gamari at 2022-10-21T09:11:12-04:00 Fix manifest filename when writing Windows .rc files As noted in #12971, we previously used `show` which resulted in inappropriate escaping of non-ASCII characters. - - - - - 30f0d9a9 by Ben Gamari at 2022-10-21T09:11:12-04:00 Write response files in UTF-8 on Windows This reverts the workaround introduced in f63c8ef33ec9666688163abe4ccf2d6c0428a7e7, which taught our response file logic to write response files with the `latin1` encoding to workaround `gcc`'s lacking Unicode support. This is now no longer necessary (and in fact actively unhelpful) since we rather use Clang. - - - - - b8304648 by M Farkas-Dyck at 2022-10-21T09:11:56-04:00 Scrub some partiality in `GHC.Core.Opt.Simplify.Utils`. - - - - - 09ec7de2 by Teo Camarasu at 2022-10-21T13:23:07-04:00 template-haskell: Improve documentation of strictness annotation types Before it was undocumentated that DecidedLazy can be returned by reifyConStrictness for strict fields. This can happen when a field has an unlifted type or its the single field of a newtype constructor. Fixes #21380 - - - - - 88172069 by M Farkas-Dyck at 2022-10-21T13:23:51-04:00 Delete `eqExpr`, since GHC 9.4 has been released. - - - - - 86e6549e by Ömer Sinan Ağacan at 2022-10-22T07:41:30-04:00 Introduce a standard thunk for allocating strings Currently for a top-level closure in the form hey = unpackCString# x we generate code like this: Main.hey_entry() // [R1] { info_tbls: [(c2T4, label: Main.hey_info rep: HeapRep static { Thunk } srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } {offset c2T4: // global _rqm::P64 = R1; if ((Sp + 8) - 24 < SpLim) (likely: False) goto c2T5; else goto c2T6; c2T5: // global R1 = _rqm::P64; call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8; c2T6: // global (_c2T1::I64) = call "ccall" arg hints: [PtrHint, PtrHint] result hints: [PtrHint] newCAF(BaseReg, _rqm::P64); if (_c2T1::I64 == 0) goto c2T3; else goto c2T2; c2T3: // global call (I64[_rqm::P64])() args: 8, res: 0, upd: 8; c2T2: // global I64[Sp - 16] = stg_bh_upd_frame_info; I64[Sp - 8] = _c2T1::I64; R2 = hey1_r2Gg_bytes; Sp = Sp - 16; call GHC.CString.unpackCString#_info(R2) args: 24, res: 0, upd: 24; } } This code is generated for every string literal. Only difference between top-level closures like this is the argument for the bytes of the string (hey1_r2Gg_bytes in the code above). With this patch we introduce a standard thunk in the RTS, called stg_MK_STRING_info, that does what `unpackCString# x` does, except it gets the bytes address from the payload. Using this, for the closure above, we generate this: Main.hey_closure" { Main.hey_closure: const stg_MK_STRING_info; const 0; // padding for indirectee const 0; // static link const 0; // saved info const hey1_r1Gg_bytes; // the payload } This is much smaller in code. Metric Decrease: T10421 T11195 T12150 T12425 T16577 T18282 T18698a T18698b Co-Authored By: Ben Gamari <ben at well-typed.com> - - - - - 1937016b by Andreas Klebinger at 2022-10-22T07:42:06-04:00 hadrian: Improve error for wrong key/value errors. - - - - - 11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00 Class layout info (#19623) Updates the haddock submodule. - - - - - f0a90c11 by Sven Tennie at 2022-10-24T00:12:51-04:00 Pin used way for test cloneMyStack (#21977) cloneMyStack checks the order of closures on the cloned stack. This may change for different ways. Thus we limit this test to one way (normal). - - - - - 0614e74d by Aaron Allen at 2022-10-24T17:11:21+02:00 Convert Diagnostics in GHC.Tc.Gen.Splice (#20116) Replaces uses of `TcRnUnknownMessage` in `GHC.Tc.Gen.Splice` with structured diagnostics. closes #20116 - - - - - 8d2dbe2d by Andreas Klebinger at 2022-10-24T15:59:41-04:00 Improve stg lint for unboxed sums. It now properly lints cases where sums end up distributed over multiple args after unarise. Fixes #22026. - - - - - 41406da5 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Fix binder-swap bug This patch fixes #21229 properly, by avoiding doing a binder-swap on dictionary Ids. This is pretty subtle, and explained in Note [Care with binder-swap on dictionaries]. Test is already in simplCore/should_run/T21229 This allows us to restore a feature to the specialiser that we had to revert: see Note [Specialising polymorphic dictionaries]. (This is done in a separate patch.) I also modularised things, using a new function scrutBinderSwap_maybe in all the places where we are (effectively) doing a binder-swap, notably * Simplify.Iteration.addAltUnfoldings * SpecConstr.extendCaseBndrs In Simplify.Iteration.addAltUnfoldings I also eliminated a guard Many <- idMult case_bndr because we concluded, in #22123, that it was doing no good. - - - - - 5a997e16 by Simon Peyton Jones at 2022-10-25T18:07:03-04:00 Make the specialiser handle polymorphic specialisation Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164 - - - - - 7f203d00 by Sylvain Henry at 2022-10-25T18:07:43-04:00 Numeric exceptions: replace FFI calls with primops ghc-bignum needs a way to raise numerical exceptions defined in base package. At the time we used FFI calls into primops defined in the RTS. These FFI calls had to be wrapped into hacky bottoming functions because "foreign import prim" syntax doesn't support giving a bottoming demand to the foreign call (cf #16929). These hacky wrapper functions trip up the JavaScript backend (#21078) because they are polymorphic in their return type. This commit replaces them with primops very similar to raise# but raising predefined exceptions. - - - - - 0988a23d by Sylvain Henry at 2022-10-25T18:08:24-04:00 Enable popcount rewrite rule when cross-compiling The comment applies only when host's word size < target's word size. So we can relax the guard. - - - - - a2f53ac8 by Sylvain Henry at 2022-10-25T18:09:05-04:00 Add GHC.SysTools.Cpp module Move doCpp out of the driver to be able to use it in the upcoming JS backend. - - - - - 1fd7f201 by Ben Gamari at 2022-10-25T18:09:42-04:00 llvm-targets: Add datalayouts for big-endian AArch64 targets Fixes #22311. Thanks to @zeldin for the patch. - - - - - f5a486eb by Krzysztof Gogolewski at 2022-10-25T18:10:19-04:00 Cleanup String/FastString conversions Remove unused mkPtrString and isUnderscoreFS. We no longer use mkPtrString since 1d03d8bef96. Remove unnecessary conversions between FastString and String and back. - - - - - f7bfb40c by Ryan Scott at 2022-10-26T00:01:24-04:00 Broaden the in-scope sets for liftEnvSubst and composeTCvSubst This patch fixes two distinct (but closely related) buglets that were uncovered in #22235: * `liftEnvSubst` used an empty in-scope set, which was not wide enough to cover the variables in the range of the substitution. This patch fixes this by populating the in-scope set from the free variables in the range of the substitution. * `composeTCvSubst` applied the first substitution argument to the range of the second substitution argument, but the first substitution's in-scope set was not wide enough to cover the range of the second substutition. We similarly fix this issue in this patch by widening the first substitution's in-scope set before applying it. Fixes #22235. - - - - - 0270cc54 by Vladislav Zavialov at 2022-10-26T00:02:01-04:00 Introduce TcRnWithHsDocContext (#22346) Before this patch, GHC used withHsDocContext to attach an HsDocContext to an error message: addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) The problem with this approach is that it only works with TcRnUnknownMessage. But could we attach an HsDocContext to a structured error message in a generic way? This patch solves the problem by introducing a new constructor to TcRnMessage: data TcRnMessage where ... TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage ... - - - - - 9ab31f42 by Sylvain Henry at 2022-10-26T09:32:20+02:00 Testsuite: more precise test options Necessary for newer cross-compiling backends (JS, Wasm) that don't support TH yet. - - - - - f60a1a62 by Vladislav Zavialov at 2022-10-26T12:17:14-04:00 Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115) When faced with VDQ in the type of a term, GHC generates the following error message: Illegal visible, dependent quantification in the type of a term (GHC does not yet support this) Prior to this patch, there were two ways this message could have been generated and represented: 1. with the dedicated constructor TcRnVDQInTermType (see check_type in GHC.Tc.Validity) 2. with the transitional constructor TcRnUnknownMessage (see noNestedForallsContextsErr in GHC.Rename.Utils) Not only this led to duplication of code generating the final SDoc, it also made it tricky to track the origin of the error message. This patch fixes the problem by using TcRnVDQInTermType exclusively. - - - - - 223e159d by Owen Shepherd at 2022-10-27T13:54:33-04:00 Remove source location information from interface files This change aims to minimize source location information leaking into interface files, which makes ABI hashes dependent on the build location. The `Binary (Located a)` instance has been removed completely. It seems that the HIE interface still needs the ability to serialize SrcSpans, but by wrapping the instances, it should be a lot more difficult to inadvertently add source location information. - - - - - 22e3deb9 by Simon Peyton Jones at 2022-10-27T13:55:37-04:00 Add missing dict binds to specialiser I had forgotten to add the auxiliary dict bindings to the /unfolding/ of a specialised function. This caused #22358, which reports failures when compiling Hackage packages fixed-vector indexed-traversable Regression test T22357 is snarfed from indexed-traversable - - - - - a8ed36f9 by Evan Relf at 2022-10-27T13:56:36-04:00 Fix broken link to `async` package - - - - - 750846cd by Zubin Duggal at 2022-10-28T00:49:22-04:00 Pass correct package db when testing stage1. It used to pick the db for stage-2 which obviously didn't work. - - - - - ad612f55 by Krzysztof Gogolewski at 2022-10-28T00:50:00-04:00 Minor SDoc-related cleanup * Rename pprCLabel to pprCLabelStyle, and use the name pprCLabel for a function using CStyle (analogous to pprAsmLabel) * Move LabelStyle to the CLabel module, it no longer needs to be in Outputable. * Move calls to 'text' right next to literals, to make sure the text/str rule is triggered. * Remove FastString/String roundtrip in Tc.Deriv.Generate * Introduce showSDocForUser', which abstracts over a pattern in GHCi.UI - - - - - c2872f3f by Bryan Richter at 2022-10-28T11:36:34+03:00 CI: Don't run lint-submods on nightly Fixes #22325 - - - - - 270037fa by Hécate Moonlight at 2022-10-28T19:46:12-04:00 Start the deprecation process for GHC.Pack - - - - - d45d8cb3 by M Farkas-Dyck at 2022-11-01T12:47:21-04:00 Drop a kludge for binutils<2.17, which is now over 10 years old. - - - - - 8ee8b418 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: `name` argument of `createOSThread` can be `const` Since we don't intend to ever change the incoming string, declare this to be true. Also, in the POSIX implementation, the argument is no longer `STG_UNUSED` (since ee0deb8054da2a597fc5624469b4c44fd769ada2) in any code path. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 - - - - - 13b5f102 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix lifetime of `start_thread`s `name` value Since, unlike the code in ee0deb8054da2^, usage of the `name` value passed to `createOSThread` now outlives said function's lifetime, and could hence be released by the caller by the time the new thread runs `start_thread`, it needs to be copied. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2#note_460080 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - edd175c9 by Nicolas Trangez at 2022-11-01T12:47:58-04:00 rts: fix OS thread naming in ticker Since ee0deb805, the use of `pthread_setname_np` on Darwin was fixed when invoking `createOSThread`. However, the 'ticker' has some thread-creation code which doesn't rely on `createOSThread`, yet also uses `pthread_setname_np`. This patch enforces all thread creation to go through a single function, which uses the (correct) thread-naming code introduced in ee0deb805. See: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0deb8054da2a597fc5624469b4c44fd769ada2 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22206 See: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9066 - - - - - b7a00113 by Krzysztof Gogolewski at 2022-11-01T12:48:35-04:00 Typo: rename -fwrite-if-simplfied-core to -fwrite-if-simplified-core - - - - - 30e625e6 by Vladislav Zavialov at 2022-11-01T12:49:10-04:00 ThToHs: fix overzealous parenthesization Before this patch, when converting from TH.Exp to LHsExpr GhcPs, the compiler inserted more parentheses than required: ((f a) (b + c)) d This was happening because the LHS of the function application was parenthesized as if it was the RHS. Now we use funPrec and appPrec appropriately and produce sensibly parenthesized expressions: f a (b + c) d I also took the opportunity to remove the special case for LamE, which was not special at all and simply duplicated code. - - - - - 0560821f by Simon Peyton Jones at 2022-11-01T12:49:47-04:00 Add accurate skolem info when quantifying Ticket #22379 revealed that skolemiseQuantifiedTyVar was dropping the passed-in skol_info on the floor when it encountered a SkolemTv. Bad! Several TyCons thereby share a single SkolemInfo on their binders, which lead to bogus error reports. - - - - - 38d19668 by Fendor at 2022-11-01T12:50:25-04:00 Expose UnitEnvGraphKey for user-code - - - - - 77e24902 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Shrink test case for #22357 Ryan Scott offered a cut-down repro case (60 lines instead of more than 700 lines) - - - - - 4521f649 by Simon Peyton Jones at 2022-11-01T12:51:00-04:00 Add two tests for #17366 - - - - - 6b400d26 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_NORETURN` Instead of sprinkling the codebase with `GNU(C3)_ATTRIBUTE(__noreturn__)`, add a `STG_NORETURN` macro (for, basically, the same thing) similar to `STG_UNUSED` and others, and update the code to use this macro where applicable. - - - - - f9638654 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: consistently use `STG_UNUSED` - - - - - 81a58433 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_USED` Similar to `STG_UNUSED`, have a specific macro for `__attribute__(used)`. - - - - - 41e1f748 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: introduce (and use) `STG_MALLOC` Instead of using `GNUC3_ATTRIBUTE(__malloc__)`, provide a `STG_MALLOC` macro definition and use it instead. - - - - - 3a9a8bde by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `STG_UNUSED` - - - - - 9ab999de by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: specify deallocator of allocating functions This patch adds a new `STG_MALLOC1` macro (and its counterpart `STG_MALLOC2` for completeness) which allows to specify the deallocation function to be used with allocations of allocating functions, and applies it to `stg*allocBytes`. It also fixes a case where `free` was used to free up an `stgMallocBytes` allocation, found by the above change. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-malloc-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 81c0c7c9 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: use `alloc_size` attribute This patch adds the `STG_ALLOC_SIZE1` and `STG_ALLOC_SIZE2` macros which allow to set the `alloc_size` attribute on functions, when available. See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-alloc_005fsize-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - 99a1d896 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: add and use `STG_RETURNS_NONNULL` See: https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html#index-returns_005fnonnull-function-attribute See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - c235b399 by Nicolas Trangez at 2022-11-02T12:06:48-04:00 rts: tag `stgStrndup` as `STG_MALLOC` See: https://gitlab.haskell.org/ghc/ghc/-/issues/22381 - - - - - ed81b448 by Oleg Grenrus at 2022-11-02T12:07:27-04:00 Move Symbol implementation note out of public haddock - - - - - 284fd39c by Ben Gamari at 2022-11-03T01:58:54-04:00 gen-dll: Drop it Currently it is only used by the make build system, which is soon to be retired, and it has not built since 41cf758b. We may need to reintroduce it when dynamic-linking support is introduced on Windows, but we will cross that bridge once we get there. Fixes #21753. - - - - - 24f4f54f by Matthew Pickering at 2022-11-03T01:59:30-04:00 Port foundation numeric tests to GHC testsuite This commit ports the numeric tests which found a regression in GHC-9.4. https://github.com/haskell-foundation/foundation/issues/571 Included in the commit is a simple random number generator and simplified QuickCheck implementation. In future these could be factored out of this standalone file and reused as a general purpose library which could be used for other QuickCheck style tests in the testsuite. See #22282 - - - - - d51bf7bd by M Farkas-Dyck at 2022-11-03T02:00:13-04:00 git: ignore HIE files. Cleans up git status if one sets -fwrite-ide-info in hadrian/ghci. - - - - - a9fc15b1 by Matthew Pickering at 2022-11-03T02:00:49-04:00 Clarify status of bindings in WholeCoreBindings Gergo points out that these bindings are tidied, rather than prepd as the variable claims. Therefore we update the name of the variable to reflect reality and add a comment to the data type to try to erase any future confusion. Fixes #22307 - - - - - 634da448 by Bodigrim at 2022-11-03T21:25:02+00:00 Fix haddocks for GHC.IORef - - - - - 31125154 by Andreas Klebinger at 2022-11-03T23:08:09-04:00 Export pprTrace and friends from GHC.Prelude. Introduces GHC.Prelude.Basic which can be used in modules which are a dependency of the ppr code. - - - - - bdc8cbb3 by Bryan Richter at 2022-11-04T10:27:37+02:00 CI: Allow hadrian-ghc-in-ghci to run in nightlies Since lint-submods doesn't run in nightlies, hadrian-ghc-in-ghci needs to mark it as "optional" so it can run if the job doesn't exist. Fixes #22396. - - - - - 3c0e3793 by Krzysztof Gogolewski at 2022-11-05T00:29:57-04:00 Minor refactor around FastStrings Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph. - - - - - e41b2f55 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump unix submodule to 2.8.0.0 Also bumps process and ghc-boot bounds on unix. For hadrian, when cross-compiling, we add -Wwarn=unused-imports -Wwarn=unused-top-binds to validation flavour. Further fixes in unix and/or hsc2hs is needed to make it completely free of warnings; for the time being, this change is needed to unblock other cross-compilation related work. - - - - - 42938a58 by Matthew Pickering at 2022-11-05T14:18:10+00:00 Bump Win32 submodule to 2.13.4.0 Fixes #22098 - - - - - e7372bc5 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump ci-images revision ci-images has recently been updated, including changes needed for wasm32-wasi CI. - - - - - 88cb9492 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump gmp-tarballs submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 69427ce9 by Cheng Shao at 2022-11-06T13:15:22+00:00 Bump haskeline submodule Includes a fix for wasm support, doesn't impact other targets. - - - - - 5fe11fe6 by Carter Schonwald at 2022-11-07T13:22:14-05:00 bump llvm upper bound - - - - - 68f49874 by M Farkas-Dyck at 2022-11-08T12:53:55-05:00 Define `Infinite` list and use where appropriate. Also add perf test for infinite list fusion. In particular, in `GHC.Core`, often we deal with infinite lists of roles. Also in a few locations we deal with infinite lists of names. Thanks to simonpj for helping to write the Note [Fusion for `Infinite` lists]. - - - - - ce726cd2 by Ross Paterson at 2022-11-08T12:54:34-05:00 Fix TypeData issues (fixes #22315 and #22332) There were two bugs here: 1. Treating type-level constructors as PromotedDataCon doesn't always work, in particular because constructors promoted via DataKinds are called both T and 'T. (Tests T22332a, T22332b, T22315a, T22315b) Fix: guard these cases with isDataKindsPromotedDataCon. 2. Type-level constructors were sent to the code generator, producing things like constructor wrappers. (Tests T22332a, T22332b) Fix: test for them in isDataTyCon. Other changes: * changed the marking of "type data" DataCon's as suggested by SPJ. * added a test TDGADT for a type-level GADT. * comment tweaks * change tcIfaceTyCon to ignore IfaceTyConInfo, so that IfaceTyConInfo is used only for pretty printing, not for typechecking. (SPJ) - - - - - 132f8908 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Clarify msum/asum documentation - - - - - bb5888c5 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Add example for (<$) - - - - - 080fffa1 by Jade Lovelace at 2022-11-08T12:55:18-05:00 Document what Alternative/MonadPlus instances actually do - - - - - 92ccb8de by Giles Anderson at 2022-11-09T09:27:52-05:00 Use TcRnDiagnostic in GHC.Tc.TyCl.Instance (#20117) The following `TcRnDiagnostic` messages have been introduced: TcRnWarnUnsatisfiedMinimalDefinition TcRnMisplacedInstSig TcRnBadBootFamInstDeclErr TcRnIllegalFamilyInstance TcRnAssocInClassErr TcRnBadFamInstDecl TcRnNotOpenFamily - - - - - 90c5abd4 by Hécate Moonlight at 2022-11-09T09:28:30-05:00 GHCi tags generation phase 2 see #19884 - - - - - f9f17b68 by Simon Peyton Jones at 2022-11-10T12:20:03+00:00 Fire RULES in the Specialiser The Specialiser has, for some time, fires class-op RULES in the specialiser itself: see Note [Specialisation modulo dictionary selectors] This MR beefs it up a bit, so that it fires /all/ RULES in the specialiser, not just class-op rules. See Note [Fire rules in the specialiser] The result is a bit more specialisation; see test simplCore/should_compile/T21851_2 This pushed me into a bit of refactoring. I made a new data types GHC.Core.Rules.RuleEnv, which combines - the several source of rules (local, home-package, external) - the orphan-module dependencies in a single record for `getRules` to consult. That drove a bunch of follow-on refactoring, including allowing me to remove cr_visible_orphan_mods from the CoreReader data type. I moved some of the RuleBase/RuleEnv stuff into GHC.Core.Rule. The reorganisation in the Simplifier improve compile times a bit (geom mean -0.1%), but T9961 is an outlier Metric Decrease: T9961 - - - - - 2b3d0bee by Simon Peyton Jones at 2022-11-10T12:21:13+00:00 Make indexError work better The problem here is described at some length in Note [Boxity for bottoming functions] and Note [Reboxed crud for bottoming calls] in GHC.Core.Opt.DmdAnal. This patch adds a SPECIALISE pragma for indexError, which makes it much less vulnerable to the problem described in these Notes. (This came up in another line of work, where a small change made indexError do reboxing (in nofib/spectral/simple/table_sort) that didn't happen before my change. I've opened #22404 to document the fagility. - - - - - 399e921b by Simon Peyton Jones at 2022-11-10T12:21:14+00:00 Fix DsUselessSpecialiseForClassMethodSelector msg The error message for DsUselessSpecialiseForClassMethodSelector was just wrong (a typo in some earlier work); trivial fix - - - - - dac0682a by Sebastian Graf at 2022-11-10T21:16:01-05:00 WorkWrap: Unboxing unboxed tuples is not always useful (#22388) See Note [Unboxing through unboxed tuples]. Fixes #22388. - - - - - 1230c268 by Sebastian Graf at 2022-11-10T21:16:01-05:00 Boxity: Handle argument budget of unboxed tuples correctly (#21737) Now Budget roughly tracks the combined width of all arguments after unarisation. See the changes to `Note [Worker argument budgets]`. Fixes #21737. - - - - - 2829fd92 by Cheng Shao at 2022-11-11T00:26:54-05:00 autoconf: check getpid getuid raise This patch adds checks for getpid, getuid and raise in autoconf. These functions are absent in wasm32-wasi and thus needs to be checked. - - - - - f5dfd1b4 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add -Wwarn only for cross-compiling unix - - - - - 2e6ab453 by Cheng Shao at 2022-11-11T00:26:55-05:00 hadrian: add targetSupportsThreadedRts flag This patch adds a targetSupportsThreadedRts flag to indicate whether the target supports the threaded rts at all, different from existing targetSupportsSMP that checks whether -N is supported by the RTS. All existing flavours have also been updated accordingly to respect this flags. Some targets (e.g. wasm32-wasi) does not support the threaded rts, therefore this flag is needed for the default flavours to work. It makes more sense to have proper autoconf logic to check for threading support, but for the time being, we just set the flag to False iff the target is wasm32. - - - - - 8104f6f5 by Cheng Shao at 2022-11-11T00:26:55-05:00 Fix Cmm symbol kind - - - - - b2035823 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add the two key graph modules from Martin Erwig's FGL Martin Erwig's FGL (Functional Graph Library) provides an "inductive" representation of graphs. A general graph has labeled nodes and labeled edges. The key operation on a graph is to decompose it by removing one node, together with the edges that connect the node to the rest of the graph. There is also an inverse composition operation. The decomposition and composition operations make this representation of graphs exceptionally well suited to implement graph algorithms in which the graph is continually changing, as alluded to in #21259. This commit adds `GHC.Data.Graph.Inductive.Graph`, which defines the interface, and `GHC.Data.Graph.Inductive.PatriciaTree`, which provides an implementation. Both modules are taken from `fgl-5.7.0.3` on Hackage, with these changes: - Copyright and license text have been copied into the files themselves, not stored separately. - Some calls to `error` have been replaced with calls to `panic`. - Conditional-compilation support for older versions of GHC, `containers`, and `base` has been removed. - - - - - 3633a5f5 by Norman Ramsey at 2022-11-11T00:26:55-05:00 add new modules for reducibility and WebAssembly translation - - - - - df7bfef8 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add support for the wasm32-wasi target tuple This patch adds the wasm32-wasi tuple support to various places in the tree: autoconf, hadrian, ghc-boot and also the compiler. The codegen logic will come in subsequent commits. - - - - - 32ae62e6 by Cheng Shao at 2022-11-11T00:26:55-05:00 deriveConstants: parse .ll output for wasm32 due to broken nm This patch makes deriveConstants emit and parse an .ll file when targeting wasm. It's a necessary workaround for broken llvm-nm on wasm, which isn't capable of reporting correct constant values when parsing an object. - - - - - 07e92c92 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: workaround cmm's improper variadic ccall breaking wasm32 typechecking Unlike other targets, wasm requires the function signature of the call site and callee to strictly match. So in Cmm, when we call a C function that actually returns a value, we need to add an _unused local variable to receive it, otherwise type error awaits. An even bigger problem is calling variadic functions like barf() and such. Cmm doesn't support CAPI calling convention yet, so calls to variadic functions just happen to work in some cases with some target's ABI. But again, it doesn't work with wasm. Fortunately, the wasm C ABI lowers varargs to a stack pointer argument, and it can be passed NULL when no other arguments are expected to be passed. So we also add the additional unused NULL arguments to those functions, so to fix wasm, while not affecting behavior on other targets. - - - - - 00124d12 by Cheng Shao at 2022-11-11T00:26:55-05:00 testsuite: correct sleep() signature in T5611 In libc, sleep() returns an integer. The ccall type signature should match the libc definition, otherwise it causes linker error on wasm. - - - - - d72466a9 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: prefer ffi_type_void over FFI_TYPE_VOID This patch uses ffi_type_void instead of FFI_TYPE_VOID in the interpreter code, since the FFI_TYPE_* macros are not available in libffi-wasm32 yet. The libffi public documentation also only mentions the lower-case ffi_type_* symbols, so we should prefer the lower-case API here. - - - - - 4d36a1d3 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't define RTS_USER_SIGNALS when signal.h is not present In the rts, we have a RTS_USER_SIGNALS macro, and most signal-related logic is guarded with RTS_USER_SIGNALS. This patch extends the range of code guarded with RTS_USER_SIGNALS, and define RTS_USER_SIGNALS iff signal.h is actually detected by autoconf. This is required for wasm32-wasi to work, which lacks signals. - - - - - 3f1e164f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: use HAVE_GETPID to guard subprocess related logic We've previously added detection of getpid() in autoconf. This patch uses HAVE_GETPID to guard some subprocess related logic in the RTS. This is required for certain targets like wasm32-wasi, where there isn't a process model at all. - - - - - 50bf5e77 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: IPE.c: don't do mutex stuff when THREADED_RTS is not defined This patch adds the missing THREADED_RTS CPP guard to mutex logic in IPE.c. - - - - - ed3b3da0 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: genericRaise: use exit() instead when not HAVE_RAISE We check existence of raise() in autoconf, and here, if not HAVE_RAISE, we should use exit() instead in genericRaise. - - - - - c0ba1547 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: checkSuid: don't do it when not HAVE_GETUID When getuid() is not present, don't do checkSuid since it doesn't make sense anyway on that target. - - - - - d2d6dfd2 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 placeholder linker This patch adds minimal placeholder linker logic for wasm32, just enough to unblock compiling rts on wasm32. RTS linker functionality is not properly implemented yet for wasm32. - - - - - 65ba3285 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: chdir to PWD on wasm32 This patch adds a wasm32-specific behavior to RtsStartup logic. When the PWD environment variable is present, we chdir() to it first. The point is to workaround an issue in wasi-libc: it's currently not possible to specify the initial working directory, it always defaults to / (in the virtual filesystem mapped from some host directory). For some use cases this is sufficient, but there are some other cases (e.g. in the testsuite) where the program needs to access files outside. - - - - - 65b82542 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: no timer for wasm32 Due to the lack of threads, on wasm32 there can't be a background timer that periodically resets the context switch flag. This patch disables timer for wasm32, and also makes the scheduler default to -C0 on wasm32 to avoid starving threads. - - - - - e007586f by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsSymbols: empty RTS_POSIX_ONLY_SYMBOLS for wasm32 The default RTS_POSIX_ONLY_SYMBOLS doesn't make sense on wasm32. - - - - - 0e33f667 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: Schedule: no FORKPROCESS_PRIMOP_SUPPORTED on wasm32 On wasm32 there isn't a process model at all, so no FORKPROCESS_PRIMOP_SUPPORTED. - - - - - 88bbdb31 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: LibffiAdjustor: adapt to ffi_alloc_prep_closure interface for wasm32 libffi-wasm32 only supports non-standard libffi closure api via ffi_alloc_prep_closure(). This patch implements ffi_alloc_prep_closure() via standard libffi closure api on other targets, and uses it to implement adjustor functionality. - - - - - 15138746 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: don't return memory to OS on wasm32 This patch makes the storage manager not return any memory on wasm32. The detailed reason is described in Note [Megablock allocator on wasm]. - - - - - 631af3cc by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: make flushExec a no-op on wasm32 This patch makes flushExec a no-op on wasm32, since there's no such thing as executable memory on wasm32 in the first place. - - - - - 654a3d46 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: RtsStartup: don't call resetTerminalSettings, freeThreadingResources on wasm32 This patch prevents resetTerminalSettings and freeThreadingResources to be called on wasm32, since there is no TTY or threading on wasm32 at all. - - - - - f271e7ca by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: OSThreads.h: stub types for wasm32 This patch defines stub Condition/Mutex/OSThreadId/ThreadLocalKey types for wasm32, just enough to unblock compiling RTS. Any threading-related functionality has been patched to be disabled on wasm32. - - - - - a6ac67b0 by Cheng Shao at 2022-11-11T00:26:55-05:00 Add register mapping for wasm32 This patch adds register mapping logic for wasm32. See Note [Register mapping on WebAssembly] in wasm32 NCG for more description. - - - - - d7b33982 by Cheng Shao at 2022-11-11T00:26:55-05:00 rts: wasm32 specific logic This patch adds the rest of wasm32 specific logic in rts. - - - - - 7f59b0f3 by Cheng Shao at 2022-11-11T00:26:55-05:00 base: fall back to using monotonic clock to emulate cputime on wasm32 On wasm32, we have to fall back to using monotonic clock to emulate cputime, since there's no native support for cputime as a clock id. - - - - - 5fcbae0b by Cheng Shao at 2022-11-11T00:26:55-05:00 base: more autoconf checks for wasm32 This patch adds more autoconf checks to base, since those functions and headers may exist on other POSIX systems but don't exist on wasm32. - - - - - 00a9359f by Cheng Shao at 2022-11-11T00:26:55-05:00 base: avoid using unsupported posix functionality on wasm32 This base patch avoids using unsupported posix functionality on wasm32. - - - - - 34b8f611 by Cheng Shao at 2022-11-11T00:26:55-05:00 autoconf: set CrossCompiling=YES in cross bindist configure This patch fixes the bindist autoconf logic to properly set CrossCompiling=YES when it's a cross GHC bindist. - - - - - 5ebeaa45 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: add util functions for UniqFM and UniqMap This patch adds addToUFM_L (backed by insertLookupWithKey), addToUniqMap_L and intersectUniqMap_C. These UniqFM/UniqMap util functions are used by the wasm32 NCG. - - - - - 177c56c1 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: avoid -Wl,--no-as-needed for wasm32 The driver used to pass -Wl,--no-as-needed for LLD linking. This is actually only supported for ELF targets, and must be avoided when linking for wasm32. - - - - - 06f01c74 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: allow big arith for wasm32 This patch enables Cmm big arithmetic on wasm32, since 64-bit arithmetic can be efficiently lowered to wasm32 opcodes. - - - - - df6bb112 by Cheng Shao at 2022-11-11T00:26:55-05:00 driver: pass -Wa,--no-type-check for wasm32 when runAsPhase This patch passes -Wa,--no-type-check for wasm32 when compiling assembly. See the added note for more detailed explanation. - - - - - c1fe4ab6 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: enforce cmm switch planning for wasm32 This patch forcibly enable Cmm switch planning for wasm32, since otherwise the switch tables we generate may exceed the br_table maximum allowed size. - - - - - a8adc71e by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: annotate CmmFileEmbed with blob length This patch adds the blob length field to CmmFileEmbed. The wasm32 NCG needs to know the precise size of each data segment. - - - - - 36340328 by Cheng Shao at 2022-11-11T00:26:55-05:00 compiler: wasm32 NCG This patch adds the wasm32 NCG. - - - - - 435f42ea by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add wasm32-wasi release bindist job - - - - - d8262fdc by Cheng Shao at 2022-11-11T00:26:55-05:00 ci: add a stronger test for cross bindists This commit adds a simple GHC API program that parses and reprints the original hello world program used for basic testing of cross bindists. Before there's full cross-compilation support in the test suite driver, this provides better coverage than the original test. - - - - - 8e6ae882 by Cheng Shao at 2022-11-11T00:26:55-05:00 CODEOWNERS: add wasm-specific maintainers - - - - - 707d5651 by Zubin Duggal at 2022-11-11T00:27:31-05:00 Clarify that LLVM upper bound is non-inclusive during configure (#22411) - - - - - 430eccef by Ben Gamari at 2022-11-11T13:16:45-05:00 rts: Check for program_invocation_short_name via autoconf Instead of assuming support on all Linuxes. - - - - - 6dab0046 by Matthew Pickering at 2022-11-11T13:17:22-05:00 driver: Fix -fdefer-diagnostics flag The `withDeferredDiagnostics` wrapper wasn't doing anything because the session it was modifying wasn't used in hsc_env. Therefore the fix is simple, just push the `getSession` call into the scope of `withDeferredDiagnostics`. Fixes #22391 - - - - - d0c691b6 by Simon Peyton Jones at 2022-11-11T13:18:07-05:00 Add a fast path for data constructor workers See Note [Fast path for data constructors] in GHC.Core.Opt.Simplify.Iteration This bypasses lots of expensive logic, in the special case of applications of data constructors. It is a surprisingly worthwhile improvement, as you can see in the figures below. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Read(normal) -2.0% CoOpt_Singletons(normal) -2.0% ManyConstructors(normal) -1.3% T10421(normal) -1.9% GOOD T10421a(normal) -1.5% T10858(normal) -1.6% T11545(normal) -1.7% T12234(optasm) -1.3% T12425(optasm) -1.9% GOOD T13035(normal) -1.0% GOOD T13056(optasm) -1.8% T13253(normal) -3.3% GOOD T15164(normal) -1.7% T15304(normal) -3.4% T15630(normal) -2.8% T16577(normal) -4.3% GOOD T17096(normal) -1.1% T17516(normal) -3.1% T18282(normal) -1.9% T18304(normal) -1.2% T18698a(normal) -1.2% GOOD T18698b(normal) -1.5% GOOD T18923(normal) -1.3% T1969(normal) -1.3% GOOD T19695(normal) -4.4% GOOD T21839c(normal) -2.7% GOOD T21839r(normal) -2.7% GOOD T4801(normal) -3.8% GOOD T5642(normal) -3.1% GOOD T6048(optasm) -2.5% GOOD T9020(optasm) -2.7% GOOD T9630(normal) -2.1% GOOD T9961(normal) -11.7% GOOD WWRec(normal) -1.0% geo. mean -1.1% minimum -11.7% maximum +0.1% Metric Decrease: T10421 T12425 T13035 T13253 T16577 T18698a T18698b T1969 T19695 T21839c T21839r T4801 T5642 T6048 T9020 T9630 T9961 - - - - - 3c37d30b by Krzysztof Gogolewski at 2022-11-11T19:18:39+01:00 Use a more efficient printer for code generation (#21853) The changes in `GHC.Utils.Outputable` are the bulk of the patch and drive the rest. The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc` and support printing directly to a handle with `bPutHDoc`. See Note [SDoc versus HDoc] and Note [HLine versus HDoc]. The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF and dependencies (printing module names, labels etc.). Co-authored-by: Alexis King <lexi.lambda at gmail.com> Metric Decrease: CoOpt_Read ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13379 T18140 T18282 T18698a T18698b T1969 T20049 T21839c T21839r T3064 T3294 T4801 T5321FD T5321Fun T5631 T6048 T783 T9198 T9233 - - - - - 6b92b47f by Matthew Craven at 2022-11-11T18:32:14-05:00 Weaken wrinkle 1 of Note [Scrutinee Constant Folding] Fixes #22375. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 154c70f6 by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Fix fragile RULE setup in GHC.Float In testing my type-vs-constraint patch I found that the handling of Natural literals was very fragile -- and I somehow tripped that fragility in my work. So this patch fixes the fragility. See Note [realToFrac natural-to-float] This made a big (9%) difference in one existing test in perf/should_run/T1-359 Metric Decrease: T10359 - - - - - 778c6adc by Simon Peyton Jones at 2022-11-11T23:40:10+00:00 Type vs Constraint: finally nailed This big patch addresses the rats-nest of issues that have plagued us for years, about the relationship between Type and Constraint. See #11715/#21623. The main payload of the patch is: * To introduce CONSTRAINT :: RuntimeRep -> Type * To make TYPE and CONSTRAINT distinct throughout the compiler Two overview Notes in GHC.Builtin.Types.Prim * Note [TYPE and CONSTRAINT] * Note [Type and Constraint are not apart] This is the main complication. The specifics * New primitive types (GHC.Builtin.Types.Prim) - CONSTRAINT - ctArrowTyCon (=>) - tcArrowTyCon (-=>) - ccArrowTyCon (==>) - funTyCon FUN -- Not new See Note [Function type constructors and FunTy] and Note [TYPE and CONSTRAINT] * GHC.Builtin.Types: - New type Constraint = CONSTRAINT LiftedRep - I also stopped nonEmptyTyCon being built-in; it only needs to be wired-in * Exploit the fact that Type and Constraint are distinct throughout GHC - Get rid of tcView in favour of coreView. - Many tcXX functions become XX functions. e.g. tcGetCastedTyVar --> getCastedTyVar * Kill off Note [ForAllTy and typechecker equality], in (old) GHC.Tc.Solver.Canonical. It said that typechecker-equality should ignore the specified/inferred distinction when comparein two ForAllTys. But that wsa only weakly supported and (worse) implies that we need a separate typechecker equality, different from core equality. No no no. * GHC.Core.TyCon: kill off FunTyCon in data TyCon. There was no need for it, and anyway now we have four of them! * GHC.Core.TyCo.Rep: add two FunTyFlags to FunCo See Note [FunCo] in that module. * GHC.Core.Type. Lots and lots of changes driven by adding CONSTRAINT. The key new function is sORTKind_maybe; most other changes are built on top of that. See also `funTyConAppTy_maybe` and `tyConAppFun_maybe`. * Fix a longstanding bug in GHC.Core.Type.typeKind, and Core Lint, in kinding ForAllTys. See new tules (FORALL1) and (FORALL2) in GHC.Core.Type. (The bug was that before (forall (cv::t1 ~# t2). blah), where blah::TYPE IntRep, would get kind (TYPE IntRep), but it should be (TYPE LiftedRep). See Note [Kinding rules for types] in GHC.Core.Type. * GHC.Core.TyCo.Compare is a new module in which we do eqType and cmpType. Of course, no tcEqType any more. * GHC.Core.TyCo.FVs. I moved some free-var-like function into this module: tyConsOfType, visVarsOfType, and occCheckExpand. Refactoring only. * GHC.Builtin.Types. Compiletely re-engineer boxingDataCon_maybe to have one for each /RuntimeRep/, rather than one for each /Type/. This dramatically widens the range of types we can auto-box. See Note [Boxing constructors] in GHC.Builtin.Types The boxing types themselves are declared in library ghc-prim:GHC.Types. GHC.Core.Make. Re-engineer the treatment of "big" tuples (mkBigCoreVarTup etc) GHC.Core.Make, so that it auto-boxes unboxed values and (crucially) types of kind Constraint. That allows the desugaring for arrows to work; it gathers up free variables (including dictionaries) into tuples. See Note [Big tuples] in GHC.Core.Make. There is still work to do here: #22336. But things are better than before. * GHC.Core.Make. We need two absent-error Ids, aBSENT_ERROR_ID for types of kind Type, and aBSENT_CONSTRAINT_ERROR_ID for vaues of kind Constraint. Ditto noInlineId vs noInlieConstraintId in GHC.Types.Id.Make; see Note [inlineId magic]. * GHC.Core.TyCo.Rep. Completely refactor the NthCo coercion. It is now called SelCo, and its fields are much more descriptive than the single Int we used to have. A great improvement. See Note [SelCo] in GHC.Core.TyCo.Rep. * GHC.Core.RoughMap.roughMatchTyConName. Collapse TYPE and CONSTRAINT to a single TyCon, so that the rough-map does not distinguish them. * GHC.Core.DataCon - Mainly just improve documentation * Some significant renamings: GHC.Core.Multiplicity: Many --> ManyTy (easier to grep for) One --> OneTy GHC.Core.TyCo.Rep TyCoBinder --> GHC.Core.Var.PiTyBinder GHC.Core.Var TyCoVarBinder --> ForAllTyBinder AnonArgFlag --> FunTyFlag ArgFlag --> ForAllTyFlag GHC.Core.TyCon TyConTyCoBinder --> TyConPiTyBinder Many functions are renamed in consequence e.g. isinvisibleArgFlag becomes isInvisibleForAllTyFlag, etc * I refactored FunTyFlag (was AnonArgFlag) into a simple, flat data type data FunTyFlag = FTF_T_T -- (->) Type -> Type | FTF_T_C -- (-=>) Type -> Constraint | FTF_C_T -- (=>) Constraint -> Type | FTF_C_C -- (==>) Constraint -> Constraint * GHC.Tc.Errors.Ppr. Some significant refactoring in the TypeEqMisMatch case of pprMismatchMsg. * I made the tyConUnique field of TyCon strict, because I saw code with lots of silly eval's. That revealed that GHC.Settings.Constants.mAX_SUM_SIZE can only be 63, because we pack the sum tag into a 6-bit field. (Lurking bug squashed.) Fixes * #21530 Updates haddock submodule slightly. Performance changes ~~~~~~~~~~~~~~~~~~~ I was worried that compile times would get worse, but after some careful profiling we are down to a geometric mean 0.1% increase in allocation (in perf/compiler). That seems fine. There is a big runtime improvement in T10359 Metric Decrease: LargeRecord MultiLayerModulesTH_OneShot T13386 T13719 Metric Increase: T8095 - - - - - 360f5fec by Simon Peyton Jones at 2022-11-11T23:40:11+00:00 Indent closing "#-}" to silence HLint - - - - - e160cf47 by Krzysztof Gogolewski at 2022-11-12T08:05:28-05:00 Fix merge conflict in T18355.stderr Fixes #22446 - - - - - 294f9073 by Simon Peyton Jones at 2022-11-12T23:14:13+00:00 Fix a trivial typo in dataConNonlinearType Fixes #22416 - - - - - 268a3ce9 by Ben Gamari at 2022-11-14T09:36:57-05:00 eventlog: Ensure that IPE output contains actual info table pointers The refactoring in 866c736e introduced a rather subtle change in the semantics of the IPE eventlog output, changing the eventlog field from encoding info table pointers to "TNTC pointers" (which point to entry code when tables-next-to-code is enabled). Fix this. Fixes #22452. - - - - - d91db679 by Matthew Pickering at 2022-11-14T16:48:10-05:00 testsuite: Add tests for T22347 These are fixed in recent versions but might as well add regression tests. See #22347 - - - - - 8f6c576b by Matthew Pickering at 2022-11-14T16:48:45-05:00 testsuite: Improve output from tests which have failing pre_cmd There are two changes: * If a pre_cmd fails, then don't attempt to run the test. * If a pre_cmd fails, then print the stdout and stderr from running that command (which hopefully has a nice error message). For example: ``` =====> 1 of 1 [0, 0, 0] *** framework failure for test-defaulting-plugin(normal) pre_cmd failed: 2 ** pre_cmd was "$MAKE -s --no-print-directory -C defaulting-plugin package.test-defaulting-plugin TOP={top}". stdout: stderr: DefaultLifted.hs:19:13: error: [GHC-76037] Not in scope: type constructor or class ‘Typ’ Suggested fix: Perhaps use one of these: ‘Type’ (imported from GHC.Tc.Utils.TcType), data constructor ‘Type’ (imported from GHC.Plugins) | 19 | instance Eq Typ where | ^^^ make: *** [Makefile:17: package.test-defaulting-plugin] Error 1 Performance Metrics (test environment: local): ``` Fixes #22329 - - - - - 2b7d5ccc by Madeline Haraj at 2022-11-14T22:44:17+00:00 Implement UNPACK support for sum types. This is based on osa's unpack_sums PR from ages past. The meat of the patch is implemented in dataConArgUnpackSum and described in Note [UNPACK for sum types]. - - - - - 78f7ecb0 by Andreas Klebinger at 2022-11-14T22:20:29-05:00 Expand on the need to clone local binders. Fixes #22402. - - - - - 65ce43cc by Krzysztof Gogolewski at 2022-11-14T22:21:05-05:00 Fix :i Constraint printing "type Constraint = Constraint" Since Constraint became a synonym for CONSTRAINT 'LiftedRep, we need the same code for handling printing as for the synonym Type = TYPE 'LiftedRep. This addresses the same bug as #18594, so I'm reusing the test. - - - - - 94549f8f by ARATA Mizuki at 2022-11-15T21:36:03-05:00 configure: Don't check for an unsupported version of LLVM The upper bound is not inclusive. Fixes #22449 - - - - - 02d3511b by Bodigrim at 2022-11-15T21:36:41-05:00 Fix capitalization in haddock for TestEquality - - - - - 08bf2881 by Cheng Shao at 2022-11-16T09:16:29+00:00 base: make Foreign.Marshal.Pool use RTS internal arena for allocation `Foreign.Marshal.Pool` used to call `malloc` once for each allocation request. Each `Pool` maintained a list of allocated pointers, and traverses the list to `free` each one of those pointers. The extra O(n) overhead is apparently bad for a `Pool` that serves a lot of small allocation requests. This patch uses the RTS internal arena to implement `Pool`, with these benefits: - Gets rid of the extra O(n) overhead. - The RTS arena is simply a bump allocator backed by the block allocator, each allocation request is likely faster than a libc `malloc` call. Closes #14762 #18338. - - - - - 37cfe3c0 by Krzysztof Gogolewski at 2022-11-16T14:50:06-05:00 Misc cleanup * Replace catMaybes . map f with mapMaybe f * Use concatFS to concatenate multiple FastStrings * Fix documentation of -exclude-module * Cleanup getIgnoreCount in GHCi.UI - - - - - b0ac3813 by Lawton Nichols at 2022-11-19T03:22:14-05:00 Give better errors for code corrupted by Unicode smart quotes (#21843) Previously, we emitted a generic and potentially confusing error during lexical analysis on programs containing smart quotes (“/”/‘/’). This commit adds smart quote-aware lexer errors. - - - - - cb8430f8 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make OpaqueNo* tests less noisy to unrelated changes - - - - - b1a8af69 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Simplifier: Consider `seq` as a `BoringCtxt` (#22317) See `Note [Seq is boring]` for the rationale. Fixes #22317. - - - - - 9fd11585 by Sebastian Graf at 2022-11-19T03:22:49-05:00 Make T21839c's ghc/max threshold more forgiving - - - - - 4b6251ab by Simon Peyton Jones at 2022-11-19T03:23:24-05:00 Be more careful when reporting unbound RULE binders See Note [Variables unbound on the LHS] in GHC.HsToCore.Binds. Fixes #22471. - - - - - e8f2b80d by Peter Trommler at 2022-11-19T03:23:59-05:00 PPC NCG: Fix generating assembler code Fixes #22479 - - - - - f2f9ef07 by Bodigrim at 2022-11-20T18:39:30-05:00 Extend documentation for Data.IORef - - - - - ef511b23 by Simon Peyton Jones at 2022-11-20T18:40:05-05:00 Buglet in GHC.Tc.Module.checkBootTyCon This lurking bug used the wrong function to compare two types in GHC.Tc.Module.checkBootTyCon It's hard to trigger the bug, which only came up during !9343, so there's no regression test in this MR. - - - - - 451aeac3 by Bodigrim at 2022-11-20T18:40:44-05:00 Add since pragmas for c_interruptible_open and hostIsThreaded - - - - - 8d6aaa49 by Duncan Coutts at 2022-11-22T02:06:16-05:00 Introduce CapIOManager as the per-cap I/O mangager state Rather than each I/O manager adding things into the Capability structure ad-hoc, we should have a common CapIOManager iomgr member of the Capability structure, with a common interface to initialise etc. The content of the CapIOManager struct will be defined differently for each I/O manager implementation. Eventually we should be able to have the CapIOManager be opaque to the rest of the RTS, and known just to the I/O manager implementation. We plan for that by making the Capability contain a pointer to the CapIOManager rather than containing the structure directly. Initially just move the Unix threaded I/O manager's control FD. - - - - - 8901285e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Add hook markCapabilityIOManager To allow I/O managers to have GC roots in the Capability, within the CapIOManager structure. Not yet used in this patch. - - - - - 5cf709c5 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move APPEND_TO_BLOCKED_QUEUE from cmm to C The I/O and delay blocking primitives for the non-threaded way currently access the blocked_queue and sleeping_queue directly. We want to move where those queues are to make their ownership clearer: to have them clearly belong to the I/O manager impls rather than to the scheduler. Ultimately we will want to change their representation too. It's inconvenient to do that if these queues are accessed directly from cmm code. So as a first step, replace the APPEND_TO_BLOCKED_QUEUE with a C version appendToIOBlockedQueue(), and replace the open-coded sleeping_queue insertion with insertIntoSleepingQueue(). - - - - - ced9acdb by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move {blocked,sleeping}_queue from scheduler global vars to CapIOManager The blocked_queue_{hd,tl} and the sleeping_queue are currently cooperatively managed between the scheduler and (some but not all of) the non-threaded I/O manager implementations. They lived as global vars with the scheduler, but are poked by I/O primops and the I/O manager backends. This patch is a step on the path towards making the management of I/O or timer blocking belong to the I/O managers and not the scheduler. Specifically, this patch moves the {blocked,sleeping}_queue from being global vars in the scheduler to being members of the CapIOManager struct within each Capability. They are not yet exclusively used by the I/O managers: they are still poked from a couple other places, notably in the scheduler before calling awaitEvent. - - - - - 0f68919e by Duncan Coutts at 2022-11-22T02:06:17-05:00 Remove the now-unused markScheduler The global vars {blocked,sleeping}_queue are now in the Capability and so get marked there via markCapabilityIOManager. - - - - - 39a91f60 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move macros for checking for pending IO or timers from Schedule.h to Schedule.c and IOManager.h This is just moving, the next step will be to rejig them slightly. For the non-threaded RTS the scheduler needs to be able to test for there being pending I/O operation or pending timers. The implementation of these tests should really be considered to be part of the I/O managers and not part of the scheduler. - - - - - 664b034b by Duncan Coutts at 2022-11-22T02:06:17-05:00 Replace EMPTY_{BLOCKED,SLEEPING}_QUEUE macros by function These are the macros originaly from Scheduler.h, previously moved to IOManager.h, and now replaced with a single inline function anyPendingTimeoutsOrIO(). We can use a single function since the two macros were always checked together. Note that since anyPendingTimeoutsOrIO is defined for all IO manager cases, including threaded, we do not need to guard its use by cpp #if !defined(THREADED_RTS) - - - - - 32946220 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Expand emptyThreadQueues inline for clarity It was not really adding anything. The name no longer meant anything since those I/O and timeout queues do not belong to the scheuler. In one of the two places it was used, the comments already had to explain what it did, whereas now the code matches the comment nicely. - - - - - 9943baf9 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Move the awaitEvent declaration into IOManager.h And add or adjust comments at the use sites of awaitEvent. - - - - - 054dcc9d by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to awaitEvent It is currently only used in the non-threaded RTS so it works to use MainCapability, but it's a bit nicer to pass the cap anyway. It's certainly shorter. - - - - - 667fe5a4 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Pass the Capability *cap explicitly to appendToIOBlockedQueue And to insertIntoSleepingQueue. Again, it's a bit cleaner and simpler though not strictly necessary given that these primops are currently only used in the non-threaded RTS. - - - - - 7181b074 by Duncan Coutts at 2022-11-22T02:06:17-05:00 Reveiew feedback: improve one of the TODO comments The one about the nonsense (const False) test on WinIO for there being any IO or timers pending, leading to unnecessary complication later in the scheduler. - - - - - e5b68183 by Andreas Klebinger at 2022-11-22T02:06:52-05:00 Optimize getLevity. Avoid the intermediate data structures allocated by splitTyConApp. This avoids ~0.5% of allocations for a build using -O2. Fixes #22254 - - - - - de5fb348 by Andreas Klebinger at 2022-11-22T02:07:28-05:00 hadrian:Set TNTC when running testsuite. - - - - - 9d61c182 by Oleg Grenrus at 2022-11-22T15:59:34-05:00 Add unsafePtrEquality# restricted to UnliftedTypes - - - - - e817c871 by Jonathan Dowland at 2022-11-22T16:00:14-05:00 utils/unlit: adjust parser to match Report spec The Haskell 2010 Report says that, for Latex-style Literate format, "Program code begins on the first line following a line that begins \begin{code}". (This is unchanged from the 98 Report) However the unlit.c implementation only matches a line that contains "\begin{code}" and nothing else. One consequence of this is that one cannot suffix Latex options to the code environment. I.e., this does not work: \begin{code}[label=foo,caption=Foo Code] Adjust the matcher to conform to the specification from the Report. The Haskell Wiki currently recommends suffixing a '%' to \begin{code} in order to deliberately hide a code block from Haskell. This is bad advice, as it's relying on an implementation quirk rather than specified behaviour. None-the-less, some people have tried to use it, c.f. <https://mail.haskell.org/pipermail/haskell-cafe/2009-September/066780.html> An alternative solution is to define a separate, equivalent Latex environment to "code", that is functionally identical in Latex but ignored by unlit. This should not be a burden: users are required to manually define the code environment anyway, as it is not provided by the Latex verbatim or lstlistings packages usually used for presenting code in documents. Fixes #3549. - - - - - 0b7fef11 by Teo Camarasu at 2022-11-23T12:44:33-05:00 Fix eventlog all option Previously it didn't enable/disable nonmoving_gc and ticky event types Fixes #21813 - - - - - 04d0618c by Arnaud Spiwack at 2022-11-23T12:45:14-05:00 Expand Note [Linear types] with the stance on linting linearity Per the discussion on #22123 - - - - - e1538516 by Lawton Nichols at 2022-11-23T12:45:55-05:00 Add documentation on custom Prelude modules (#22228) Specifically, custom Prelude modules that are named `Prelude`. - - - - - b5c71454 by Sylvain Henry at 2022-11-23T12:46:35-05:00 Don't let configure perform trivial substitutions (#21846) Hadrian now performs substitutions, especially to generate .cabal files from .cabal.in files. Two benefits: 1. We won't have to re-configure when we modify thing.cabal.in. Hadrian will take care of this for us. 2. It paves the way to allow the same package to be configured differently by Hadrian in the same session. This will be useful to fix #19174: we want to build a stage2 cross-compiler for the host platform and a stage1 compiler for the cross target platform in the same Hadrian session. - - - - - 99aca26b by nineonine at 2022-11-23T12:47:11-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043) Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043 - - - - - 040bfdc3 by M Farkas-Dyck at 2022-11-23T21:59:03-05:00 Scrub some no-warning pragmas. - - - - - 178c1fd8 by Vladislav Zavialov at 2022-11-23T21:59:39-05:00 Check if the SDoc starts with a single quote (#22488) This patch fixes pretty-printing of character literals inside promoted lists and tuples. When we pretty-print a promoted list or tuple whose first element starts with a single quote, we want to add a space between the opening bracket and the element: '[True] -- ok '[ 'True] -- ok '['True] -- not ok If we don't add the space, we accidentally produce a character literal '['. Before this patch, pprSpaceIfPromotedTyCon inspected the type as an AST and tried to guess if it would be rendered with a single quote. However, it missed the case when the inner type was itself a character literal: '[ 'x'] -- ok '['x'] -- not ok Instead of adding this particular case, I opted for a more future-proof solution: check the SDoc directly. This way we can detect if the single quote is actually there instead of trying to predict it from the AST. The new function is called spaceIfSingleQuote. - - - - - 11627c42 by Matthew Pickering at 2022-11-23T22:00:15-05:00 notes: Fix references to HPT space leak note Updating this note was missed when updating the HPT to the HUG. Fixes #22477 - - - - - 86ff1523 by Andrei Borzenkov at 2022-11-24T17:24:51-05:00 Convert diagnostics in GHC.Rename.Expr to proper TcRnMessage (#20115) Problem: avoid usage of TcRnMessageUnknown Solution: The following `TcRnMessage` messages has been introduced: TcRnNoRebindableSyntaxRecordDot TcRnNoFieldPunsRecordDot TcRnIllegalStaticExpression TcRnIllegalStaticFormInSplice TcRnListComprehensionDuplicateBinding TcRnEmptyStmtsGroup TcRnLastStmtNotExpr TcRnUnexpectedStatementInContext TcRnIllegalTupleSection TcRnIllegalImplicitParameterBindings TcRnSectionWithoutParentheses Co-authored-by: sheaf <sam.derbyshire at gmail.com> - - - - - d198a19a by Cheng Shao at 2022-11-24T17:25:29-05:00 rts: fix missing Arena.h symbols in RtsSymbols.c It was an unfortunate oversight in !8961 and broke devel2 builds. - - - - - 5943e739 by Bodigrim at 2022-11-25T04:38:28-05:00 Assorted fixes to avoid Data.List.{head,tail} - - - - - 1f1b99b8 by sheaf at 2022-11-25T04:38:28-05:00 Review suggestions for assorted fixes to avoid Data.List.{head,tail} - - - - - 13d627bb by Vladislav Zavialov at 2022-11-25T04:39:04-05:00 Print unticked promoted data constructors (#20531) Before this patch, GHC unconditionally printed ticks before promoted data constructors: ghci> type T = True -- unticked (user-written) ghci> :kind! T T :: Bool = 'True -- ticked (compiler output) After this patch, GHC prints ticks only when necessary: ghci> type F = False -- unticked (user-written) ghci> :kind! F F :: Bool = False -- unticked (compiler output) ghci> data False -- introduce ambiguity ghci> :kind! F F :: Bool = 'False -- ticked by necessity (compiler output) The old behavior can be enabled by -fprint-redundant-promotion-ticks. Summary of changes: * Rename PrintUnqualified to NamePprCtx * Add QueryPromotionTick to it * Consult the GlobalRdrEnv to decide whether to print a tick (see mkPromTick) * Introduce -fprint-redundant-promotion-ticks Co-authored-by: Artyom Kuznetsov <hi at wzrd.ht> - - - - - d10dc6bd by Simon Peyton Jones at 2022-11-25T22:31:27+00:00 Fix decomposition of TyConApps Ticket #22331 showed that we were being too eager to decompose a Wanted TyConApp, leading to incompleteness in the solver. To understand all this I ended up doing a substantial rewrite of the old Note [Decomposing equalities], now reborn as Note [Decomposing TyConApp equalities]. Plus rewrites of other related Notes. The actual fix is very minor and actually simplifies the code: in `can_decompose` in `GHC.Tc.Solver.Canonical.canTyConApp`, we now call `noMatchableIrreds`. A closely related refactor: we stop trying to use the same "no matchable givens" function here as in `matchClassInst`. Instead split into two much simpler functions. - - - - - 2da5c38a by Will Hawkins at 2022-11-26T04:05:04-05:00 Redirect output of musttail attribute test Compilation output from test for support of musttail attribute leaked to the console. - - - - - 0eb1c331 by Cheng Shao at 2022-11-28T08:55:53+00:00 Move hs_mulIntMayOflo cbits to ghc-prim It's only used by wasm NCG at the moment, but ghc-prim is a more reasonable place for hosting out-of-line primops. Also, we only need a single version of hs_mulIntMayOflo. - - - - - 36b53a9d by Cheng Shao at 2022-11-28T09:05:57+00:00 compiler: generate ccalls for clz/ctz/popcnt in wasm NCG We used to generate a single wasm clz/ctz/popcnt opcode, but it's wrong when it comes to subwords, so might as well generate ccalls for them. See #22470 for details. - - - - - d4134e92 by Cheng Shao at 2022-11-28T23:48:14-05:00 compiler: remove unused MO_U_MulMayOflo We actually only emit MO_S_MulMayOflo and never emit MO_U_MulMayOflo anywhere. - - - - - 8d15eadc by Apoorv Ingle at 2022-11-29T03:09:31-05:00 Killing cc_fundeps, streamlining kind equality orientation, and type equality processing order Fixes: #217093 Associated to #19415 This change * Flips the orientation of the the generated kind equality coercion in canEqLHSHetero; * Removes `cc_fundeps` in CDictCan as the check was incomplete; * Changes `canDecomposableTyConAppOk` to ensure we process kind equalities before type equalities and avoiding a call to `canEqLHSHetero` while processing wanted TyConApp equalities * Adds 2 new tests for validating the change - testsuites/typecheck/should_compile/T21703.hs and - testsuites/typecheck/should_fail/T19415b.hs (a simpler version of T19415.hs) * Misc: Due to the change in the equality direction some error messages now have flipped type mismatch errors * Changes in Notes: - Note [Fundeps with instances, and equality orientation] supercedes Note [Fundeps with instances] - Added Note [Kind Equality Orientation] to visualize the kind flipping - Added Note [Decomposing Dependent TyCons and Processing Wanted Equalties] - - - - - 646969d4 by Krzysztof Gogolewski at 2022-11-29T03:10:13-05:00 Change printing of sized literals to match the proposal Literals in Core were printed as e.g. 0xFF#16 :: Int16#. The proposal 451 now specifies syntax 0xFF#Int16. This change affects the Core printer only - more to be done later. Part of #21422. - - - - - 02e282ec by Simon Peyton Jones at 2022-11-29T03:10:48-05:00 Be a bit more selective about floating bottoming expressions This MR arranges to float a bottoming expression to the top only if it escapes a value lambda. See #22494 and Note [Floating to the top] in SetLevels. This has a generally beneficial effect in nofib +-------------------------------++----------+ | ||tsv (rel) | +===============================++==========+ | imaginary/paraffins || -0.93% | | imaginary/rfib || -0.05% | | real/fem || -0.03% | | real/fluid || -0.01% | | real/fulsom || +0.05% | | real/gamteb || -0.27% | | real/gg || -0.10% | | real/hidden || -0.01% | | real/hpg || -0.03% | | real/scs || -11.13% | | shootout/k-nucleotide || -0.01% | | shootout/n-body || -0.08% | | shootout/reverse-complement || -0.00% | | shootout/spectral-norm || -0.02% | | spectral/fibheaps || -0.20% | | spectral/hartel/fft || -1.04% | | spectral/hartel/solid || +0.33% | | spectral/hartel/wave4main || -0.35% | | spectral/mate || +0.76% | +===============================++==========+ | geom mean || -0.12% | The effect on compile time is generally slightly beneficial Metrics: compile_time/bytes allocated ---------------------------------------------- MultiLayerModulesTH_OneShot(normal) +0.3% PmSeriesG(normal) -0.2% PmSeriesT(normal) -0.1% T10421(normal) -0.1% T10421a(normal) -0.1% T10858(normal) -0.1% T11276(normal) -0.1% T11303b(normal) -0.2% T11545(normal) -0.1% T11822(normal) -0.1% T12150(optasm) -0.1% T12234(optasm) -0.3% T13035(normal) -0.2% T16190(normal) -0.1% T16875(normal) -0.4% T17836b(normal) -0.2% T17977(normal) -0.2% T17977b(normal) -0.2% T18140(normal) -0.1% T18282(normal) -0.1% T18304(normal) -0.2% T18698a(normal) -0.1% T18923(normal) -0.1% T20049(normal) -0.1% T21839r(normal) -0.1% T5837(normal) -0.4% T6048(optasm) +3.2% BAD T9198(normal) -0.2% T9630(normal) -0.1% TcPlugin_RewritePerf(normal) -0.4% hard_hole_fits(normal) -0.1% geo. mean -0.0% minimum -0.4% maximum +3.2% The T6048 outlier is hard to pin down, but it may be the effect of reading in more interface files definitions. It's a small program for which compile time is very short, so I'm not bothered about it. Metric Increase: T6048 - - - - - ab23dc5e by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Mark unpack_sums_6 as fragile due to #22504 This test is explicitly dependent upon runtime, which is generally not appropriate given that the testsuite is run in parallel and generally saturates the CPU. - - - - - def47dd3 by Ben Gamari at 2022-11-29T03:11:25-05:00 testsuite: Don't use grep -q in unpack_sums_7 `grep -q` closes stdin as soon as it finds the pattern it is looking for, resulting in #22484. - - - - - cc25d52e by Sylvain Henry at 2022-11-29T09:44:31+01:00 Add Javascript backend Add JS backend adapted from the GHCJS project by Luite Stegeman. Some features haven't been ported or implemented yet. Tests for these features have been disabled with an associated gitlab ticket. Bump array submodule Work funded by IOG. Co-authored-by: Jeffrey Young <jeffrey.young at iohk.io> Co-authored-by: Luite Stegeman <stegeman at gmail.com> Co-authored-by: Josh Meredith <joshmeredith2008 at gmail.com> - - - - - 68c966cd by sheaf at 2022-11-30T09:31:25-05:00 Fix @since annotations on WithDict and Coercible Fixes #22453 - - - - - a3a8e9e9 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Be more careful in GHC.Tc.Solver.Interact.solveOneFromTheOther We were failing to account for the cc_pend_sc flag in this important function, with the result that we expanded superclasses forever. Fixes #22516. - - - - - a9d9b8c0 by Simon Peyton Jones at 2022-11-30T09:32:03-05:00 Use mkNakedFunTy in tcPatSynSig As #22521 showed, in tcPatSynSig we make a "fake type" to kind-generalise; and that type has unzonked type variables in it. So we must not use `mkFunTy` (which checks FunTy's invariants) via `mkPhiTy` when building this type. Instead we need to use `mkNakedFunTy`. Easy fix. - - - - - 31462d98 by Andreas Klebinger at 2022-11-30T14:50:58-05:00 Properly cast values when writing/reading unboxed sums. Unboxed sums might store a Int8# value as Int64#. This patch makes sure we keep track of the actual value type. See Note [Casting slot arguments] for the details. - - - - - 10a2a7de by Oleg Grenrus at 2022-11-30T14:51:39-05:00 Move Void to GHC.Base... This change would allow `Void` to be used deeper in module graph. For example exported from `Prelude` (though that might be already possible). Also this change includes a change `stimes @Void _ x = x`, https://github.com/haskell/core-libraries-committee/issues/95 While the above is not required, maintaining old stimes behavior would be tricky as `GHC.Base` doesn't know about `Num` or `Integral`, which would require more hs-boot files. - - - - - b4cfa8e2 by Sebastian Graf at 2022-11-30T14:52:24-05:00 DmdAnal: Reflect the `seq` of strict fields of a DataCon worker (#22475) See the updated `Note [Data-con worker strictness]` and the new `Note [Demand transformer for data constructors]`. Fixes #22475. - - - - - d87f28d8 by Baldur Blöndal at 2022-11-30T21:16:36+01:00 Make Functor a quantified superclass of Bifunctor. See https://github.com/haskell/core-libraries-committee/issues/91 for discussion. This change relates Bifunctor with Functor by requiring second = fmap. Moreover this change is a step towards unblocking the major version bump of bifunctors and profunctors to major version 6. This paves the way to move the Profunctor class into base. For that Functor first similarly becomes a superclass of Profunctor in the new major version 6. - - - - - 72cf4c5d by doyougnu at 2022-12-01T12:36:44-05:00 FastString: SAT bucket_match Metric Decrease: MultiLayerModulesTH_OneShot - - - - - afc2540d by Simon Peyton Jones at 2022-12-01T12:37:20-05:00 Add a missing varToCoreExpr in etaBodyForJoinPoint This subtle bug showed up when compiling a library with 9.4. See #22491. The bug is present in master, but it is hard to trigger; the new regression test T22491 fails in 9.4. The fix was easy: just add a missing varToCoreExpr in etaBodyForJoinPoint. The fix is definitely right though! I also did some other minor refatoring: * Moved the preInlineUnconditionally test in simplExprF1 to before the call to joinPointBinding_maybe, to avoid fruitless eta-expansion. * Added a boolean from_lam flag to simplNonRecE, to avoid two fruitless tests, and commented it a bit better. These refactorings seem to save 0.1% on compile-time allocation in perf/compiler; with a max saving of 1.4% in T9961 Metric Decrease: T9961 - - - - - 81eeec7f by M Farkas-Dyck at 2022-12-01T12:37:56-05:00 CI: Forbid the fully static build on Alpine to fail. To do so, we mark some tests broken in this configuration. - - - - - c5d1bf29 by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Remove ARMv7 jobs These jobs fail (and are allowed to fail) nearly every time. Soon they won't even be able to run at all, as we won't currently have runners that can run them. Fixing the latter problem is tracked in #22409. I went ahead and removed all settings and configurations. - - - - - d82992fd by Bryan Richter at 2022-12-01T12:37:56-05:00 CI: Fix CI lint Failure was introduced by conflicting changes to gen_ci.hs that did *not* trigger git conflicts. - - - - - ce126993 by Simon Peyton Jones at 2022-12-02T01:22:12-05:00 Refactor TyCon to have a top-level product This patch changes the representation of TyCon so that it has a top-level product type, with a field that gives the details (newtype, type family etc), #22458. Not much change in allocation, but execution seems to be a bit faster. Includes a change to the haddock submodule to adjust for API changes. - - - - - 74c767df by Matthew Pickering at 2022-12-02T01:22:48-05:00 ApplicativeDo: Set pattern location before running exhaustiveness checker This improves the error messages of the exhaustiveness checker when checking statements which have been moved around with ApplicativeDo. Before: Test.hs:2:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 2 | let x = () | ^^^^^^^^^^ After: Test.hs:4:3: warning: [GHC-62161] [-Wincomplete-uni-patterns] Pattern match(es) are non-exhaustive In a pattern binding: Patterns of type ‘Maybe ()’ not matched: Nothing | 4 | ~(Just res1) <- seq x (pure $ Nothing @()) | Fixes #22483 - - - - - 85ecc1a0 by Matthew Pickering at 2022-12-02T19:46:43-05:00 Add special case for :Main module in `GHC.IfaceToCore.mk_top_id` See Note [Root-main Id] The `:Main` special binding is actually defined in the current module (hence don't go looking for it externally) but the module name is rOOT_MAIN rather than the current module so we need this special case. There was already some similar logic in `GHC.Rename.Env` for External Core, but now the "External Core" is in interface files it needs to be moved here instead. Fixes #22405 - - - - - 108c319f by Krzysztof Gogolewski at 2022-12-02T19:47:18-05:00 Fix linearity checking in Lint Lint was not able to see that x*y <= x*y, because this inequality was decomposed to x <= x*y && y <= x*y, but there was no rule to see that x <= x*y. Fixes #22546. - - - - - bb674262 by Bryan Richter at 2022-12-03T04:38:46-05:00 Mark T16916 fragile See https://gitlab.haskell.org/ghc/ghc/-/issues/16966 - - - - - 5d267d46 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 Refactor: FreshOrReuse instead of addTyClTyVarBinds This is a refactoring that should have no effect on observable behavior. Prior to this change, GHC.HsToCore.Quote contained a few closely related functions to process type variable bindings: addSimpleTyVarBinds, addHsTyVarBinds, addQTyVarBinds, and addTyClTyVarBinds. We can classify them by their input type and name generation strategy: Fresh names only Reuse bound names +---------------------+-------------------+ [Name] | addSimpleTyVarBinds | | [LHsTyVarBndr flag GhcRn] | addHsTyVarBinds | | LHsQTyVars GhcRn | addQTyVarBinds | addTyClTyVarBinds | +---------------------+-------------------+ Note how two functions are missing. Because of this omission, there were two places where a LHsQTyVars value was constructed just to be able to pass it to addTyClTyVarBinds: 1. mk_qtvs in addHsOuterFamEqnTyVarBinds -- bad 2. mkHsQTvs in repFamilyDecl -- bad This prevented me from making other changes to LHsQTyVars, so the main goal of this refactoring is to get rid of those workarounds. The most direct solution would be to define the missing functions. But that would lead to a certain amount of code duplication. To avoid code duplication, I factored out the name generation strategy into a function parameter: data FreshOrReuse = FreshNamesOnly | ReuseBoundNames addSimpleTyVarBinds :: FreshOrReuse -> ... addHsTyVarBinds :: FreshOrReuse -> ... addQTyVarBinds :: FreshOrReuse -> ... - - - - - c189b831 by Vladislav Zavialov at 2022-12-03T04:39:22-05:00 addHsOuterFamEqnTyVarBinds: use FreshNamesOnly for explicit binders Consider this example: [d| instance forall a. C [a] where type forall b. G [a] b = Proxy b |] When we process "forall b." in the associated type instance, it is unambiguously the binding site for "b" and we want a fresh name for it. Therefore, FreshNamesOnly is more fitting than ReuseBoundNames. This should not have any observable effect but it avoids pointless lookups in the MetaEnv. - - - - - 42512264 by Ross Paterson at 2022-12-03T10:32:45+00:00 Handle type data declarations in Template Haskell quotations and splices (fixes #22500) This adds a TypeDataD constructor to the Template Haskell Dec type, and ensures that the constructors it contains go in the TyCls namespace. - - - - - 1a767fa3 by Vladislav Zavialov at 2022-12-05T05:18:50-05:00 Add BufSpan to EpaLocation (#22319, #22558) The key part of this patch is the change to mkTokenLocation: - mkTokenLocation (RealSrcSpan r _) = TokenLoc (EpaSpan r) + mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan r mb) mkTokenLocation used to discard the BufSpan, but now it is saved and can be retrieved from LHsToken or LHsUniToken. This is made possible by the following change to EpaLocation: - data EpaLocation = EpaSpan !RealSrcSpan + data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan) | ... The end goal is to make use of the BufSpan in Parser/PostProcess/Haddock. - - - - - cd31acad by sheaf at 2022-12-06T15:45:58-05:00 Hadrian: fix ghcDebugAssertions off-by-one error Commit 6b2f7ffe changed the logic that decided whether to enable debug assertions. However, it had an off-by-one error, as the stage parameter to the function inconsistently referred to the stage of the compiler being used to build or the stage of the compiler we are building. This patch makes it consistent. Now the parameter always refers to the the compiler which is being built. In particular, this patch re-enables assertions in the stage 2 compiler when building with devel2 flavour, and disables assertions in the stage 2 compiler when building with validate flavour. Some extra performance tests are now run in the "validate" jobs because the stage2 compiler no longer contains assertions. ------------------------- Metric Decrease: CoOpt_Singletons MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot T11374 T12227 T12234 T13253-spj T13701 T14683 T14697 T15703 T17096 T17516 T18304 T18478 T18923 T5030 T9872b TcPlugin_RewritePerf Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T13386 T13719 T3294 T9233 T9675 parsing001 ------------------------- - - - - - 21d66db1 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInstallNameTool - - - - - aaaaa79b by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of askOtool - - - - - 4e28f49e by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of runInjectRPaths - - - - - a7422580 by mrkun at 2022-12-06T15:46:38-05:00 Push DynFlags out of Linker.MacOS - - - - - e902d771 by Matthew Craven at 2022-12-08T08:30:23-05:00 Fix bounds-checking buglet in Data.Array.Byte ...another manifestation of #20851 which I unfortunately missed in my first pass. - - - - - 8d36c0c6 by Gergő Érdi at 2022-12-08T08:31:03-05:00 Remove copy-pasted definitions of `graphFromEdgedVertices*` - - - - - c5d8ed3a by Gergő Érdi at 2022-12-08T08:31:03-05:00 Add version of `reachableGraph` that avoids loop for cyclic inputs by building its result connected component by component Fixes #22512 - - - - - 90cd5396 by Krzysztof Gogolewski at 2022-12-08T08:31:39-05:00 Mark Type.Reflection.Unsafe as Unsafe This module can be used to construct ill-formed TypeReps, so it should be Unsafe. - - - - - 2057c77d by Ian-Woo Kim at 2022-12-08T08:32:19-05:00 Truncate eventlog event for large payload (#20221) RTS eventlog events for postCapsetVecEvent are truncated if payload is larger than EVENT_PAYLOAD_SIZE_MAX Previously, postCapsetVecEvent records eventlog event with payload of variable size larger than EVENT_PAYLOAD_SIZE_MAX (2^16) without any validation, resulting in corrupted data. For example, this happens when a Haskell binary is invoked with very long command line arguments exceeding 2^16 bytes (see #20221). Now we check the size of accumulated payload messages incrementally, and truncate the message just before the payload size exceeds EVENT_PAYLOAD_SIZE_MAX. RTS will warn the user with a message showing how many arguments are truncated. - - - - - 9ec76f61 by Cheng Shao at 2022-12-08T08:32:59-05:00 hadrian: don't add debug info to non-debug ways of rts Hadrian used to pass -g when building all ways of rts. It makes output binaries larger (especially so for wasm backend), and isn't needed by most users out there, so this patch removes that flag. In case the debug info is desired, we still pass -g3 when building the debug way, and there's also the debug_info flavour transformer which ensures -g3 is passed for all rts ways. - - - - - 7658cdd4 by Krzysztof Gogolewski at 2022-12-08T08:33:36-05:00 Restore show (typeRep @[]) == "[]" The Show instance for TypeRep [] has changed in 9.5 to output "List" because the name of the type constructor changed. This seems to be accidental and is inconsistent with TypeReps of saturated lists, which are printed as e.g. "[Int]". For now, I'm restoring the old behavior; in the future, maybe we should show TypeReps without puns (List, Tuple, Type). - - - - - 216deefd by Matthew Pickering at 2022-12-08T22:45:27-05:00 Add test for #22162 - - - - - 5d0a311f by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job to test interface file determinism guarantees In this job we can run on every commit we add a test which builds the Cabal library twice and checks that the ABI hash and interface hash is stable across the two builds. * We run the test 20 times to try to weed out any race conditions due to `-j` * We run the builds in different temporary directories to try to weed out anything related to build directory affecting ABI or interface file hash. Fixes #22180 - - - - - 0a76d7d4 by Matthew Pickering at 2022-12-08T22:45:27-05:00 ci: Add job for testing interface stability across builds The idea is that both the bindists should product libraries with the same ABI and interface hash. So the job checks with ghc-pkg to make sure the computed ABI is the same. In future this job can be extended to check for the other facets of interface determinism. Fixes #22180 - - - - - 74c9bf91 by Matthew Pickering at 2022-12-08T22:45:27-05:00 backpack: Be more careful when adding together ImportAvails There was some code in the signature merging logic which added together the ImportAvails of the signature and the signature which was merged into it. This had the side-effect of making the merged signature depend on the signature (via a normal module dependency). The intention was to propagate orphan instances through the merge but this also messed up recompilation logic because we shouldn't be attempting to load B.hi when mergeing it. The fix is to just combine the part of ImportAvails that we intended to (transitive info, orphan instances and type family instances) rather than the whole thing. - - - - - d122e022 by Matthew Pickering at 2022-12-08T22:45:27-05:00 Fix mk_mod_usage_info if the interface file is not already loaded In #22217 it was observed that the order modules are compiled in affects the contents of an interface file. This was because a module dependended on another module indirectly, via a re-export but the interface file for this module was never loaded because the symbol was never used in the file. If we decide that we depend on a module then we jolly well ought to record this fact in the interface file! Otherwise it could lead to very subtle recompilation bugs if the dependency is not tracked and the module is updated. Therefore the best thing to do is just to make sure the file is loaded by calling the `loadSysInterface` function. This first checks the caches (like we did before) but then actually goes to find the interface on disk if it wasn't loaded. Fixes #22217 - - - - - ea25088d by lrzlin at 2022-12-08T22:46:06-05:00 Add initial support for LoongArch Architecture. - - - - - 9eb9d2f4 by Bodigrim at 2022-12-08T22:46:47-05:00 Update submodule mtl to 2.3.1, parsec to 3.1.15.1, haddock and Cabal to HEAD - - - - - 08d8fe2a by Bodigrim at 2022-12-08T22:46:47-05:00 Allow mtl-2.3 in hadrian - - - - - 3807a46c by Bodigrim at 2022-12-08T22:46:47-05:00 Support mtl-2.3 in check-exact - - - - - ef702a18 by Bodigrim at 2022-12-08T22:46:47-05:00 Fix tests - - - - - 3144e8ff by Sebastian Graf at 2022-12-08T22:47:22-05:00 Make (^) INLINE (#22324) So that we get to cancel away the allocation for the lazily used base. We can move `powImpl` (which *is* strict in the base) to the top-level so that we don't duplicate too much code and move the SPECIALISATION pragmas onto `powImpl`. The net effect of this change is that `(^)` plays along much better with inlining thresholds and loopification (#22227), for example in `x2n1`. Fixes #22324. - - - - - 1d3a8b8e by Matthew Pickering at 2022-12-08T22:47:59-05:00 Typeable: Fix module locations of some definitions in GHC.Types There was some confusion in Data.Typeable about which module certain wired-in things were defined in. Just because something is wired-in doesn't mean it comes from GHC.Prim, in particular things like LiftedRep and RuntimeRep are defined in GHC.Types and that's the end of the story. Things like Int#, Float# etc are defined in GHC.Prim as they have no Haskell definition site at all so we need to generate type representations for them (which live in GHC.Types). Fixes #22510 - - - - - 0f7588b5 by Sebastian Graf at 2022-12-08T22:48:34-05:00 Make `drop` and `dropWhile` fuse (#18964) I copied the fusion framework we have in place for `take`. T18964 asserts that we regress neither when fusion fires nor when it doesn't. Fixes #18964. - - - - - 26e71562 by Sebastian Graf at 2022-12-08T22:49:10-05:00 Do not strictify a DFun's parameter dictionaries (#22549) ... thus fixing #22549. The details are in the refurbished and no longer dead `Note [Do not strictify a DFun's parameter dictionaries]`. There's a regression test in T22549. - - - - - 36093407 by John Ericson at 2022-12-08T22:49:45-05:00 Delete `rts/package.conf.in` It is a relic of the Make build system. The RTS now uses a `package.conf` file generated the usual way by Cabal. - - - - - b0cc2fcf by Krzysztof Gogolewski at 2022-12-08T22:50:21-05:00 Fixes around primitive literals * The SourceText of primitive characters 'a'# did not include the #, unlike for other primitive literals 1#, 1##, 1.0#, 1.0##, "a"#. We can now remove the function pp_st_suffix, which was a hack to add the # back. * Negative primitive literals shouldn't use parentheses, as described in Note [Printing of literals in Core]. Added a testcase to T14681. - - - - - aacf616d by Bryan Richter at 2022-12-08T22:50:56-05:00 testsuite: Mark conc024 fragile on Windows - - - - - ed239a24 by Ryan Scott at 2022-12-09T09:42:16-05:00 Document TH splices' interaction with INCOHERENT instances Top-level declaration splices can having surprising interactions with `INCOHERENT` instances, as observed in #22492. This patch resolves #22492 by documenting this strange interaction in the GHC User's Guide. [ci skip] - - - - - 1023b432 by Mike Pilgrem at 2022-12-09T09:42:56-05:00 Fix #22300 Document GHC's extensions to valid whitespace - - - - - 79b0cec0 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Add support for environments that don't have setImmediate - - - - - 5b007ec5 by Luite Stegeman at 2022-12-09T09:43:38-05:00 Fix bound thread status - - - - - 65335d10 by Matthew Pickering at 2022-12-09T20:15:45-05:00 Update containers submodule This contains a fix necessary for the multi-repl to work on GHC's code base where we try to load containers and template-haskell into the same session. - - - - - 4937c0bb by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-multi: Put interface files in separate directories Before we were putting all the interface files in the same directory which was leading to collisions if the files were called the same thing. - - - - - 8acb5b7b by Matthew Pickering at 2022-12-09T20:15:45-05:00 hadrian-toolargs: Add filepath to allowed repl targets - - - - - 5949d927 by Matthew Pickering at 2022-12-09T20:15:45-05:00 driver: Set correct UnitId when rehydrating modules We were not setting the UnitId before rehydrating modules which just led to us attempting to find things in the wrong HPT. The test for this is the hadrian-multi command (which is now added as a CI job). Fixes #22222 - - - - - ab06c0f0 by Matthew Pickering at 2022-12-09T20:15:45-05:00 ci: Add job to test hadrian-multi command I am not sure this job is good because it requires booting HEAD with HEAD, but it should be fine. - - - - - fac3e568 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hadrian: Update bootstrap plans to 9.2.* series and 9.4.* series. This updates the build plans for the most recent compiler versions, as well as fixing the hadrian-bootstrap-gen script to a specific GHC version. - - - - - 195b08b4 by Matthew Pickering at 2022-12-09T20:16:20-05:00 ci: Bump boot images to use ghc-9.4.3 Also updates the bootstrap jobs to test booting 9.2 and 9.4. - - - - - c658c580 by Matthew Pickering at 2022-12-09T20:16:20-05:00 hlint: Removed redundant UnboxedSums pragmas UnboxedSums is quite confusingly implied by UnboxedTuples, alas, just the way it is. See #22485 - - - - - b3e98a92 by Oleg Grenrus at 2022-12-11T12:26:17-05:00 Add heqT, a kind-heterogeneous variant of heq CLC proposal https://github.com/haskell/core-libraries-committee/issues/99 - - - - - bfd7c1e6 by Bodigrim at 2022-12-11T12:26:55-05:00 Document that Bifunctor instances for tuples are lawful only up to laziness - - - - - 5d1a1881 by Bryan Richter at 2022-12-12T16:22:36-05:00 Mark T21336a fragile - - - - - c30accc2 by Matthew Pickering at 2022-12-12T16:23:11-05:00 Add test for #21476 This issues seems to have been fixed since the ticket was made, so let's add a test and move on. Fixes #21476 - - - - - e9d74a3e by Sebastian Graf at 2022-12-13T22:18:39-05:00 Respect -XStrict in the pattern-match checker (#21761) We were missing a call to `decideBangHood` in the pattern-match checker. There is another call in `matchWrapper.mk_eqn_info` which seems redundant but really is not; see `Note [Desugaring -XStrict matches in Pmc]`. Fixes #21761. - - - - - 884790e2 by Gergő Érdi at 2022-12-13T22:19:14-05:00 Fix loop in the interface representation of some `Unfolding` fields As discovered in #22272, dehydration of the unfolding info of a recursive definition used to involve a traversal of the definition itself, which in turn involves traversing the unfolding info. Hence, a loop. Instead, we now store enough data in the interface that we can produce the unfolding info without this traversal. See Note [Tying the 'CoreUnfolding' knot] for details. Fixes #22272 Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00 EPA: When splitting out header comments, keep ones for first decl Any comments immediately preceding the first declaration are no longer kept as header comments, but attach to the first declaration instead. - - - - - 8b1f1b45 by Sylvain Henry at 2022-12-13T22:20:28-05:00 JS: fix object file name comparison (#22578) - - - - - e9e161bb by Bryan Richter at 2022-12-13T22:21:03-05:00 configure: Bump min bootstrap GHC version to 9.2 - - - - - 75855643 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Don't enable TSAN in stage0 build - - - - - da7b51d8 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce blockConcat - - - - - 34f6b09c by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm: Introduce MemoryOrderings - - - - - 43beaa7b by Ben Gamari at 2022-12-15T03:54:02-05:00 llvm: Respect memory specified orderings - - - - - 8faf74fc by Ben Gamari at 2022-12-15T03:54:02-05:00 Codegen/x86: Eliminate barrier for relaxed accesses - - - - - 6cc3944a by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Reduce some repetition - - - - - 6c9862c4 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Add syntax for ordered loads and stores - - - - - 748490d2 by Ben Gamari at 2022-12-15T03:54:02-05:00 cmm/Parser: Atomic load syntax Originally I had thought I would just use the `prim` call syntax instead of introducing new syntax for atomic loads. However, it turns out that `prim` call syntax tends to make things quite unreadable. This new syntax seems quite natural. - - - - - 28c6781a by Ben Gamari at 2022-12-15T03:54:02-05:00 codeGen: Introduce ThreadSanitizer instrumentation This introduces a new Cmm pass which instruments the program with ThreadSanitizer annotations, allowing full tracking of mutator memory accesses via TSAN. - - - - - d97aa311 by Ben Gamari at 2022-12-15T03:54:02-05:00 Hadrian: Drop TSAN_ENABLED define from flavour This is redundant since the TSANUtils.h already defines it. - - - - - 86974ef1 by Ben Gamari at 2022-12-15T03:54:02-05:00 hadrian: Enable Cmm instrumentation in TSAN flavour - - - - - 93723290 by Ben Gamari at 2022-12-15T03:54:02-05:00 rts: Ensure that global regs are never passed as fun call args This is in general unsafe as they may be clobbered if they are mapped to caller-saved machine registers. See Note [Register parameter passing]. - - - - - 2eb0fb87 by Matthew Pickering at 2022-12-15T03:54:39-05:00 Package Imports: Get candidate packages also from re-exported modules Previously we were just looking at the direct imports to try and work out what a package qualifier could apply to but #22333 pointed out we also needed to look for reexported modules. Fixes #22333 - - - - - 552b7908 by Ben Gamari at 2022-12-15T03:55:15-05:00 compiler: Ensure that MutVar operations have necessary barriers Here we add acquire and release barriers in readMutVar# and writeMutVar#, which are necessary for soundness. Fixes #22468. - - - - - 933d61a4 by Simon Peyton Jones at 2022-12-15T03:55:51-05:00 Fix bogus test in Lint The Lint check for branch compatiblity within an axiom, in GHC.Core.Lint.compatible_branches was subtly different to the check made when contructing an axiom, in GHC.Core.FamInstEnv.compatibleBranches. The latter is correct, so I killed the former and am now using the latter. On the way I did some improvements to pretty-printing and documentation. - - - - - 03ed0b95 by Ryan Scott at 2022-12-15T03:56:26-05:00 checkValidInst: Don't expand synonyms when splitting sigma types Previously, the `checkValidInst` function (used when checking that an instance declaration is headed by an actual type class, not a type synonym) was using `tcSplitSigmaTy` to split apart the `forall`s and instance context. This is incorrect, however, as `tcSplitSigmaTy` expands type synonyms, which can cause instances headed by quantified constraint type synonyms to be accepted erroneously. This patch introduces `splitInstTyForValidity`, a variant of `tcSplitSigmaTy` specialized for validity checking that does _not_ expand type synonyms, and uses it in `checkValidInst`. Fixes #22570. - - - - - ed056bc3 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/Messages: Refactor This doesn't change behavior but makes the code a bit easier to follow. - - - - - 7356f8e0 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/ThreadPaused: Ordering fixes - - - - - 914f0025 by Ben Gamari at 2022-12-16T16:12:44-05:00 eventlog: Silence spurious data race - - - - - fbc84244 by Ben Gamari at 2022-12-16T16:12:44-05:00 Introduce SET_INFO_RELEASE for Cmm - - - - - 821b5472 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Use fences instead of explicit barriers - - - - - 2228c999 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts/stm: Fix memory ordering in readTVarIO# See #22421. - - - - - 99269b9f by Ben Gamari at 2022-12-16T16:12:44-05:00 Improve heap memory barrier Note Also introduce MUT_FIELD marker in Closures.h to document mutable fields. - - - - - 70999283 by Ben Gamari at 2022-12-16T16:12:44-05:00 rts: Introduce getNumCapabilities And ensure accesses to n_capabilities are atomic (although with relaxed ordering). This is necessary as RTS API callers may concurrently call into the RTS without holding a capability. - - - - - 98689f77 by Ben Gamari at 2022-12-16T16:12:44-05:00 ghc: Fix data race in dump file handling Previously the dump filename cache would use a non-atomic update which could potentially result in lost dump contents. Note that this is still a bit racy since the first writer may lag behind a later appending writer. - - - - - 605d9547 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Always use atomics for context_switch and interrupt Since these are modified by the timer handler. - - - - - 86f20258 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts/Timer: Always use atomic operations As noted in #22447, the existence of the pthread-based ITimer implementation means that we cannot assume that the program is single-threaded. - - - - - f8e901dc by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate recent_activity access This makes it easier to ensure that it is accessed using the necessary atomic operations. - - - - - e0affaa9 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate access to capabilities array - - - - - 7ca683e4 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Encapsulate sched_state - - - - - 1cf13bd0 by Ben Gamari at 2022-12-16T16:12:45-05:00 PrimOps: Fix benign MutVar race Relaxed ordering is fine here since the later CAS implies a release. - - - - - 3d2a7e08 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Style fix - - - - - 82c62074 by Ben Gamari at 2022-12-16T16:12:45-05:00 compiler: Use release store in eager blackholing - - - - - eb1a0136 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Fix ordering of makeStableName - - - - - ad0e260a by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Use ordered accesses instead of explicit barriers - - - - - a3eccf06 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Statically allocate capabilities This is a rather simplistic way of solving #17289. - - - - - 287fa3fb by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Ensure that all accesses to pending_sync are atomic - - - - - 351eae58 by Ben Gamari at 2022-12-16T16:12:45-05:00 rts: Note race with wakeBlockingQueue - - - - - 5acf33dd by Bodigrim at 2022-12-16T16:13:22-05:00 Bump submodule directory to 1.3.8.0 and hpc to HEAD - - - - - 0dd95421 by Bodigrim at 2022-12-16T16:13:22-05:00 Accept allocations increase on Windows This is because of `filepath-1.4.100.0` and AFPP, causing increasing round-trips between lists and ByteArray. See #22625 for discussion. Metric Increase: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T10547 T12150 T12227 T12234 T12425 T13035 T13253 T13253-spj T13701 T13719 T15703 T16875 T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T21839r T5837 T6048 T9198 T9961 TcPlugin_RewritePerf hard_hole_fits - - - - - ef9ac9d2 by Cheng Shao at 2022-12-16T16:13:59-05:00 testsuite: Mark T9405 as fragile instead of broken on Windows It's starting to pass again, and the unexpected pass blocks CI. - - - - - 1f3abd85 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: remove obsolete commented code in wasm NCG It was just a temporary hack to workaround a bug in the relooper, that bug has been fixed long before the wasm backend is merged. - - - - - e3104eab by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm Also removes some unreachable code here. - - - - - 1c6930bf by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: change fallback function signature to Cmm function signature in wasm NCG In the wasm NCG, when handling a `CLabel` of undefined function without knowing its function signature, we used to fallback to `() -> ()` which is accepted by `wasm-ld`. This patch changes it to the signature of Cmm functions, which equally works, but would be required when we emit tail call instructions. - - - - - 8a81d9d9 by Cheng Shao at 2022-12-16T21:16:28+00:00 compiler: add optional tail-call support in wasm NCG When the `-mtail-call` clang flag is passed at configure time, wasm tail-call extension is enabled, and the wasm NCG will emit `return_call`/`return_call_indirect` instructions to take advantage of it and avoid the `StgRun` trampoline overhead. Closes #22461. - - - - - d1431cc0 by Cheng Shao at 2022-12-17T08:07:15-05:00 base: add missing autoconf checks for waitpid/umask These are not present in wasi-libc. Required for fixing #22589 - - - - - da3f1e91 by Cheng Shao at 2022-12-17T08:07:51-05:00 compiler: make .wasm the default executable extension on wasm32 Following convention as in other wasm toolchains. Fixes #22594. - - - - - ad21f4ef by Cheng Shao at 2022-12-17T08:07:51-05:00 ci: support hello.wasm in ci.sh cross testing logic - - - - - 6fe2d778 by amesgen at 2022-12-18T19:33:49-05:00 Correct `exitWith` Haddocks The `IOError`-specific `catch` in the Prelude is long gone. - - - - - b3eacd64 by Ben Gamari at 2022-12-18T19:34:24-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 761c1f49 by Ben Gamari at 2022-12-18T19:35:00-05:00 rts/libdw: Silence uninitialized usage warnings As noted in #22538, previously some GCC versions warned that various locals in Libdw.c may be used uninitialized. Although this wasn't strictly true (since they were initialized in an inline assembler block) we fix this by providing explicit empty initializers. Fixes #22538 - - - - - 5e047eff by Matthew Pickering at 2022-12-20T15:12:04+00:00 testsuite: Mark T16392 as fragile on windows See #22649 - - - - - 703a4665 by M Farkas-Dyck at 2022-12-20T21:14:46-05:00 Scrub some partiality in `GHC.Cmm.Info.Build`: `doSRTs` takes a `[(CAFSet, CmmDecl)]` but truly wants a `[(CAFSet, CmmStatics)]`. - - - - - 9736ab74 by Matthew Pickering at 2022-12-20T21:15:22-05:00 packaging: Fix upload_ghc_libs.py script This change reflects the changes where .cabal files are now generated by hadrian rather than ./configure. Fixes #22518 - - - - - 7c6de18d by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Drop uses of AC_PROG_CC_C99 As noted in #22566, this macro is deprecated as of autoconf-2.70 `AC_PROG_CC` now sets `ac_cv_prog_cc_c99` itself. Closes #22566. - - - - - 36c5d98e by Ben Gamari at 2022-12-20T21:15:57-05:00 configure: Use AS_HELP_STRING instead of AC_HELP_STRING The latter has been deprecated. See #22566. - - - - - befe6ff8 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: fix various usages of head and tail - - - - - 666d0ba7 by Bodigrim at 2022-12-20T21:16:37-05:00 GHCi.UI: avoid head and tail in parseCallEscape and around - - - - - 5d96fd50 by Bodigrim at 2022-12-20T21:16:37-05:00 Make GHC.Driver.Main.hscTcRnLookupRdrName to return NonEmpty - - - - - 3ce2ab94 by Bodigrim at 2022-12-21T06:17:56-05:00 Allow transformers-0.6 in ghc, ghci, ghc-bin and hadrian - - - - - 954de93a by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule haskeline to HEAD (to allow transformers-0.6) - - - - - cefbeec3 by Bodigrim at 2022-12-21T06:17:56-05:00 Update submodule transformers to 0.6.0.4 - - - - - b4730b62 by Bodigrim at 2022-12-21T06:17:56-05:00 Fix tests T13253 imports MonadTrans, which acquired a quantified constraint in transformers-0.6, thus increase in allocations Metric Increase: T13253 - - - - - 0be75261 by Simon Peyton Jones at 2022-12-21T06:18:32-05:00 Abstract over the right free vars Fix #22459, in two ways: (1) Make the Specialiser not create a bogus specialisation if it is presented by strangely polymorphic dictionary. See Note [Weird special case in SpecDict] in GHC.Core.Opt.Specialise (2) Be more careful in abstractFloats See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. So (2) stops creating the excessively polymorphic dictionary in abstractFloats, while (1) stops crashing if some other pass should nevertheless create a weirdly polymorphic dictionary. - - - - - df7bc6b3 by Ying-Ruei Liang (TheKK) at 2022-12-21T14:31:54-05:00 rts: explicitly store return value of ccall checkClosure to prevent type error (#22617) - - - - - e193e537 by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix shadowing lacuna in OccurAnal Issue #22623 demonstrated another lacuna in the implementation of wrinkle (BS3) in Note [The binder-swap substitution] in the occurrence analyser. I was failing to add TyVar lambda binders using addInScope/addOneInScope and that led to a totally bogus binder-swap transformation. Very easy to fix. - - - - - 3d55d8ab by Simon Peyton Jones at 2022-12-21T14:32:30-05:00 Fix an assertion check in addToEqualCtList The old assertion saw that a constraint ct could rewrite itself (of course it can) and complained (stupid). Fixes #22645 - - - - - ceb2e9b9 by Ben Gamari at 2022-12-21T15:26:08-05:00 configure: Bump version to 9.6 - - - - - fb4d36c4 by Ben Gamari at 2022-12-21T15:27:49-05:00 base: Bump version to 4.18 Requires various submodule bumps. - - - - - 93ee7e90 by Ben Gamari at 2022-12-21T15:27:49-05:00 ghc-boot: Fix bootstrapping - - - - - fc3a2232 by Ben Gamari at 2022-12-22T13:45:06-05:00 Bump GHC version to 9.7 - - - - - 914f7fe3 by Andreas Klebinger at 2022-12-22T23:36:10-05:00 Don't consider large byte arrays/compact regions pinned. Workaround for #22255 which showed how treating large/compact regions as pinned could cause segfaults. - - - - - 32b32d7f by Matthew Pickering at 2022-12-22T23:36:46-05:00 hadrian bindist: Install manpages to share/man/man1/ghc.1 When the installation makefile was copied over the manpages were no longer installed in the correct place. Now we install it into share/man/man1/ghc.1 as the make build system did. Fixes #22371 - - - - - b3ddf803 by Ben Gamari at 2022-12-22T23:37:23-05:00 rts: Drop paths from configure from cabal file A long time ago we would rely on substitutions from the configure script to inject paths of the include and library directories of libffi and libdw. However, now these are instead handled inside Hadrian when calling Cabal's `configure` (see the uses of `cabalExtraDirs` in Hadrian's `Settings.Packages.packageArgs`). While the occurrences in the cabal file were redundant, they did no harm. However, since b5c714545abc5f75a1ffdcc39b4bfdc7cd5e64b4 they have no longer been interpolated. @mpickering noticed the suspicious uninterpolated occurrence of `@FFIIncludeDir@` in #22595, prompting this commit to finally remove them. - - - - - b2c7523d by Ben Gamari at 2022-12-22T23:37:59-05:00 Bump libffi-tarballs submodule We will now use libffi-3.4.4. - - - - - 3699a554 by Alan Zimmerman at 2022-12-22T23:38:35-05:00 EPA: Make EOF position part of AnnsModule Closes #20951 Closes #19697 - - - - - 99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00 JS: fix support for -outputdir (#22641) The `-outputdir` option wasn't correctly handled with the JS backend because the same code path was used to handle both objects produced by the JS backend and foreign .js files. Now we clearly distinguish the two in the pipeline, fixing the bug. - - - - - 02ed7d78 by Simon Peyton Jones at 2022-12-22T23:39:49-05:00 Refactor mkRuntimeError This patch fixes #22634. Because we don't have TYPE/CONSTRAINT polymorphism, we need two error functions rather than one. I took the opportunity to rname runtimeError to impossibleError, to line up with mkImpossibleExpr, and avoid confusion with the genuine runtime-error-constructing functions. - - - - - 35267f07 by Ben Gamari at 2022-12-22T23:40:32-05:00 base: Fix event manager shutdown race on non-Linux platforms During shutdown it's possible that we will attempt to use a closed fd to wakeup another capability's event manager. On the Linux eventfd path we were careful to handle this. However on the non-Linux path we failed to do so. Fix this. - - - - - 317f45c1 by Simon Peyton Jones at 2022-12-22T23:41:07-05:00 Fix unifier bug: failing to decompose over-saturated type family This simple patch fixes #22647 - - - - - 14b2e3d3 by Ben Gamari at 2022-12-22T23:41:42-05:00 rts/m32: Fix sanity checking Previously we would attempt to clear pages which were marked as read-only. Fix this. - - - - - 16a1bcd1 by Matthew Pickering at 2022-12-23T09:15:24+00:00 ci: Move wasm pipelines into nightly rather than master See #22664 for the changes which need to be made to bring one of these back to the validate pipeline. - - - - - 18d2acd2 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in marking of blackholes We must use an acquire-fence when marking to ensure that the indirectee is visible. - - - - - 11241efa by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix segment list races - - - - - 602455c9 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Use atomic when looking at bd->gen Since it may have been mutated by a moving GC. - - - - - 9d63b160 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Eliminate race in bump_static_flag To ensure that we don't race with a mutator entering a new CAF we take the SM mutex before touching static_flag. The other option here would be to instead modify newCAF to use a CAS but the present approach is a bit safer. - - - - - 26837523 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that mutable fields have acquire barrier - - - - - 8093264a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix races in collector status tracking Mark a number of accesses to do with tracking of the status of the concurrent collection thread as atomic. No interesting races here, merely necessary to satisfy TSAN. - - - - - 387d4fcc by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make segment state updates atomic - - - - - 543cae00 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Refactor update remembered set initialization This avoids a lock inversion between the storage manager mutex and the stable pointer table mutex by not dropping the SM_MUTEX in nonmovingCollect. This requires quite a bit of rejiggering but it does seem like a better strategy. - - - - - c9936718 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Ensure that we aren't holding locks when closing them TSAN complains about this sort of thing. - - - - - 0cd31f7d by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make bitmap accesses atomic This is a benign race on any sensible hard since these are byte accesses. Nevertheless, atomic accesses are necessary to satisfy TSAN. - - - - - d3fe110a by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix benign race in update remembered set check Relaxed load is fine here since we will take the lock before looking at the list. - - - - - ab6cf893 by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Fix race in shortcutting We must use an acquire load to read the info table pointer since if we find an indirection we must be certain that we see the indirectee. - - - - - 36c9f23c by Ben Gamari at 2022-12-23T19:09:30-05:00 nonmoving: Make free list counter accesses atomic Since these may race with the allocator(s). - - - - - aebef31c by doyougnu at 2022-12-23T19:10:09-05:00 add GHC.Utils.Binary.foldGet' and use for Iface A minor optimization to remove lazy IO and a lazy accumulator strictify foldGet' IFace.Binary: use strict foldGet' remove superfluous bang - - - - - 5eb357d9 by Ben Gamari at 2022-12-24T00:41:05-05:00 compiler: Ensure that GHC toolchain is first in search path As noted in #22561, it is important that GHC's toolchain look first for its own headers and libraries to ensure that the system's are not found instead. If this happens things can break in surprising ways (e.g. see #22561). - - - - - cbaebfb9 by Matthew Pickering at 2022-12-24T00:41:40-05:00 head.hackage: Use slow-validate bindist for linting jobs This enables the SLOW_VALIDATE env var for the linting head.hackage jobs, namely the jobs enabled manually, by the label or on the nightly build now use the deb10-numa-slow-validate bindist which has assertions enabled. See #22623 for a ticket which was found by using this configuration already! The head.hackage jobs triggered by upstream CI are now thusly: hackage-lint: Can be triggered on any MR, normal validate pipeline or nightly build. Runs head.hackage with -dlint and a slow-validate bindist hackage-label-lint: Trigged on MRs with "user-facing" label, runs the slow-validate head.hackage build with -dlint. nightly-hackage-lint: Runs automatically on nightly pipelines with slow-validate + dlint config. nightly-hackage-perf: Runs automaticaly on nightly pipelines with release build and eventlogging enabled. release-hackage-lint: Runs automatically on release pipelines with -dlint on a release bindist. - - - - - f4850f36 by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Don't run abi-test-nightly on release jobs The test is not configured to get the correct dependencies for the release pipelines (and indeed stops the release pipeline being run at all) - - - - - c264b06b by Matthew Pickering at 2022-12-24T00:41:40-05:00 ci: Run head.hackage jobs on upstream-testing branch rather than master This change allows less priviledged users to trigger head.hackage jobs because less permissions are needed to trigger jobs on the upstream-testing branch, which is not protected. There is a CI job which updates upstream-testing each hour to the state of the master branch so it should always be relatively up-to-date. - - - - - 63b97430 by Ben Gamari at 2022-12-24T00:42:16-05:00 llvmGen: Fix relaxed ordering Previously I used LLVM's `unordered` ordering for the C11 `relaxed` ordering. However, this is wrong and should rather use the LLVM `monotonic` ordering. Fixes #22640 - - - - - f42ba88f by Ben Gamari at 2022-12-24T00:42:16-05:00 gitlab-ci: Introduce aarch64-linux-llvm job This nightly job will ensure that we don't break the LLVM backend on AArch64/Linux by bootstrapping GHC. This would have caught #22640. - - - - - 6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00 Store RdrName rather than OccName in Holes In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130 - - - - - 3c3060e4 by Richard Eisenberg at 2022-12-24T17:34:19+00:00 Drop support for kind constraints. This implements proposal 547 and closes ticket #22298. See the proposal and ticket for motivation. Compiler perf improves a bit Metrics: compile_time/bytes allocated ------------------------------------- CoOpt_Singletons(normal) -2.4% GOOD T12545(normal) +1.0% T13035(normal) -13.5% GOOD T18478(normal) +0.9% T9872d(normal) -2.2% GOOD geo. mean -0.2% minimum -13.5% maximum +1.0% Metric Decrease: CoOpt_Singletons T13035 T9872d - - - - - 6d7d4393 by Ben Gamari at 2022-12-24T21:09:56-05:00 hadrian: Ensure that linker scripts are used when merging objects In #22527 @rui314 inadvertantly pointed out a glaring bug in Hadrian's implementation of the object merging rules: unlike the old `make` build system we utterly failed to pass the needed linker scripts. Fix this. - - - - - a5bd0eb8 by Bodigrim at 2022-12-24T21:10:34-05:00 Document infelicities of instance Ord Double and workarounds - - - - - 62b9a7b2 by Zubin Duggal at 2023-01-03T12:22:11+00:00 Force the Docs structure to prevent leaks in GHCi with -haddock without -fwrite-interface Involves adding many new NFData instances. Without forcing Docs, references to the TcGblEnv for each module are retained by the Docs structure. Usually these are forced when the ModIface is serialised but not when we aren't writing the interface. - - - - - 21bedd84 by Facundo Domínguez at 2023-01-03T23:27:30-05:00 Explain the auxiliary functions of permutations - - - - - 32255d05 by Matthew Pickering at 2023-01-04T11:58:42+00:00 compiler: Add -f[no-]split-sections flags Here we add a `-fsplit-sections` flag which may some day replace `-split-sections`. This has the advantage of automatically providing a `-fno-split-sections` flag, which is useful for our packaging because we enable `-split-sections` by default but want to disable it in certain configurations. - - - - - e640940c by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Fix computation of tables_next_to_code for outOfTreeCompiler This copy-pasto was introduced in de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b - - - - - 15bee123 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add test:all_deps to build just testsuite dependencies Fixes #22534 - - - - - fec6638e by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Add no_split_sections tranformer This transformer reverts the effect of `split_sections`, which we intend to use for platforms which don't support split sections. In order to achieve this we have to modify the implemntation of the split_sections transformer to store whether we are enabling split_sections directly in the `Flavour` definition. This is because otherwise there's no convenient way to turn off split_sections due to having to pass additional linker scripts when merging objects. - - - - - 3dc05726 by Matthew Pickering at 2023-01-04T11:58:42+00:00 check-exact: Fix build with -Werror - - - - - 53a6ae7a by Matthew Pickering at 2023-01-04T11:58:42+00:00 ci: Build all test dependencies with in-tree compiler This means that these executables will honour flavour transformers such as "werror". Fixes #22555 - - - - - 32e264c1 by Matthew Pickering at 2023-01-04T11:58:42+00:00 hadrian: Document using GHC environment variable to select boot compiler Fixes #22340 - - - - - be9dd9b0 by Matthew Pickering at 2023-01-04T11:58:42+00:00 packaging: Build perf builds with -split-sections In 8f71d958 the make build system was made to use split-sections on linux systems but it appears this logic never made it to hadrian. There is the split_sections flavour transformer but this doesn't appear to be used for perf builds on linux. This is disbled on deb9 and windows due to #21670 Closes #21135 - - - - - 00dc5106 by Matthew Pickering at 2023-01-04T14:32:45-05:00 sphinx: Use modern syntax for extlinks This fixes the following build error: ``` Command line: /opt/homebrew/opt/sphinx-doc/bin/sphinx-build -b man -d /private/tmp/extra-dir-55768274273/.doctrees-man -n -w /private/tmp/extra-dir-55768274273/.log docs/users_guide /private/tmp/extra-dir-55768274273 ===> Command failed with error code: 2 Exception occurred: File "/opt/homebrew/Cellar/sphinx-doc/6.0.0/libexec/lib/python3.11/site-packages/sphinx/ext/extlinks.py", line 101, in role title = caption % part ~~~~~~~~^~~~~~ TypeError: not all arguments converted during string formatting ``` I tested on Sphinx-5.1.1 and Sphinx-6.0.0 Thanks for sterni for providing instructions about how to test using sphinx-6.0.0. Fixes #22690 - - - - - 541aedcd by Krzysztof Gogolewski at 2023-01-05T10:48:34-05:00 Misc cleanup - Remove unused uniques and hs-boot declarations - Fix types of seq and unsafeCoerce# - Remove FastString/String roundtrip in JS - Use TTG to enforce totality - Remove enumeration in Heap/Inspect; the 'otherwise' clause serves the primitive types well. - - - - - 22bb8998 by Alan Zimmerman at 2023-01-05T10:49:09-05:00 EPA: Do not collect comments from end of file In Parser.y semis1 production triggers for the virtual semi at the end of the file. This is detected by it being zero length. In this case, do not extend the span being used to gather comments, so any final comments are allocated at the module level instead. - - - - - 9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00 HsToken in TypeArg (#19623) Updates the haddock submodule. - - - - - b2a2db04 by Matthew Pickering at 2023-01-05T23:02:30-05:00 Revert "configure: Drop uses of AC_PROG_CC_C99" This reverts commit 7c6de18dd3151ead954c210336728e8686c91de6. Centos7 using a very old version of the toolchain (autotools-2.69) where the behaviour of these macros has not yet changed. I am reverting this without haste as it is blocking the 9.6 branch. Fixes #22704 - - - - - 28f8c0eb by Luite Stegeman at 2023-01-06T18:16:24+09:00 Add support for sized literals in the bytecode interpreter. The bytecode interpreter only has branching instructions for word-sized values. These are used for pattern matching. Branching instructions for other types (e.g. Int16# or Word8#) weren't needed, since unoptimized Core or STG never requires branching on types like this. It's now possible for optimized STG to reach the bytecode generator (e.g. fat interface files or certain compiler flag combinations), which requires dealing with various sized literals in branches. This patch improves support for generating bytecode from optimized STG by adding the following new bytecode instructions: TESTLT_I64 TESTEQ_I64 TESTLT_I32 TESTEQ_I32 TESTLT_I16 TESTEQ_I16 TESTLT_I8 TESTEQ_I8 TESTLT_W64 TESTEQ_W64 TESTLT_W32 TESTEQ_W32 TESTLT_W16 TESTEQ_W16 TESTLT_W8 TESTEQ_W8 Fixes #21945 - - - - - ac39e8e9 by Matthew Pickering at 2023-01-06T13:47:00-05:00 Only store Name in FunRhs rather than Id with knot-tied fields All the issues here have been caused by #18758. The goal of the ticket is to be able to talk about things like `LTyClDecl GhcTc`. In the case of HsMatchContext, the correct "context" is whatever we want, and in fact storing just a `Name` is sufficient and correct context, even if the rest of the AST is storing typechecker Ids. So this reverts (#20415, !5579) which intended to get closed to #18758 but didn't really and introduced a few subtle bugs. Printing of an error message in #22695 would just hang, because we would attempt to print the `Id` in debug mode to assertain whether it was empty or not. Printing the Name is fine for the error message. Another consequence is that when `-dppr-debug` was enabled the compiler would hang because the debug printing of the Id would try and print fields which were not populated yet. This also led to 32070e6c2e1b4b7c32530a9566fe14543791f9a6 having to add a workaround for the `checkArgs` function which was probably a very similar bug to #22695. Fixes #22695 - - - - - c306d939 by Matthew Pickering at 2023-01-06T22:08:53-05:00 ci: Upgrade darwin, windows and freebsd CI to use GHC-9.4.3 Fixes #22599 - - - - - 0db496ff by Matthew Pickering at 2023-01-06T22:08:53-05:00 darwin ci: Explicitly pass desired build triple to configure On the zw3rk machines for some reason the build machine was inferred to be arm64. Setting the build triple appropiately resolve this confusion and we produce x86 binaries. - - - - - 2459c358 by Ben Gamari at 2023-01-06T22:09:29-05:00 rts: MUT_VAR is not a StgMutArrPtrs There was previously a comment claiming that the MUT_VAR closure type had the layout of StgMutArrPtrs. - - - - - 6206cb92 by Simon Peyton Jones at 2023-01-07T12:14:40-05:00 Make FloatIn robust to shadowing This MR fixes #22622. See the new Note [Shadowing and name capture] I did a bit of refactoring in sepBindsByDropPoint too. The bug doesn't manifest in HEAD, but it did show up in 9.4, so we should backport this patch to 9.4 - - - - - a960ca81 by Matthew Pickering at 2023-01-07T12:15:15-05:00 T10955: Set DYLD_LIBRARY_PATH for darwin The correct path to direct the dynamic linker on darwin is DYLD_LIBRARY_PATH rather than LD_LIBRARY_PATH. On recent versions of OSX using LD_LIBRARY_PATH seems to have stopped working. For more reading see: https://stackoverflow.com/questions/3146274/is-it-ok-to-use-dyld-library-path-on-mac-os-x-and-whats-the-dynamic-library-s - - - - - 73484710 by Matthew Pickering at 2023-01-07T12:15:15-05:00 Skip T18623 on darwin (to add to the long list of OSs) On recent versions of OSX, running `ulimit -v` results in ``` ulimit: setrlimit failed: invalid argument ``` Time is too short to work out what random stuff Apple has been doing with ulimit, so just skip the test like we do for other platforms. - - - - - 8c0ea25f by Matthew Pickering at 2023-01-07T12:15:15-05:00 Pass -Wl,-no_fixup_chains to ld64 when appropiate Recent versions of MacOS use a version of ld where `-fixup_chains` is on by default. This is incompatible with our usage of `-undefined dynamic_lookup`. Therefore we explicitly disable `fixup-chains` by passing `-no_fixup_chains` to the linker on darwin. This results in a warning of the form: ld: warning: -undefined dynamic_lookup may not work with chained fixups The manual explains the incompatible nature of these two flags: -undefined treatment Specifies how undefined symbols are to be treated. Options are: error, warning, suppress, or dynamic_lookup. The default is error. Note: dynamic_lookup that depends on lazy binding will not work with chained fixups. A relevant ticket is #22429 Here are also a few other links which are relevant to the issue: Official comment: https://developer.apple.com/forums/thread/719961 More relevant links: https://openradar.appspot.com/radar?id=5536824084660224 https://github.com/python/cpython/issues/97524 Note in release notes: https://developer.apple.com/documentation/xcode-release-notes/xcode-13-releas e-notes - - - - - 365b3045 by Matthew Pickering at 2023-01-09T02:36:20-05:00 Disable split sections on aarch64-deb10 build See #22722 Failure on this job: https://gitlab.haskell.org/ghc/ghc/-/jobs/1287852 ``` Unexpected failures: /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T10828.run T10828 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T13123.run T13123 [exit code non-0] (ext-interp) /builds/ghc/ghc/tmp/ghctest-s3d8g1hj/test spaces/testsuite/tests/th/T20590.run T20590 [exit code non-0] (ext-interp) Appending 232 stats to file: /builds/ghc/ghc/performance-metrics.tsv ``` ``` Compile failed (exit code 1) errors were: data family D_0 a_1 :: * -> * data instance D_0 GHC.Types.Int GHC.Types.Bool :: * where DInt_2 :: D_0 GHC.Types.Int GHC.Types.Bool data E_3 where MkE_4 :: a_5 -> E_3 data Foo_6 a_7 b_8 where MkFoo_9, MkFoo'_10 :: a_11 -> Foo_6 a_11 b_12 newtype Bar_13 :: * -> GHC.Types.Bool -> * where MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 GHC.Types.Int => {T10828.foo :: a_2, T10828.bar :: b_3} -> T10828.T GHC.Types.Int T10828.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: (do TyConI dec <- runQ $ reify (mkName "T") runIO $ putStrLn (pprint dec) >> hFlush stdout d <- runQ $ [d| data T' a :: Type where MkT' :: a -> a -> T' a MkC' :: forall a b. (a ~ Int) => {foo :: a, bar :: b} -> T' Int |] runIO $ putStrLn (pprint d) >> hFlush stdout ....) *** unexpected failure for T10828(ext-interp) =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] =====> 7000 of 9215 [0, 1, 0] Compile failed (exit code 1) errors were: T13123.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data GADT where MkGADT :: forall k proxy (a :: k). proxy a -> GADT |]) *** unexpected failure for T13123(ext-interp) =====> 7100 of 9215 [0, 2, 0] =====> 7100 of 9215 [0, 2, 0] =====> 7200 of 9215 [0, 2, 0] Compile failed (exit code 1) errors were: T20590.hs:1:1: error: [GHC-87897] Exception when trying to run compile-time code: ghc-iserv terminated (-4) Code: ([d| data T where MkT :: forall a. a -> T |]) *** unexpected failure for T20590(ext-interp) ``` Looks fairly worrying to me. - - - - - 965a2735 by Alan Zimmerman at 2023-01-09T02:36:20-05:00 EPA: exact print HsDocTy To match ghc-exactprint https://github.com/alanz/ghc-exactprint/pull/121 - - - - - 5d65773e by John Ericson at 2023-01-09T20:39:27-05:00 Remove RTS hack for configuring See the brand new Note [Undefined symbols in the RTS] for additional details. - - - - - e3fff751 by Sebastian Graf at 2023-01-09T20:40:02-05:00 Handle shadowing in DmdAnal (#22718) Previously, when we had a shadowing situation like ```hs f x = ... -- demand signature <1L><1L> main = ... \f -> f 1 ... ``` we'd happily use the shadowed demand signature at the call site inside the lambda. Of course, that's wrong and solution is simply to remove the demand signature from the `AnalEnv` when we enter the lambda. This patch does so for all binding constructs Core. In #22718 the issue was caused by LetUp not shadowing away the existing demand signature for the let binder in the let body. The resulting absent error is fickle to reproduce; hence no reproduction test case. #17478 would help. Fixes #22718. It appears that TcPlugin_Rewrite regresses by ~40% on Darwin. It is likely that DmdAnal was exploiting ill-scoped analysis results. Metric increase ['bytes allocated'] (test_env=x86_64-darwin-validate): TcPlugin_Rewrite - - - - - d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00 Add safe list indexing operator: !? With Joachim's amendments. Implements https://github.com/haskell/core-libraries-committee/issues/110 - - - - - cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00 rts, tests: limit thread name length to 15 bytes On Linux, `pthread_setname_np` (or rather, the kernel) only allows for thread names up to 16 bytes, including the terminating null byte. This commit adds a note pointing this out in `createOSThread`, and fixes up two instances where a thread name of more than 15 characters long was used (in the RTS, and in a test-case). Fixes: #22366 Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366 See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796 - - - - - 64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00 Store bootstrap_llvm_target and use it to set LlvmTarget in bindists This mirrors some existing logic for the bootstrap_target which influences how TargetPlatform is set. As described on #21970 not storing this led to `LlvmTarget` being set incorrectly and hence the wrong `--target` flag being passed to the C compiler. Towards #21970 - - - - - 4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00 Check for FP_LD_NO_FIXUP_CHAINS in installation configure script Otherwise, when installing from a bindist the C flag isn't passed to the C compiler. This completes the fix for #22429 - - - - - 2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00 Fix outdated link to Happy section on sequences - - - - - 146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00 Revert "NCG(x86): Compile add+shift as lea if possible." This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a. See #22666 and #21777 - - - - - 6e6adbe3 by Jade Lovelace at 2023-01-11T00:55:30-05:00 Fix tcPluginRewrite example - - - - - faa57138 by Jade Lovelace at 2023-01-11T00:55:31-05:00 fix missing haddock pipe - - - - - 0470ea7c by Florian Weimer at 2023-01-11T00:56:10-05:00 m4/fp_leading_underscore.m4: Avoid implicit exit function declaration And switch to a new-style function definition. Fixes build issues with compilers that do not accept implicit function declarations. - - - - - b2857df4 by HaskellMouse at 2023-01-11T00:56:52-05:00 Added a new warning about compatibility with RequiredTypeArguments This commit introduces a new warning that indicates code incompatible with future extension: RequiredTypeArguments. Enabling this extension may break some code and the warning will help to make it compatible in advance. - - - - - 5f17e21a by Ben Gamari at 2023-01-11T00:57:27-05:00 testsuite: Drop testheapalloced.c As noted in #22414, this file (which appears to be a benchmark for characterising the one-step allocator's MBlock cache) is currently unreferenced. Remove it. Closes #22414. - - - - - bc125775 by Vladislav Zavialov at 2023-01-11T00:58:03-05:00 Introduce the TypeAbstractions language flag GHC Proposals #448 "Modern scoped type variables" and #425 "Invisible binders in type declarations" introduce a new language extension flag: TypeAbstractions. Part of the functionality guarded by this flag has already been implemented, namely type abstractions in constructor patterns, but it was guarded by a combination of TypeApplications and ScopedTypeVariables instead of a dedicated language extension flag. This patch does the following: * introduces a new language extension flag TypeAbstractions * requires TypeAbstractions for @a-syntax in constructor patterns instead of TypeApplications and ScopedTypeVariables * creates a User's Guide page for TypeAbstractions and moves the "Type Applications in Patterns" section there To avoid a breaking change, the new flag is implied by ScopedTypeVariables and is retroactively added to GHC2021. Metric Decrease: MultiLayerModulesTH_OneShot - - - - - 083f7015 by Krzysztof Gogolewski at 2023-01-11T00:58:38-05:00 Misc cleanup - Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault - - - - - aed1974e by Richard Eisenberg at 2023-01-11T08:30:42+00:00 Refactor the treatment of loopy superclass dicts This patch completely re-engineers how we deal with loopy superclass dictionaries in instance declarations. It fixes #20666 and #19690 The highlights are * Recognise that the loopy-superclass business should use precisely the Paterson conditions. This is much much nicer. See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance * With that in mind, define "Paterson-smaller" in Note [Paterson conditions] in GHC.Tc.Validity, and the new data type `PatersonSize` in GHC.Tc.Utils.TcType, along with functions to compute and compare PatsonSizes * Use the new PatersonSize stuff when solving superclass constraints See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance * In GHC.Tc.Solver.Monad.lookupInInerts, add a missing call to prohibitedSuperClassSolve. This was the original cause of #20666. * Treat (TypeError "stuff") as having PatersonSize zero. See Note [Paterson size for type family applications] in GHC.Tc.Utils.TcType. * Treat the head of a Wanted quantified constraint in the same way as the superclass of an instance decl; this is what fixes #19690. See GHC.Tc.Solver.Canonical Note [Solving a Wanted forall-constraint] (Thanks to Matthew Craven for this insight.) This entailed refactoring the GivenSc constructor of CtOrigin a bit, to say whether it comes from an instance decl or quantified constraint. * Some refactoring way in which redundant constraints are reported; we don't want to complain about the extra, apparently-redundant constraints that we must add to an instance decl because of the loopy-superclass thing. I moved some work from GHC.Tc.Errors to GHC.Tc.Solver. * Add a new section to the user manual to describe the loopy superclass issue and what rules it follows. - - - - - 300bcc15 by HaskellMouse at 2023-01-11T13:43:36-05:00 Parse qualified terms in type signatures This commit allows qualified terms in type signatures to pass the parser and to be cathced by renamer with more informative error message. Adds a few tests. Fixes #21605 - - - - - 964284fc by Simon Peyton Jones at 2023-01-11T13:44:12-05:00 Fix void-arg-adding mechanism for worker/wrapper As #22725 shows, in worker/wrapper we must add the void argument /last/, not first. See GHC.Core.Opt.WorkWrap.Utils Note [Worker/wrapper needs to add void arg last]. That led me to to study GHC.Core.Opt.SpecConstr Note [SpecConstr needs to add void args first] which suggests the opposite! And indeed I think it's the other way round for SpecConstr -- or more precisely the void arg must precede the "extra_bndrs". That led me to some refactoring of GHC.Core.Opt.SpecConstr.calcSpecInfo. - - - - - f7ceafc9 by Krzysztof Gogolewski at 2023-01-11T22:36:59-05:00 Add 'docWithStyle' to improve codegen This new combinator docWithStyle :: IsOutput doc => doc -> (PprStyle -> SDoc) -> doc let us remove the need for code to be polymorphic in HDoc when not used in code style. Metric Decrease: ManyConstructors T13035 T1969 - - - - - b3be0d18 by Simon Peyton Jones at 2023-01-11T22:37:35-05:00 Fix finaliseArgBoxities for OPAQUE function We never do worker wrapper for OPAQUE functions, so we must zap the unboxing info during strictness analysis. This patch fixes #22502 - - - - - db11f358 by Ben Gamari at 2023-01-12T07:49:04-05:00 Revert "rts: Drop racy assertion" The logic here was inverted. Reverting the commit to avoid confusion when examining the commit history. This reverts commit b3eacd64fb36724ed6c5d2d24a81211a161abef1. - - - - - 3242139f by Ben Gamari at 2023-01-12T07:49:04-05:00 rts: Drop racy assertion 0e274c39bf836d5bb846f5fa08649c75f85326ac added an assertion in `dirty_MUT_VAR` checking that the MUT_VAR being dirtied was clean. However, this isn't necessarily the case since another thread may have raced us to dirty the object. - - - - - 9ffd5d57 by Ben Gamari at 2023-01-12T07:49:41-05:00 configure: Fix escaping of `$tooldir` In !9547 I introduced `$tooldir` directories into GHC's default link and compilation flags to ensure that our C toolchain finds its own headers and libraries before others on the system. However, the patch was subtly wrong in the escaping of `$tooldir`. Fix this. Fixes #22561. - - - - - 905d0b6e by Sebastian Graf at 2023-01-12T15:51:47-05:00 Fix contification with stable unfoldings (#22428) Many functions now return a `TailUsageDetails` that adorns a `UsageDetails` with a `JoinArity` that reflects the number of join point binders around the body for which the `UsageDetails` was computed. `TailUsageDetails` is now returned by `occAnalLamTail` as well as `occAnalUnfolding` and `occAnalRules`. I adjusted `Note [Join points and unfoldings/rules]` and `Note [Adjusting right-hand sides]` to account for the new machinery. I also wrote a new `Note [Join arity prediction based on joinRhsArity]` and refer to it when we combine `TailUsageDetails` for a recursive RHS. I also renamed * `occAnalLam` to `occAnalLamTail` * `adjustRhsUsage` to `adjustTailUsage` * a few other less important functions and properly documented the that each call of `occAnalLamTail` must pair up with `adjustTailUsage`. I removed `Note [Unfoldings and join points]` because it was redundant with `Note [Occurrences in stable unfoldings]`. While in town, I refactored `mkLoopBreakerNodes` so that it returns a condensed `NodeDetails` called `SimpleNodeDetails`. Fixes #22428. The refactoring seems to have quite beneficial effect on ghc/alloc performance: ``` CoOpt_Read(normal) ghc/alloc 784,778,420 768,091,176 -2.1% GOOD T12150(optasm) ghc/alloc 77,762,270 75,986,720 -2.3% GOOD T12425(optasm) ghc/alloc 85,740,186 84,641,712 -1.3% GOOD T13056(optasm) ghc/alloc 306,104,656 299,811,632 -2.1% GOOD T13253(normal) ghc/alloc 350,233,952 346,004,008 -1.2% T14683(normal) ghc/alloc 2,800,514,792 2,754,651,360 -1.6% T15304(normal) ghc/alloc 1,230,883,318 1,215,978,336 -1.2% T15630(normal) ghc/alloc 153,379,590 151,796,488 -1.0% T16577(normal) ghc/alloc 7,356,797,056 7,244,194,416 -1.5% T17516(normal) ghc/alloc 1,718,941,448 1,692,157,288 -1.6% T19695(normal) ghc/alloc 1,485,794,632 1,458,022,112 -1.9% T21839c(normal) ghc/alloc 437,562,314 431,295,896 -1.4% GOOD T21839r(normal) ghc/alloc 446,927,580 440,615,776 -1.4% GOOD geo. mean -0.6% minimum -2.4% maximum -0.0% ``` Metric Decrease: CoOpt_Read T10421 T12150 T12425 T13056 T18698a T18698b T21839c T21839r T9961 - - - - - a1491c87 by Andreas Klebinger at 2023-01-12T15:52:23-05:00 Only gc sparks locally when we can ensure marking is done. When performing GC without work stealing there was no guarantee that spark pruning was happening after marking of the sparks. This could cause us to GC live sparks under certain circumstances. Fixes #22528. - - - - - 8acfe930 by Cheng Shao at 2023-01-12T15:53:00-05:00 Change MSYSTEM to CLANG64 uniformly - - - - - 73bc162b by M Farkas-Dyck at 2023-01-12T15:53:42-05:00 Make `GHC.Tc.Errors.Reporter` take `NonEmpty ErrorItem` rather than `[ErrorItem]`, which lets us drop some panics. Also use the `BasicMismatch` constructor rather than `mkBasicMismatchMsg`, which lets us drop the "-Wno-incomplete-record-updates" flag. - - - - - 1b812b69 by Oleg Grenrus at 2023-01-12T15:54:21-05:00 Fix #22728: Not all diagnostics in safe check are fatal Also add tests for the issue and -Winferred-safe-imports in general - - - - - c79b2b65 by Matthew Pickering at 2023-01-12T15:54:58-05:00 Don't run hadrian-multi on fast-ci label Fixes #22667 - - - - - 9a3d6add by Bodigrim at 2023-01-13T00:46:36-05:00 Bump submodule bytestring to 0.11.4.0 Metric Decrease: T21839c T21839r - - - - - df33c13c by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Bump Darwin bootstrap toolchain This updates the bootstrap compiler on Darwin from 8.10.7 to 9.2.5, ensuring that we have the fix for #21964. - - - - - 756a66ec by Ben Gamari at 2023-01-13T00:47:12-05:00 gitlab-ci: Pass -w to cabal update Due to cabal#8447, cabal-install 3.8.1.0 requires a compiler to run `cabal update`. - - - - - 1142f858 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump hsc2hs submodule - - - - - d4686729 by Cheng Shao at 2023-01-13T11:04:00+00:00 Bump process submodule - - - - - 84ae6573 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: Bump DOCKER_REV - - - - - d53598c5 by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: enable xz parallel compression for x64 jobs - - - - - d31fcbca by Cheng Shao at 2023-01-13T11:06:58+00:00 ci: use in-image emsdk for js jobs - - - - - 93b9bbc1 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: improve nix-shell for gen_ci.hs and fix some ghc/hlint warnings - Add a ghc environment including prebuilt dependencies to the nix-shell. Get rid of the ad hoc cabal cache and all dependencies are now downloaded from the nixos binary cache. - Make gen_ci.hs a cabal package with HLS integration, to make future hacking of gen_ci.hs easier. - Fix some ghc/hlint warnings after I got HLS to work. - For the lint-ci-config job, do a shallow clone to save a few minutes of unnecessary git checkout time. - - - - - 8acc56c7 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: source the toolchain env file in wasm jobs - - - - - 87194df0 by Cheng Shao at 2023-01-13T11:47:17+00:00 ci: add wasm ci jobs via gen_ci.hs - There is one regular wasm job run in validate pipelines - Additionally, int-native/unreg wasm jobs run in nightly/release pipelines Also, remove the legacy handwritten wasm ci jobs in .gitlab-ci.yml. - - - - - b6eb9bcc by Matthew Pickering at 2023-01-13T11:52:16+00:00 wasm ci: Remove wasm release jobs This removes the wasm release jobs, as we do not yet intend to distribute these binaries. - - - - - 496607fd by Simon Peyton Jones at 2023-01-13T16:52:07-05:00 Add a missing checkEscapingKind Ticket #22743 pointed out that there is a missing check, for type-inferred bindings, that the inferred type doesn't have an escaping kind. The fix is easy. - - - - - 7a9a1042 by Andreas Klebinger at 2023-01-16T20:48:19-05:00 Separate core inlining logic from `Unfolding` type. This seems like a good idea either way, but is mostly motivated by a patch where this avoids a module loop. - - - - - 33b58f77 by sheaf at 2023-01-16T20:48:57-05:00 Hadrian: generalise &%> to avoid warnings This patch introduces a more general version of &%> that works with general traversable shapes, instead of lists. This allows us to pass along the information that the length of the list of filepaths passed to the function exactly matches the length of the input list of filepath patterns, avoiding pattern match warnings. Fixes #22430 - - - - - 8c7a991c by Andreas Klebinger at 2023-01-16T20:49:34-05:00 Add regression test for #22611. A case were a function used to fail to specialize, but now does. - - - - - 6abea760 by Andreas Klebinger at 2023-01-16T20:50:10-05:00 Mark maximumBy/minimumBy as INLINE. The RHS was too large to inline which often prevented the overhead of the Maybe from being optimized away. By marking it as INLINE we can eliminate the overhead of both the maybe and are able to unpack the accumulator when possible. Fixes #22609 - - - - - 99d151bb by Matthew Pickering at 2023-01-16T20:50:50-05:00 ci: Bump CACHE_REV so that ghc-9.6 branch and HEAD have different caches Having the same CACHE_REV on both branches leads to issues where the darwin toolchain is different on ghc-9.6 and HEAD which leads to long darwin build times. In general we should ensure that each branch has a different CACHE_REV. - - - - - 6a5845fb by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in source-tarball job This fixes errors of the form: ``` fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc inferred 9.7.20230113 checking for GHC Git commit id... fatal: detected dubious ownership in repository at '/builds/ghc/ghc' To add an exception for this directory, call: git config --global --add safe.directory /builds/ghc/ghc ``` - - - - - 4afb952c by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't build aarch64-deb10-llvm job on release pipelines Closes #22721 - - - - - 8039feb9 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Change owner of files in test-bootstrap job - - - - - 0b358d0c by Matthew Pickering at 2023-01-16T20:51:25-05:00 rel_eng: Add release engineering scripts into ghc tree It is better to keep these scripts in the tree as they depend on the CI configuration and so on. By keeping them in tree we can keep them up-to-date as the CI config changes and also makes it easier to backport changes to the release script between release branches in future. The final motivation is that it makes generating GHCUp metadata possible. - - - - - 28cb2ed0 by Matthew Pickering at 2023-01-16T20:51:25-05:00 ci: Don't use complicated image or clone in not-interruptible job This job exists only for the meta-reason of not allowing nightly pipelines to be cancelled. It was taking two minutes to run as in order to run "true" we would also clone the whole GHC repo. - - - - - eeea59bb by Matthew Pickering at 2023-01-16T20:51:26-05:00 Add scripts to generate ghcup metadata on nightly and release pipelines 1. A python script in .gitlab/rel_eng/mk-ghcup-metadata which generates suitable metadata for consumption by GHCUp for the relevant pipelines. - The script generates the metadata just as the ghcup maintainers want, without taking into account platform/library combinations. It is updated manually when the mapping changes. - The script downloads the bindists which ghcup wants to distribute, calculates the hash and generates the yaml in the correct structure. - The script is documented in the .gitlab/rel_eng/mk-ghcup-metadata/README.mk file 1a. The script requires us to understand the mapping from platform -> job. To choose the preferred bindist for each platform the .gitlab/gen_ci.hs script is modified to allow outputting a metadata file which answers the question about which job produces the bindist which we want to distribute to users for a specific platform. 2. Pipelines to run on nightly and release jobs to generate metadata - ghcup-metadata-nightly: Generates metadata which points directly to artifacts in the nightly job. - ghcup-metadata-release: Generates metadata suitable for inclusion directly in ghcup by pointing to the downloads folder where the bindist will be uploaded to. 2a. Trigger jobs which test the generated metadata in the downstream `ghccup-ci` repo. See that repo for documentation about what is tested and how but essentially we test in a variety of clean images that ghcup can download and install the bindists we say exist in our metadata. - - - - - 97bd4d8c by Bodigrim at 2023-01-16T20:52:04-05:00 Bump submodule parsec to 3.1.16.1 - - - - - 97ac8230 by Alan Zimmerman at 2023-01-16T20:52:39-05:00 EPA: Add annotation for 'type' in DataDecl Closes #22765 - - - - - dbbab95d by Ben Gamari at 2023-01-17T06:36:06-05:00 compiler: Small optimisation of assertM In #22739 @AndreasK noticed that assertM performed the action to compute the asserted predicate regardless of whether DEBUG is enabled. This is inconsistent with the other assertion operations and general convention. Fix this. Closes #22739. - - - - - fc02f3bb by Viktor Dukhovni at 2023-01-17T06:36:47-05:00 Avoid unnecessary printf warnings in EventLog.c Fixes #22778 - - - - - 003b6d44 by Simon Peyton Jones at 2023-01-17T16:33:05-05:00 Document the semantics of pattern bindings a bit better This MR is in response to the discussion on #22719 - - - - - f4d50baf by Vladislav Zavialov at 2023-01-17T16:33:41-05:00 Hadrian: fix warnings (#22783) This change fixes the following warnings when building Hadrian: src/Hadrian/Expression.hs:38:10: warning: [-Wredundant-constraints] src/Hadrian/Expression.hs:84:13: warning: [-Wtype-equality-requires-operators] src/Hadrian/Expression.hs:84:21: warning: [-Wtype-equality-requires-operators] src/Hadrian/Haskell/Cabal/Parse.hs:67:1: warning: [-Wunused-imports] - - - - - 06036d93 by Sylvain Henry at 2023-01-18T01:55:10-05:00 testsuite: req_smp --> req_target_smp, req_ghc_smp See #22630 and !9552 This commit: - splits req_smp into req_target_smp and req_ghc_smp - changes the testsuite driver to calculate req_ghc_smp - changes a handful of tests to use req_target_smp instead of req_smp - changes a handful of tests to use req_host_smp when needed The problem: - the problem this solves is the ambiguity surrounding req_smp - on master req_smp was used to express the constraint that the program being compiled supports smp _and_ that the host RTS (i.e., the RTS used to compile the program) supported smp. Normally that is fine, but in cross compilation this is not always the case as was discovered in #22630. The solution: - Differentiate the two constraints: - use req_target_smp to say the RTS the compiled program is linked with (and the platform) supports smp - use req_host_smp to say the RTS the host is linked with supports smp WIP: fix req_smp (target vs ghc) add flag to separate bootstrapper split req_smp -> req_target_smp and req_ghc_smp update tests smp flags cleanup and add some docstrings only set ghc_with_smp to bootstrapper on S1 or CC Only set ghc_with_smp to bootstrapperWithSMP of when testing stage 1 and cross compiling test the RTS in config/ghc not hadrian re-add ghc_with_smp fix and align req names fix T11760 to use req_host_smp test the rts directly, avoid python 3.5 limitation test the compiler in a try block align out of tree and in tree withSMP flags mark failing tests as host req smp testsuite: req_host_smp --> req_ghc_smp Fix ghc vs host, fix ghc_with_smp leftover - - - - - ee9b78aa by Krzysztof Gogolewski at 2023-01-18T01:55:45-05:00 Use -Wdefault when running Python testdriver (#22727) - - - - - e9c0537c by Vladislav Zavialov at 2023-01-18T01:56:22-05:00 Enable -Wstar-is-type by default (#22759) Following the plan in GHC Proposal #143 "Remove the * kind syntax", which states: In the next release (or 3 years in), enable -fwarn-star-is-type by default. The "next release" happens to be 9.6.1 I also moved the T21583 test case from should_fail to should_compile, because the only reason it was failing was -Werror=compat in our test suite configuration. - - - - - 4efee43d by Ryan Scott at 2023-01-18T01:56:59-05:00 Add missing parenthesizeHsType in cvtSigTypeKind We need to ensure that the output of `cvtSigTypeKind` is parenthesized (at precedence `sigPrec`) so that any type signatures with an outermost, explicit kind signature can parse correctly. Fixes #22784. - - - - - f891a442 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump ghc-tarballs to fix #22497 It turns out that gmp 6.2.1 uses the platform-reserved `x18` register on AArch64/Darwin. This was fixed in upstream changeset 18164:5f32dbc41afc, which was merged in 2020. Here I backport this patch although I do hope that a new release is forthcoming soon. Bumps gmp-tarballs submodule. Fixes #22497. - - - - - b13c6ea5 by Ben Gamari at 2023-01-18T07:28:00-05:00 Bump gmp-tarballs submodule This backports the upstream fix for CVE-2021-43618, fixing #22789. - - - - - c45a5fff by Cheng Shao at 2023-01-18T07:28:37-05:00 Fix typo in recent darwin tests fix Corrects a typo in !9647. Otherwise T18623 will still fail on darwin and stall other people's work. - - - - - b4c14c4b by Luite Stegeman at 2023-01-18T14:21:42-05:00 Add PrimCallConv support to GHCi This adds support for calling Cmm code from bytecode using the native calling convention, allowing modules that use `foreign import prim` to be loaded and debugged in GHCi. This patch introduces a new `PRIMCALL` bytecode instruction and a helper stack frame `stg_primcall`. The code is based on the existing functionality for dealing with unboxed tuples in bytecode, which has been generalised to handle arbitrary calls. Fixes #22051 - - - - - d0a63ef8 by Adam Gundry at 2023-01-18T14:22:26-05:00 Refactor warning flag parsing to add missing flags This adds `-Werror=<group>` and `-fwarn-<group>` flags for warning groups as well as individual warnings. Previously these were defined on an ad hoc basis so for example we had `-Werror=compat` but not `-Werror=unused-binds`, whereas we had `-fwarn-unused-binds` but not `-fwarn-compat`. Fixes #22182. - - - - - 7ed1b8ef by Adam Gundry at 2023-01-18T14:22:26-05:00 Minor corrections to comments - - - - - 5389681e by Adam Gundry at 2023-01-18T14:22:26-05:00 Revise warnings documentation in user's guide - - - - - ab0d5cda by Adam Gundry at 2023-01-18T14:22:26-05:00 Move documentation of deferred type error flags out of warnings section - - - - - eb5a6b91 by John Ericson at 2023-01-18T22:24:10-05:00 Give the RTS it's own configure script Currently it doesn't do much anything, we are just trying to introduce it without breaking the build. Later, we will move functionality from the top-level configure script over to it. We need to bump Cabal for https://github.com/haskell/cabal/pull/8649; to facilitate and existing hack of skipping some configure checks for the RTS we now need to skip just *part* not *all* of the "post configure" hook, as running the configure script (which we definitely want to do) is also implemented as part of the "post configure" hook. But doing this requires exposing functionality that wasn't exposed before. - - - - - 32ab07bf by Bodigrim at 2023-01-18T22:24:51-05:00 ghc package does not have to depend on terminfo - - - - - 981ff7c4 by Bodigrim at 2023-01-18T22:24:51-05:00 ghc-pkg does not have to depend on terminfo - - - - - f058e367 by Ben Gamari at 2023-01-18T22:25:27-05:00 nativeGen/X86: MFENCE is unnecessary for release semantics In #22764 a user noticed that a program implementing a simple atomic counter via an STRef regressed significantly due to the introduction of necessary atomic operations in the MutVar# primops (#22468). This regression was caused by a bug in the NCG, which emitted an unnecessary MFENCE instruction for a release-ordered atomic write. MFENCE is rather only needed to achieve sequentially consistent ordering. Fixes #22764. - - - - - 154889db by Ryan Scott at 2023-01-18T22:26:03-05:00 Add regression test for #22151 Issue #22151 was coincidentally fixed in commit aed1974e92366ab8e117734f308505684f70cddf (`Refactor the treatment of loopy superclass dicts`). This adds a regression test to ensure that the issue remains fixed. Fixes #22151. - - - - - 14b5982a by Andrei Borzenkov at 2023-01-18T22:26:43-05:00 Fix printing of promoted MkSolo datacon (#22785) Problem: In 2463df2f, the Solo data constructor was renamed to MkSolo, and Solo was turned into a pattern synonym for backwards compatibility. Since pattern synonyms can not be promoted, the old code that pretty-printed promoted single-element tuples started producing ill-typed code: t :: Proxy ('Solo Int) This fails with "Pattern synonym ‘Solo’ used as a type" The solution is to track the distinction between type constructors and data constructors more carefully when printing single-element tuples. - - - - - 1fe806d3 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add hi_core flavour transformer The hi_core flavour transformer enables -fwrite-if-simplified-core for stage1 libraries, which emit core into interface files to make it possible to restart code generation. Building boot libs with it makes it easier to use GHC API to prototype experimental backends that needs core/stg at link time. - - - - - 317cad26 by Cheng Shao at 2023-01-23T04:48:47-05:00 hadrian: add missing docs for recently added flavour transformers - - - - - 658f4446 by Ben Gamari at 2023-01-23T04:49:23-05:00 gitlab-ci: Add Rocky8 jobs Addresses #22268. - - - - - a83ec778 by Vladislav Zavialov at 2023-01-23T04:49:58-05:00 Set "since: 9.8" for TypeAbstractions and -Wterm-variable-capture These flags did not make it into the 9.6 release series, so the "since" annotations must be corrected. - - - - - fec7c2ea by Alan Zimmerman at 2023-01-23T04:50:33-05:00 EPA: Add SourceText to HsOverLabel To be able to capture string literals with possible escape codes as labels. Close #22771 - - - - - 3efd1e99 by Ben Gamari at 2023-01-23T04:51:08-05:00 template-haskell: Bump version to 2.20.0.0 Updates `text` and `exceptions` submodules for bounds bumps. Addresses #22767. - - - - - 0900b584 by Cheng Shao at 2023-01-23T04:51:45-05:00 hadrian: disable alloca for in-tree GMP on wasm32 When building in-tree GMP for wasm32, disable its alloca usage, since it may potentially cause stack overflow (e.g. #22602). - - - - - db0f1bfd by Cheng Shao at 2023-01-23T04:52:21-05:00 Bump process submodule Includes a critical fix for wasm32, see https://github.com/haskell/process/pull/272 for details. Also changes the existing cross test to include process stuff and avoid future regression here. - - - - - 9222b167 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Fix subdir for windows bindist - - - - - 9a9bec57 by Matthew Pickering at 2023-01-23T04:52:57-05:00 ghcup metadata: Remove viPostRemove field from generated metadata This has been removed from the downstream metadata. - - - - - 82884ce0 by Simon Peyton Jones at 2023-01-23T04:53:32-05:00 Fix #22742 runtimeRepLevity_maybe was panicing unnecessarily; and the error printing code made use of the case when it should return Nothing rather than panicing. For some bizarre reason perf/compiler/T21839r shows a 10% bump in runtime peak-megagbytes-used, on a single architecture (alpine). See !9753 for commentary, but I'm going to accept it. Metric Increase: T21839r - - - - - 2c6deb18 by Bryan Richter at 2023-01-23T14:12:22+02:00 codeowners: Add Ben, Matt, and Bryan to CI - - - - - eee3bf05 by Matthew Craven at 2023-01-23T21:46:41-05:00 Do not collect compile-time metrics for T21839r ...the testsuite doesn't handle this properly since it also collects run-time metrics. Compile-time metrics for this test are already tracked via T21839c. Metric Decrease: T21839r - - - - - 1d1dd3fb by Matthew Pickering at 2023-01-24T05:37:52-05:00 Fix recompilation checking for multiple home units The key part of this change is to store a UnitId in the `UsageHomeModule` and `UsageHomeModuleInterface`. * Fine-grained dependency tracking is used if the dependency comes from any home unit. * We actually look up the right module when checking whether we need to recompile in the `UsageHomeModuleInterface` case. These scenarios are both checked by the new tests ( multipleHomeUnits_recomp and multipleHomeUnits_recomp_th ) Fixes #22675 - - - - - 7bfb30f9 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Augment target filepath by working directory when checking if module satisfies target This fixes a spurious warning in -Wmissing-home-modules. This is a simple oversight where when looking for the target in the first place we augment the search by the -working-directory flag but then fail to do so when checking this warning. Fixes #22676 - - - - - 69500dd4 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Use NodeKey rather than ModuleName in pruneCache The `pruneCache` function assumes that the list of `CachedInfo` all have unique `ModuleName`, this is not true: * In normal compilation, the same module name can appear for a file and it's boot file. * In multiple home unit compilation the same ModuleName can appear in different units The fix is to use a `NodeKey` as the actual key for the interfaces which includes `ModuleName`, `IsBoot` and `UnitId`. Fixes #22677 - - - - - 336b2b1c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Recompilation checking: Don't try to find artefacts for Interactive & hs-boot combo In interactive mode we don't produce any linkables for hs-boot files. So we also need to not going looking for them when we check to see if we have all the right objects needed for recompilation. Ticket #22669 - - - - - 6469fea7 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Don't write o-boot files in Interactive mode We should not be producing object files when in interactive mode but we still produced the dummy o-boot files. These never made it into a `Linkable` but then confused the recompilation checker. Fixes #22669 - - - - - 06cc0a95 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Improve driver diagnostic messages by including UnitId in message Currently the driver diagnostics don't give any indication about which unit they correspond to. For example `-Wmissing-home-modules` can fire multiple times for each different home unit and gives no indication about which unit it's actually reporting about. Perhaps a longer term fix is to generalise the providence information away from a SrcSpan so that these kind of whole project errors can be reported with an accurate provenance. For now we can just include the `UnitId` in the error message. Fixes #22678 - - - - - 4fe9eaff by Matthew Pickering at 2023-01-24T05:37:52-05:00 Key ModSummary cache by UnitId as well as FilePath Multiple units can refer to the same files without any problem. Just another assumption which needs to be updated when we may have multiple home units. However, there is the invariant that within each unit each file only maps to one module, so as long as we also key the cache by UnitId then we are all good. This led to some confusing behaviour in GHCi when reloading, multipleHomeUnits_shared distils the essence of what can go wrong. Fixes #22679 - - - - - ada29f5c by Matthew Pickering at 2023-01-24T05:37:52-05:00 Finder: Look in current unit before looking in any home package dependencies In order to preserve existing behaviour it's important to look within the current component before consideirng a module might come from an external component. This already happened by accident in `downsweep`, (because roots are used to repopulated the cache) but in the `Finder` the logic was the wrong way around. Fixes #22680 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp -------------------------p - - - - - be701cc6 by Matthew Pickering at 2023-01-24T05:37:52-05:00 Debug: Print full NodeKey when pretty printing ModuleGraphNode This is helpful when debugging multiple component issues. - - - - - 34d2d463 by Krzysztof Gogolewski at 2023-01-24T05:38:32-05:00 Fix Lint check for duplicate external names Lint was checking for duplicate external names by calling removeDups, which needs a comparison function that is passed to Data.List.sortBy. But the comparison was not a valid ordering - it returned LT if one of the names was not external. For example, the previous implementation won't find a duplicate in [M.x, y, M.x]. Instead, we filter out non-external names before looking for duplicates. - - - - - 1c050ed2 by Matthew Pickering at 2023-01-24T05:39:08-05:00 Add test for T22671 This was fixed by b13c6ea5 Closes #22671 - - - - - 05e6a2d9 by Tom Ellis at 2023-01-24T12:10:52-05:00 Clarify where `f` is defined - - - - - d151546e by Cheng Shao at 2023-01-24T12:11:29-05:00 CmmToC: fix CmmRegOff for 64-bit register on a 32-bit target We used to print the offset value to a platform word sized integer. This is incorrect when the offset is negative (e.g. output of cmm constant folding) and the register is 64-bit but on a 32-bit target, and may lead to incorrect runtime result (e.g. #22607). The fix is simple: just treat it as a proper MO_Add, with the correct width info inferred from the register itself. Metric Increase: T12707 T13379 T4801 T5321FD T5321Fun - - - - - e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00 Allow waiting for timerfd to be interrupted during rts shutdown - - - - - 1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00 Restore Compose's Read/Show behavior to match Read1/Show1 instances Fixes #22816. - - - - - 30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00 docs: Update INSTALL.md Removes references to make. Fixes #22480 - - - - - bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00 compiler: fix handling of MO_F_Neg in wasm NCG In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an oversight, there actually exists f32.neg/f64.neg opcodes in the wasm spec and those should be used instead! The old behavior almost works, expect when GHC compiles the -0.0 literal, which will incorrectly become 0.0. - - - - - e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: correctly detect AR at-file support Stage0's ar may not support at-files. Take it into account. Found while cross-compiling from Darwin to Windows. - - - - - 48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Hadrian: fix Windows cross-compilation Decision to build either unix or Win32 package must be stage specific for cross-compilation to be supported. - - - - - 288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00 Fix RTS build on Windows This change fixes a cross-compilation issue from ArchLinux to Windows because these symbols weren't found. - - - - - 2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00 configure: support "windows" as an OS - - - - - 13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00 Fix in-scope set in specImports Nothing deep here; I had failed to bring some floated dictionary binders into scope. Exposed by -fspecialise-aggressively Fixes #22715. - - - - - b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00 ci: Disable HLint job due to excessive runtime The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91 Now the CI job will build the stage0 compiler before it generates the necessary RTS headers. We either need to: * Fix the linting rules so they take much less time * Revert the commit * Remove the linting of base from the hlint job * Remove the hlint job This is highest priority as it is affecting all CI pipelines. For now I am just disabling the job because there are many more pressing matters at hand. Ticket #22830 - - - - - 1bd32a35 by Sylvain Henry at 2023-01-26T12:34:21-05:00 Factorize hptModulesBelow Create and use moduleGraphModulesBelow in GHC.Unit.Module.Graph that doesn't need anything from the driver to be used. - - - - - 1262d3f8 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Store dehydrated data structures in CgModBreaks This fixes a tricky leak in GHCi where we were retaining old copies of HscEnvs when reloading. If not all modules were recompiled then these hydrated fields in break points would retain a reference to the old HscEnv which could double memory usage. Fixes #22530 - - - - - e27eb80c by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force more in NFData Name instance Doesn't force the lazy `OccName` field (#19619) which is already known as a really bad source of leaks. When we slam the hammer storing Names on disk (in interface files or the like), all this should be forced as otherwise a `Name` can easily retain an `Id` and hence the entire world. Fixes #22833 - - - - - 3d004d5a by Matthew Pickering at 2023-01-26T12:34:56-05:00 Force OccName in tidyTopName This occname has just been derived from an `Id`, so need to force it promptly so we can release the Id back to the world. Another symptom of the bug caused by #19619 - - - - - f2a0fea0 by Matthew Pickering at 2023-01-26T12:34:56-05:00 Strict fields in ModNodeKey (otherwise retains HomeModInfo) Towards #22530 - - - - - 5640cb1d by Sylvain Henry at 2023-01-26T12:35:36-05:00 Hadrian: fix doc generation Was missing dependencies on files generated by templates (e.g. ghc.cabal) - - - - - 3e827c3f by Richard Eisenberg at 2023-01-26T20:06:53-05:00 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. Close #22519. - - - - - b3ef5c89 by doyougnu at 2023-01-26T20:07:48-05:00 tryFillBuffer: strictify more speculative bangs - - - - - d0d7ba0f by Vladislav Zavialov at 2023-01-26T20:08:25-05:00 base: NoImplicitPrelude in Data.Void and Data.Kind This change removes an unnecessary dependency on Prelude from two modules in the base package. - - - - - fa1db923 by Matthew Pickering at 2023-01-26T20:09:00-05:00 ci: Add ubuntu18_04 nightly and release jobs This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is older than the 2.28 which is used by Rocky8 bindists. Ticket #22268 - - - - - 807310a1 by Matthew Pickering at 2023-01-26T20:09:00-05:00 rel-eng: Add missing rocky8 bindist We intend to release rocky8 bindist so the fetching script needs to know about them. - - - - - c7116b10 by Ben Gamari at 2023-01-26T20:09:35-05:00 base: Make changelog proposal references more consistent Addresses #22773. - - - - - 6932cfc7 by Sylvain Henry at 2023-01-26T20:10:27-05:00 Fix spurious change from !9568 - - - - - e480fbc2 by Ben Gamari at 2023-01-27T05:01:24-05:00 rts: Use C11-compliant static assertion syntax Previously we used `static_assert` which is only available in C23. By contrast, C11 only provides `_Static_assert`. Fixes #22777 - - - - - 2648c09c by Andrei Borzenkov at 2023-01-27T05:02:07-05:00 Replace errors from badOrigBinding with new one (#22839) Problem: in 02279a9c the type-level [] syntax was changed from a built-in name to an alias for the GHC.Types.List constructor. badOrigBinding assumes that if a name is not built-in then it must have come from TH quotation, but this is not necessarily the case with []. The outdated assumption in badOrigBinding leads to incorrect error messages. This code: data [] Fails with "Cannot redefine a Name retrieved by a Template Haskell quote: []" Unfortunately, there is not enough information in RdrName to directly determine if the name was constructed via TH or by the parser, so this patch changes the error message instead. It unifies TcRnIllegalBindingOfBuiltIn and TcRnNameByTemplateHaskellQuote into a new error TcRnBindingOfExistingName and changes its wording to avoid guessing the origin of the name. - - - - - 545bf8cf by Matthew Pickering at 2023-01-27T14:58:53+00:00 Revert "base: NoImplicitPrelude in Data.Void and Data.Kind" Fixes CI errors of the form. ``` ===> Command failed with error code: 1 ghc: panic! (the 'impossible' happened) GHC version 9.7.20230127: lookupGlobal Failed to load interface for ‘GHC.Num.BigNat’ There are files missing in the ‘ghc-bignum’ package, try running 'ghc-pkg check'. Use -v (or `:set -v` in ghci) to see a list of the files searched for. Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/GHC/Utils/Panic.hs:189:37 in ghc:GHC.Utils.Panic pprPanic, called at compiler/GHC/Tc/Utils/Env.hs:154:32 in ghc:GHC.Tc.Utils.Env CallStack (from HasCallStack): panic, called at compiler/GHC/Utils/Error.hs:454:29 in ghc:GHC.Utils.Error Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` This reverts commit d0d7ba0fb053ebe7f919a5932066fbc776301ccd. The module now lacks a dependency on GHC.Num.BigNat which it implicitly depends on. It is causing all CI jobs to fail so we revert without haste whilst the patch can be fixed. Fixes #22848 - - - - - 638277ba by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Detect family instance orphans correctly We were treating a type-family instance as a non-orphan if there was a type constructor on its /right-hand side/ that was local. Boo! Utterly wrong. With this patch, we correctly check the /left-hand side/ instead! Fixes #22717 - - - - - 46a53bb2 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Report family instance orphans correctly This fixes the fact that we were not reporting orphan family instances at all. The fix here is easy, but touches a bit of code. I refactored the code to be much more similar to the way that class instances are done: - Add a fi_orphan field to FamInst, like the is_orphan field in ClsInst - Make newFamInst initialise this field, just like newClsInst - And make newFamInst report a warning for an orphan, just like newClsInst - I moved newFamInst from GHC.Tc.Instance.Family to GHC.Tc.Utils.Instantiate, just like newClsInst. - I added mkLocalFamInst to FamInstEnv, just like mkLocalClsInst in InstEnv - TcRnOrphanInstance and SuggestFixOrphanInstance are now parametrised over class instances vs type/data family instances. Fixes #19773 - - - - - faa300fb by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in STG This patch removes some orphan instances in the STG namespace by introducing the GHC.Stg.Lift.Types module, which allows various type family instances to be moved to GHC.Stg.Syntax, avoiding orphan instances. - - - - - 0f25a13b by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Avoid orphans in the parser This moves Anno instances for PatBuilder from GHC.Parser.PostProcess to GHC.Parser.Types to avoid orphans. - - - - - 15750d33 by Simon Peyton Jones at 2023-01-27T23:54:55-05:00 Accept an orphan declaration (sadly) This accepts the orphan type family instance type instance DsForeignHook = ... in GHC.HsToCore.Types. See Note [The Decoupling Abstract Data Hack] in GHC.Driver.Hooks - - - - - c9967d13 by Zubin Duggal at 2023-01-27T23:55:31-05:00 bindist configure: Fail if find not found (#22691) - - - - - ad8cfed4 by John Ericson at 2023-01-27T23:56:06-05:00 Put hadrian bootstrap plans through `jq` This makes it possible to review changes with conventional diffing tools. - - - - - d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Introduce threaded2_sanity way Incredibly, we previously did not have a single way which would test the threaded RTS with multiple capabilities and the sanity-checker enabled. - - - - - 38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00 rts: Relax Messages assertion `doneWithMsgThrowTo` was previously too strict in asserting that the `Message` is locked. Specifically, it failed to consider that the `Message` may not be locked if we are deleting all threads during RTS shutdown. - - - - - a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Fix race in UnliftedTVar2 Previously UnliftedTVar2 would fail when run with multiple capabilities (and possibly even with one capability) as it would assume that `killThread#` would immediately kill the "increment" thread. Also, refactor the the executable to now succeed with no output and fails with an exit code. - - - - - 8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00 testsuite: Make listThreads more robust Previously it was sensitive to the labels of threads which it did not create (e.g. the IO manager event loop threads). Fix this. - - - - - 55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix non-atomic mutation of enabled_capabilities - - - - - b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix C++ compilation issues Make the RTS compilable with a C++ compiler by inserting necessary casts. - - - - - c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Fix typo "tracingAddCapabilities" was mis-named - - - - - 77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00 rts: Drop long-dead fallback definitions for INFINITY & NAN These are no longer necessary since we now compile as C99. - - - - - 56c1bd98 by Ben Gamari at 2023-01-28T02:57:59-05:00 Revert "CApiFFI: add ConstPtr for encoding const-qualified pointer return types (#22043)" This reverts commit 99aca26b652603bc62953157a48e419f737d352d. - - - - - b3a3534b by nineonine at 2023-01-28T02:57:59-05:00 CApiFFI: add ConstPtr for encoding const-qualified pointer return types Previously, when using `capi` calling convention in foreign declarations, code generator failed to handle const-cualified pointer return types. This resulted in CC toolchain throwing `-Wincompatible-pointer-types-discards-qualifiers` warning. `Foreign.C.Types.ConstPtr` newtype was introduced to handle these cases - special treatment was put in place to generate appropritetly qualified C wrapper that no longer triggers the above mentioned warning. Fixes #22043. - - - - - 082b7d43 by Oleg Grenrus at 2023-01-28T02:58:38-05:00 Add Foldable1 Solo instance - - - - - 50b1e2e8 by Andrei Borzenkov at 2023-01-28T02:59:18-05:00 Convert diagnostics in GHC.Rename.Bind to proper TcRnMessage (#20115) I removed all occurrences of TcRnUnknownMessage in GHC.Rename.Bind module. Instead, these TcRnMessage messages were introduced: TcRnMultipleFixityDecls TcRnIllegalPatternSynonymDecl TcRnIllegalClassBiding TcRnOrphanCompletePragma TcRnEmptyCase TcRnNonStdGuards TcRnDuplicateSigDecl TcRnMisplacedSigDecl TcRnUnexpectedDefaultSig TcRnBindInBootFile TcRnDuplicateMinimalSig - - - - - 3330b819 by Matthew Pickering at 2023-01-28T02:59:54-05:00 hadrian: Fix library-dirs, dynamic-library-dirs and static-library-dirs in inplace .conf files Previously we were just throwing away the contents of the library-dirs fields but really we have to do the same thing as for include-dirs, relativise the paths into the current working directory and maintain any extra libraries the user has specified. Now the relevant section of the rts.conf file looks like: ``` library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib library-dirs-static: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib dynamic-library-dirs: ${pkgroot}/../rts/build ${pkgroot}/../../..//_build/stage1/rts/build /nix/store/av4c0fib4rkmb6sa1074z0rb1ciria5b-gperftools-2.10/lib /nix/store/2infxahfp9lj084xn3q9ib5ajks8447i-libffi-3.4.4/lib ``` Fixes #22209 - - - - - c9ad8852 by Bodigrim at 2023-01-28T03:00:33-05:00 Document differences between Data.{Monoid,Semigroup}.{First,Last} - - - - - 7e11c6dc by Cheng Shao at 2023-01-28T03:01:09-05:00 compiler: fix subword literal narrowing logic in the wasm NCG This patch fixes the W8/W16 literal narrowing logic in the wasm NCG, which used to lower it to something like i32.const -1, without properly zeroing-out the unused higher bits. Fixes #22608. - - - - - 6ea2aa02 by Cheng Shao at 2023-01-28T03:01:46-05:00 compiler: fix lowering of CmmBlock in the wasm NCG The CmmBlock datacon was not handled in lower_CmmLit, since I thought it would have been eliminated after proc-point splitting. Turns out it still occurs in very rare occasions, and this patch is needed to fix T9329 for wasm. - - - - - 2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00 Assorted changes to avoid Data.List.{head,tail} - - - - - 78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00 compiler: properly handle ForeignHints in the wasm NCG Properly handle ForeignHints of ccall arguments/return value, insert sign extends and truncations when handling signed subwords. Fixes #22852. - - - - - 8bed166b by Ben Gamari at 2023-01-30T05:06:26-05:00 nativeGen: Disable asm-shortcutting on Darwin Asm-shortcutting may produce relative references to symbols defined in other compilation units. This is not something that MachO relocations support (see #21972). For this reason we disable the optimisation on Darwin. We do so without a warning since this flag is enabled by `-O2`. Another way to address this issue would be to rather implement a PLT-relocatable jump-table strategy. However, this would only benefit Darwin and does not seem worth the effort. Closes #21972. - - - - - da468391 by Cheng Shao at 2023-01-30T05:07:03-05:00 compiler: fix data section alignment in the wasm NCG Previously we tried to lower the alignment requirement as far as possible, based on the section kind inferred from the CLabel. For info tables, .p2align 1 was applied given the GC should only need the lowest bit to tag forwarding pointers. But this would lead to unaligned loads/stores, which has a performance penalty even if the wasm spec permits it. Furthermore, the test suite has shown memory corruption in a few cases when compacting gc is used. This patch takes a more conservative approach: all data sections except C strings align to word size. - - - - - 08ba8720 by Andreas Klebinger at 2023-01-30T21:18:45-05:00 ghc-the-library: Retain cafs in both static in dynamic builds. We use keepCAFsForGHCi.c to force -fkeep-cafs behaviour by using a __attribute__((constructor)) function. This broke for static builds where the linker discarded the object file since it was not reverenced from any exported code. We fix this by asserting that the flag is enabled using a function in the same module as the constructor. Which causes the object file to be retained by the linker, which in turn causes the constructor the be run in static builds. This changes nothing for dynamic builds using the ghc library. But causes static to also retain CAFs (as we expect them to). Fixes #22417. ------------------------- Metric Decrease: T21839r ------------------------- - - - - - 20598ef6 by Ryan Scott at 2023-01-30T21:19:20-05:00 Handle `type data` properly in tyThingParent_maybe Unlike most other data constructors, data constructors declared with `type data` are represented in `TyThing`s as `ATyCon` rather than `ADataCon`. The `ATyCon` case in `tyThingParent_maybe` previously did not consider the possibility of the underlying `TyCon` being a promoted data constructor, which led to the oddities observed in #22817. This patch adds a dedicated special case in `tyThingParent_maybe`'s `ATyCon` case for `type data` data constructors to fix these oddities. Fixes #22817. - - - - - 2f145052 by Ryan Scott at 2023-01-30T21:19:56-05:00 Fix two bugs in TypeData TH reification This patch fixes two issues in the way that `type data` declarations were reified with Template Haskell: * `type data` data constructors are now properly reified using `DataConI`. This is accomplished with a special case in `reifyTyCon`. Fixes #22818. * `type data` type constructors are now reified in `reifyTyCon` using `TypeDataD` instead of `DataD`. Fixes #22819. - - - - - d0f34f25 by Simon Peyton Jones at 2023-01-30T21:20:35-05:00 Take account of loop breakers in specLookupRule The key change is that in GHC.Core.Opt.Specialise.specLookupRule we were using realIdUnfolding, which ignores the loop-breaker flag. When given a loop breaker, rule matching therefore looped infinitely -- #22802. In fixing this I refactored a bit. * Define GHC.Core.InScopeEnv as a data type, and use it. (Previously it was a pair: hard to grep for.) * Put several functions returning an IdUnfoldingFun into GHC.Types.Id, namely idUnfolding alwaysActiveUnfoldingFun, whenActiveUnfoldingFun, noUnfoldingFun and use them. (The are all loop-breaker aware.) - - - - - de963cb6 by Matthew Pickering at 2023-01-30T21:21:11-05:00 ci: Remove FreeBSD job from release pipelines We no longer attempt to build or distribute this release - - - - - f26d27ec by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Add check to make sure that release jobs are downloaded by fetch-gitlab This check makes sure that if a job is a prefixed by "release-" then the script downloads it and understands how to map the job name to the platform. - - - - - 7619c0b4 by Matthew Pickering at 2023-01-30T21:21:11-05:00 rel_eng: Fix the name of the ubuntu-* jobs These were not uploaded for alpha1 Fixes #22844 - - - - - 68eb8877 by Matthew Pickering at 2023-01-30T21:21:11-05:00 gen_ci: Only consider release jobs for job metadata In particular we do not have a release job for FreeBSD so the generation of the platform mapping was failing. - - - - - b69461a0 by Jason Shipman at 2023-01-30T21:21:50-05:00 User's guide: Clarify overlapping instance candidate elimination This commit updates the user's guide section on overlapping instance candidate elimination to use "or" verbiage instead of "either/or" in regards to the current pair of candidates' being overlappable or overlapping. "Either IX is overlappable, or IY is overlapping" can cause confusion as it suggests "Either IX is overlappable, or IY is overlapping, but not both". This was initially discussed on this Discourse topic: https://discourse.haskell.org/t/clarification-on-overlapping-instance-candidate-elimination/5677 - - - - - 7cbdaad0 by Matthew Pickering at 2023-01-31T07:53:53-05:00 Fixes for cabal-reinstall CI job * Allow filepath to be reinstalled * Bump some version bounds to allow newer versions of libraries * Rework testing logic to avoid "install --lib" and package env files Fixes #22344 - - - - - fd8f32bf by Cheng Shao at 2023-01-31T07:54:29-05:00 rts: prevent potential divide-by-zero when tickInterval=0 This patch fixes a few places in RtsFlags.c that may result in divide-by-zero error when tickInterval=0, which is the default on wasm. Fixes #22603. - - - - - 085a6db6 by Joachim Breitner at 2023-01-31T07:55:05-05:00 Update note at beginning of GHC.Builtin.NAmes some things have been renamed since it was written, it seems. - - - - - 7716cbe6 by Cheng Shao at 2023-01-31T07:55:41-05:00 testsuite: use tgamma for cg007 gamma is a glibc-only deprecated function, use tgamma instead. It's required for fixing cg007 when testing the wasm unregisterised codegen. - - - - - 19c1fbcd by doyougnu at 2023-01-31T13:08:03-05:00 InfoTableProv: ShortText --> ShortByteString - - - - - 765fab98 by doyougnu at 2023-01-31T13:08:03-05:00 FastString: add fastStringToShorText - - - - - a83c810d by Simon Peyton Jones at 2023-01-31T13:08:38-05:00 Improve exprOkForSpeculation for classops This patch fixes #22745 and #15205, which are about GHC's failure to discard unnecessary superclass selections that yield coercions. See GHC.Core.Utils Note [exprOkForSpeculation and type classes] The main changes are: * Write new Note [NON-BOTTOM_DICTS invariant] in GHC.Core, and refer to it * Define new function isTerminatingType, to identify those guaranteed-terminating dictionary types. * exprOkForSpeculation has a new (very simple) case for ClassOpId * ClassOpId has a new field that says if the return type is an unlifted type, or a terminating type. This was surprisingly tricky to get right. In particular note that unlifted types are not terminating types; you can write an expression of unlifted type, that diverges. Not so for dictionaries (or, more precisely, for the dictionaries that GHC constructs). Metric Decrease: LargeRecord - - - - - f83374f8 by Krzysztof Gogolewski at 2023-01-31T13:09:14-05:00 Support "unusable UNPACK pragma" warning with -O0 Fixes #11270 - - - - - a2d814dc by Ben Gamari at 2023-01-31T13:09:50-05:00 configure: Always create the VERSION file Teach the `configure` script to create the `VERSION` file. This will serve as the stable interface to allow the user to determine the version number of a working tree. Fixes #22322. - - - - - 5618fc21 by sheaf at 2023-01-31T15:51:06-05:00 Cmm: track the type of global registers This patch tracks the type of Cmm global registers. This is needed in order to lint uses of polymorphic registers, such as SIMD vector registers that can be used both for floating-point and integer values. This changes allows us to refactor VanillaReg to not store VGcPtr, as that information is instead stored in the type of the usage of the register. Fixes #22297 - - - - - 78b99430 by sheaf at 2023-01-31T15:51:06-05:00 Revert "Cmm Lint: relax SIMD register assignment check" This reverts commit 3be48877, which weakened a Cmm Lint check involving SIMD vectors. Now that we keep track of the type a global register is used at, we can restore the original stronger check. - - - - - be417a47 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix debugging output Previously various panics would rely on a half-written Show instance, leading to very unhelpful errors. Fix this. See #22798. - - - - - 30989d13 by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen: Teach graph-colouring allocator that x18 is unusable Previously trivColourable for AArch64 claimed that at 18 registers were trivially-colourable. This is incorrect as x18 is reserved by the platform on AArch64/Darwin. See #22798. - - - - - 7566fd9d by Ben Gamari at 2023-01-31T15:51:45-05:00 nativeGen/AArch64: Fix graph-colouring allocator Previously various `Instr` queries used by the graph-colouring allocator failed to handle a few pseudo-instructions. This manifested in compiler panicks while compiling `SHA`, which uses `-fregs-graph`. Fixes #22798. - - - - - 2cb500a5 by Ben Gamari at 2023-01-31T15:51:45-05:00 testsuite: Add regression test for #22798 - - - - - 03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00 Revert "Hadrian: fix doc generation" This is too large of a hammer. This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f. - - - - - f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Sphinx docs require templated cabal files The package-version discovery logic in `doc/users_guide/package_versions.py` uses packages' cabal files to determine package versions. Teach Sphinx about these dependencies in cases where the cabal files are generated by templates. - - - - - 2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00 hadrian: Refactor templating logic This refactors Hadrian's autoconf-style templating logic to be explicit about which interpolation variables should be substituted in which files. This clears the way to fix #22714 without incurring rule cycles. - - - - - 93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00 hadrian: Substitute LIBRARY_*_VERSION variables This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables in `libraries/prologue.txt`, fixing #22714. Fixes #22714. - - - - - 22089f69 by Ben Gamari at 2023-01-31T20:46:27-05:00 Bump transformers submodule to 0.6.0.6 Fixes #22862. - - - - - f0eefa3c by Cheng Shao at 2023-01-31T20:47:03-05:00 compiler: properly handle non-word-sized CmmSwitch scrutinees in the wasm NCG Currently, the wasm NCG has an implicit assumption: all CmmSwitch scrutinees are 32-bit integers. This is not always true; #22864 is one counter-example with a 64-bit scrutinee. This patch fixes the logic by explicitly converting the scrutinee to a word that can be used as a br_table operand. Fixes #22871. Also includes a regression test. - - - - - 9f95db54 by Simon Peyton Jones at 2023-02-01T08:55:08+00:00 Improve treatment of type applications in patterns This patch fixes a subtle bug in the typechecking of type applications in patterns, e.g. f (MkT @Int @a x y) = ... See Note [Type applications in patterns] in GHC.Tc.Gen.Pat. This fixes #19847, #22383, #19577, #21501 - - - - - 955a99ea by Simon Peyton Jones at 2023-02-01T12:31:23-05:00 Treat existentials correctly in dubiousDataConInstArgTys Consider (#22849) data T a where MkT :: forall k (t::k->*) (ix::k). t ix -> T @k a Then dubiousDataConInstArgTys MkT [Type, Foo] should return [Foo (ix::Type)] NOT [Foo (ix::k)] A bit of an obscure case, but it's an outright bug, and the fix is easy. - - - - - 0cc16aaf by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump supported LLVM range from 10 through 15 to 11 through 16 LLVM 15 turns on the new pass manager by default, which we have yet to migrate to so for new we pass the `-enable-new-pm-0` flag in our llvm-passes flag. LLVM 11 was the first version to support the `-enable-new-pm` flag so we bump the lowest supported version to 11. Our CI jobs are using LLVM 12 so they should continue to work despite this bump to the lower bound. Fixes #21936 - - - - - f94f1450 by Matthew Pickering at 2023-02-01T12:31:58-05:00 Bump DOCKER_REV to use alpine image without LLVM installed alpine_3_12 only supports LLVM 10, which is now outside the supported version range. - - - - - 083e26ed by Matthew Pickering at 2023-02-01T17:43:21-05:00 Remove tracing OPTIONS_GHC These were accidentally left over from !9542 - - - - - 354aa47d by Teo Camarasu at 2023-02-01T17:44:00-05:00 doc: fix gcdetails_block_fragmentation_bytes since annotation - - - - - 61ce5bf6 by Jaro Reinders at 2023-02-02T00:15:30-05:00 compiler: Implement higher order patterns in the rule matcher This implements proposal 555 and closes ticket #22465. See the proposal and ticket for motivation. The core changes of this patch are in the GHC.Core.Rules.match function and they are explained in the Note [Matching higher order patterns]. - - - - - 394b91ce by doyougnu at 2023-02-02T00:16:10-05:00 CI: JavaScript backend runs testsuite This MR runs the testsuite for the JS backend. Note that this is a temporary solution until !9515 is merged. Key point: The CI runs hadrian on the built cross compiler _but not_ on the bindist. Other Highlights: - stm submodule gets a bump to mark tests as broken - several tests are marked as broken or are fixed by adding more - conditions to their test runner instance. List of working commit messages: CI: test cross target _and_ emulator CI: JS: Try run testsuite with hadrian JS.CI: cleanup and simplify hadrian invocation use single bracket, print info JS CI: remove call to test_compiler from hadrian don't build haddock JS: mark more tests as broken Tracked in https://gitlab.haskell.org/ghc/ghc/-/issues/22576 JS testsuite: don't skip sum_mod test Its expected to fail, yet we skipped it which automatically makes it succeed leading to an unexpected success, JS testsuite: don't mark T12035j as skip leads to an unexpected pass JS testsuite: remove broken on T14075 leads to unexpected pass JS testsuite: mark more tests as broken JS testsuite: mark T11760 in base as broken JS testsuite: mark ManyUnbSums broken submodules: bump process and hpc for JS tests Both submodules has needed tests skipped or marked broken for th JS backend. This commit now adds these changes to GHC. See: HPC: https://gitlab.haskell.org/hpc/hpc/-/merge_requests/21 Process: https://github.com/haskell/process/pull/268 remove js_broken on now passing tests separate wasm and js backend ci test: T11760: add threaded, non-moving only_ways test: T10296a add req_c T13894: skip for JS backend tests: jspace, T22333: mark as js_broken(22573) test: T22513i mark as req_th stm submodule: mark stm055, T16707 broken for JS tests: js_broken(22374) on unpack_sums_6, T12010 dont run diff on JS CI, cleanup fixup: More CI cleanup fix: align text to master fix: align exceptions submodule to master CI: Bump DOCKER_REV Bump to ci-images commit that has a deb11 build with node. Required for !9552 testsuite: mark T22669 as js_skip See #22669 This test tests that .o-boot files aren't created when run in using the interpreter backend. Thus this is not relevant for the JS backend. testsuite: mark T22671 as broken on JS See #22835 base.testsuite: mark Chan002 fragile for JS see #22836 revert: submodule process bump bump stm submodule New hash includes skips for the JS backend. testsuite: mark RnPatternSynonymFail broken on JS Requires TH: - see !9779 - and #22261 compiler: GHC.hs ifdef import Utils.Panic.Plain - - - - - 1ffe770c by Cheng Shao at 2023-02-02T09:40:38+00:00 docs: 9.6 release notes for wasm backend - - - - - 0ada4547 by Matthew Pickering at 2023-02-02T11:39:44-05:00 Disable unfolding sharing for interface files with core definitions Ticket #22807 pointed out that the RHS sharing was not compatible with -fignore-interface-pragmas because the flag would remove unfoldings from identifiers before the `extra-decls` field was populated. For the 9.6 timescale the only solution is to disable this sharing, which will make interface files bigger but this is acceptable for the first release of `-fwrite-if-simplified-core`. For 9.8 it would be good to fix this by implementing #20056 due to the large number of other bugs that would fix. I also improved the error message in tc_iface_binding to avoid the "no match in record selector" error but it should never happen now as the entire sharing logic is disabled. Also added the currently broken test for #22807 which could be fixed by !6080 Fixes #22807 - - - - - 7e2d3eb5 by lrzlin at 2023-02-03T05:23:27-05:00 Enable tables next to code for LoongArch64 - - - - - 2931712a by Wander Hillen at 2023-02-03T05:24:06-05:00 Move pthread and timerfd ticker implementations to separate files - - - - - 41c4baf8 by Ben Gamari at 2023-02-03T05:24:44-05:00 base: Fix Note references in GHC.IO.Handle.Types - - - - - 31358198 by Bodigrim at 2023-02-03T05:25:22-05:00 Bump submodule containers to 0.6.7 Metric Decrease: ManyConstructors T10421 T12425 T12707 T13035 T13379 T15164 T1969 T783 T9198 T9961 WWRec - - - - - 8feb9301 by Ben Gamari at 2023-02-03T05:25:59-05:00 gitlab-ci: Eliminate redundant ghc --info output Previously ci.sh would emit the output of `ghc --info` every time it ran when using the nix toolchain. This produced a significant amount of noise. See #22861. - - - - - de1d1512 by Ryan Scott at 2023-02-03T14:07:30-05:00 Windows: Remove mingwex dependency The clang based toolchain uses ucrt as its math library and so mingwex is no longer needed. In fact using mingwex will cause incompatibilities as the default routines in both have differing ULPs and string formatting modifiers. ``` $ LIBRARY_PATH=/mingw64/lib ghc/_build/stage1/bin/ghc Bug.hs -fforce-recomp && ./Bug.exe [1 of 2] Compiling Main ( Bug.hs, Bug.o ) ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__imp___p__environ' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `__hscore_get_errno' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziError_errnoToIOError_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziWindows_failIf2_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePageziAPI_mkCodePageEncoding_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncodingziCodePage_currentCodePage_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziEncoding_getForeignEncoding_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_ForeignziCziString_withCStringLen1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziInternals_zdwflushCharReadBuffer_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziIOziHandleziText_hGetBuf1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziFingerprint_fingerprintString_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_DataziTypeableziInternal_mkTrCon_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziException_errorCallWithCallStackException_closure' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\base-4.17.0.0\libHSbase-4.17.0.0.a: unknown symbol `base_GHCziErr_error_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `base_DataziMaybe_fromJust1_info' ghc.exe: | C:\Users\winferno\Software\ghc\_build\stage1\lib\x86_64-windows-ghc-9.5.20220908\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.a: unknown symbol `templatezmhaskell_LanguageziHaskellziTHziSyntax_IntPrimL_con_info' ghc.exe: ^^ Could not load 'templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure', dependency unresolved. See top entry above. <no location info>: error: GHC.ByteCode.Linker.lookupCE During interactive linking, GHCi couldn't find the following symbol: templatezmhaskell_LanguageziHaskellziTHziLibziInternal_stringL_closure This may be due to you not asking GHCi to load extra object files, archives or DLLs needed by your current session. Restart GHCi, specifying the missing library using the -L/path/to/object/dir and -lmissinglibname flags, or simply by naming the relevant files on the GHCi command line. Alternatively, this link failure might indicate a bug in GHCi. If you suspect the latter, please report this as a GHC bug: https://www.haskell.org/ghc/reportabug ``` - - - - - 48e39195 by Tamar Christina at 2023-02-03T14:07:30-05:00 linker: Fix BFD import libraries This commit fixes the BFD style import library support in the runtime linker. This was accidentally broken during the refactoring to clang and went unnoticed because clang itself is unable to generate the BFD style import libraries. With this change we can not link against both GCC or Clang produced libraries again and intermix code produced by both compilers. - - - - - b2bb3e62 by Ben Gamari at 2023-02-03T14:07:30-05:00 Bump Windows toolchain Updates to LLVM 14, hopefully fixing #21964. - - - - - bf3f88a1 by Andreas Klebinger at 2023-02-03T14:08:07-05:00 Fix CallerCC potentially shadowing other cost centres. Add a CallerCC cost centre flavour for cost centres added by the CallerCC pass. This avoids potential accidental shadowing between CCs added by user annotations and ones added by CallerCC. - - - - - faea4bcd by j at 2023-02-03T14:08:47-05:00 Disable several ignore-warning flags in genapply. - - - - - 25537dfd by Ben Gamari at 2023-02-04T04:12:57-05:00 Revert "Use fix-sized bit-fiddling primops for fixed size boxed types" This reverts commit 4512ad2d6a8e65ea43c86c816411cb13b822f674. This was never applied to master/9.6 originally. (cherry picked from commit a44bdc2720015c03d57f470b759ece7fab29a57a) - - - - - 7612dc71 by Krzysztof Gogolewski at 2023-02-04T04:13:34-05:00 Minor refactor * Introduce refactorDupsOn f = refactorDups (comparing f) * Make mkBigTupleCase and coreCaseTuple monadic. Every call to those functions was preceded by calling newUniqueSupply. * Use mkUserLocalOrCoVar, which is equivalent to combining mkLocalIdOrCoVar with mkInternalName. - - - - - 5a54ac0b by Bodigrim at 2023-02-04T18:48:32-05:00 Fix colors in emacs terminal - - - - - 3c0f0c6d by Bodigrim at 2023-02-04T18:49:11-05:00 base changelog: move entries which were not backported to ghc-9.6 to base-4.19 section - - - - - b18fbf52 by Josh Meredith at 2023-02-06T07:47:57+00:00 Update JavaScript fileStat to match Emscripten layout - - - - - 6636b670 by Sylvain Henry at 2023-02-06T09:43:21-05:00 JS: replace "js" architecture with "javascript" Despite Cabal supporting any architecture name, `cabal --check` only supports a few built-in ones. Sadly `cabal --check` is used by Hackage hence using any non built-in name in a package (e.g. `arch(js)`) is rejected and the package is prevented from being uploaded on Hackage. Luckily built-in support for the `javascript` architecture was added for GHCJS a while ago. In order to allow newer `base` to be uploaded on Hackage we make the switch from `js` to `javascript` architecture. Fixes #22740. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 77a8234c by Luite Stegeman at 2023-02-06T09:43:59-05:00 Fix marking async exceptions in the JS backend Async exceptions are posted as a pair of the exception and the thread object. This fixes the marking pass to correctly follow the two elements of the pair. Potentially fixes #22836 - - - - - 3e09cf82 by Jan Hrček at 2023-02-06T09:44:38-05:00 Remove extraneous word in Roles user guide - - - - - b17fb3d9 by sheaf at 2023-02-07T10:51:33-05:00 Don't allow . in overloaded labels This patch removes . from the list of allowed characters in a non-quoted overloaded label, as it was realised this steals syntax, e.g. (#.). Users who want this functionality will have to add quotes around the label, e.g. `#"17.28"`. Fixes #22821 - - - - - 5dce04ee by romes at 2023-02-07T10:52:10-05:00 Update kinds in comments in GHC.Core.TyCon Use `Type` instead of star kind (*) Fix comment with incorrect kind * to have kind `Constraint` - - - - - 92916194 by Ben Gamari at 2023-02-07T10:52:48-05:00 Revert "Use fix-sized equality primops for fixed size boxed types" This reverts commit 024020c38126f3ce326ff56906d53525bc71690c. This was never applied to master/9.6 originally. See #20405 for why using these primops is a bad idea. (cherry picked from commit b1d109ad542e4c37ae5af6ace71baf2cb509d865) - - - - - c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00 JS: avoid head/tail and unpackFS - - - - - a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00 testsuite: Fix Python warnings (#22856) - - - - - 9ee761bf by sheaf at 2023-02-08T14:40:40-05:00 Fix tyvar scoping within class SPECIALISE pragmas Type variables from class/instance headers scope over class/instance method type signatures, but DO NOT scope over the type signatures in SPECIALISE and SPECIALISE instance pragmas. The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for SPECIALISE inline pragmas, but forgot to apply the same treatment to method SPECIALISE pragmas, which lead to a Core Lint failure with an out-of-scope type variable. This patch makes sure we apply the same logic for both cases. Fixes #22913 - - - - - 7eac2468 by Matthew Pickering at 2023-02-08T14:41:17-05:00 Revert "Don't keep exit join points so much" This reverts commit caced75765472a1a94453f2e5a439dba0d04a265. It seems the patch "Don't keep exit join points so much" is causing wide-spread regressions in the bytestring library benchmarks. If I revert it then the 9.6 numbers are better on average than 9.4. See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525 ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp MultiLayerModulesTH_Make T12150 T13386 T13719 T21839c T3294 parsing001 ------------------------- - - - - - 633f2799 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: remove config.use_threads This patch simplifies the testsuite driver by removing the use_threads config field. It's just a degenerate case of threads=1. - - - - - ca6673e3 by Cheng Shao at 2023-02-08T18:42:16-05:00 testsuite: use concurrent.futures.ThreadPoolExecutor in the driver The testsuite driver used to create one thread per test case, and explicitly use semaphore and locks for rate limiting and synchronization. This is a bad practice in any language, and occasionally may result in livelock conditions (e.g. #22889). This patch uses concurrent.futures.ThreadPoolExecutor for scheduling test case runs, which is simpler and more robust. - - - - - f22cce70 by Alan Zimmerman at 2023-02-08T18:42:51-05:00 EPA: Comment between module and where should be in header comments Do not apply the heuristic to associate a comment with a prior declaration for the first declaration in the file. Closes #22919 - - - - - d69ecac2 by Josh Meredith at 2023-02-09T03:24:05-05:00 JS generated refs: update testsuite conditions - - - - - 2ea1a6bc by sheaf at 2023-02-09T03:24:44-05:00 Bump transformers to 0.6.1.0 This allows us to avoid orphans for Foldable1 instances, fixing #22898. Updates transformers submodule. - - - - - d9d0c28d by konsumlamm at 2023-02-09T14:07:48-05:00 Update `Data.List.singleton` doc comment - - - - - fe9cd6ef by Ben Gamari at 2023-02-09T14:08:23-05:00 gitlab-template: Emphasize `user facing` label My sense is that the current mention of the ~"user facing" label is overlooked by many MR authors. Let's move this point up in the list to make it more likely that it is seen. Also rephrase some of the points. - - - - - e45eb828 by Simon Peyton Jones at 2023-02-10T06:51:28-05:00 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. - - - - - 11e0cacb by Rebecca Turner at 2023-02-10T06:52:09-05:00 Detect the `mold` linker Enables support for the `mold` linker by rui314. - - - - - 59556235 by parsonsmatt at 2023-02-10T09:53:11-05:00 Add Lift instance for Fixed - - - - - c44e5f30 by Sylvain Henry at 2023-02-10T09:53:51-05:00 Testsuite: decrease length001 timeout for JS (#22921) - - - - - 133516af by Zubin Duggal at 2023-02-10T09:54:27-05:00 compiler: Use NamedFieldPuns for `ModIface_` and `ModIfaceBackend` `NFData` instances This is a minor refactor that makes it easy to add and remove fields from `ModIface_` and `ModIfaceBackend`. Also change the formatting to make it clear exactly which fields are fully forced with `rnf` - - - - - 1e9eac1c by Matthew Pickering at 2023-02-13T11:36:41+01:00 Refresh profiling docs I went through the whole of the profiling docs and tried to amend them to reflect current best practices and tooling. In particular I removed some old references to tools such as hp2any and replaced them with references to eventlog2html. - - - - - da208b9a by Matthew Pickering at 2023-02-13T11:36:41+01:00 docs: Add section about profiling and foreign calls Previously there was no documentation for how foreign calls interacted with the profiler. This can be quite confusing for users so getting it into the user guide is the first step to a potentially better solution. See the ticket for more insightful discussion. Fixes #21764 - - - - - 081640f1 by Bodigrim at 2023-02-13T12:51:52-05:00 Document that -fproc-alignment was introduced only in GHC 8.6 - - - - - 16adc349 by Sven Tennie at 2023-02-14T11:26:31-05:00 Add clangd flag to include generated header files This enables clangd to correctly check C files that import Rts.h. (The added include directory contains ghcautoconf.h et. al.) - - - - - c399ccd9 by amesgen at 2023-02-14T11:27:14-05:00 Mention new `Foreign.Marshal.Pool` implementation in User's Guide - - - - - b9282cf7 by Ben Gamari at 2023-02-14T11:27:50-05:00 upload_ghc_libs: More control over which packages to operate on Here we add a `--skip` flag to `upload_ghc_libs`, making it easier to limit which packages to upload. This is often necessary when one package is not uploadable (e.g. see #22740). - - - - - aa3a262d by PHO at 2023-02-14T11:28:29-05:00 Assume platforms support rpaths if they use either ELF or Mach-O Not only Linux, Darwin, and FreeBSD support rpaths. Determine the usability of rpaths based on the object format, not on OS. - - - - - 47716024 by PHO at 2023-02-14T11:29:09-05:00 RTS linker: Improve compatibility with NetBSD 1. Hint address to NetBSD mmap(2) has a different semantics from that of Linux. When a hint address is provided, mmap(2) searches for a free region at or below the hint but *never* above it. This means we can't reliably search for free regions incrementally on the userland, especially when ASLR is enabled. Let the kernel do it for us if we don't care where the mapped address is going to be. 2. NetBSD not only hates to map pages as rwx, but also disallows to switch pages from rw- to r-x unless the intention is declared when pages are initially requested. This means we need a new MemoryAccess mode for pages that are going to be changed to r-x. - - - - - 11de324a by Li-yao Xia at 2023-02-14T11:29:49-05:00 base: Move changelog entry to its place - - - - - 75930424 by Ben Gamari at 2023-02-14T11:30:27-05:00 nativeGen/AArch64: Emit Atomic{Read,Write} inline Previously the AtomicRead and AtomicWrite operations were emitted as out-of-line calls. However, these tend to be very important for performance, especially the RELAXED case (which only exists for ThreadSanitizer checking). Fixes #22115. - - - - - d6411d6c by Andreas Klebinger at 2023-02-14T11:31:04-05:00 Fix some correctness issues around tag inference when targeting the bytecode generator. * Let binders are now always assumed untagged for bytecode. * Imported referenced are now always assumed to be untagged for bytecode. Fixes #22840 - - - - - 9fb4ca89 by sheaf at 2023-02-14T11:31:49-05:00 Introduce warning for loopy superclass solve Commit aed1974e completely re-engineered the treatment of loopy superclass dictionaries in instance declarations. Unfortunately, it has the potential to break (albeit in a rather minor way) user code. To alleviate migration concerns, this commit re-introduces the old behaviour. Any reliance on this old behaviour triggers a warning, controlled by `-Wloopy-superclass-solve`. The warning text explains that GHC might produce bottoming evidence, and provides a migration strategy. This allows us to provide a graceful migration period, alerting users when they are relying on this unsound behaviour. Fixes #22912 #22891 #20666 #22894 #22905 - - - - - 1928c7f3 by Cheng Shao at 2023-02-14T11:32:26-05:00 rts: make it possible to change mblock size on 32-bit targets The MBLOCK_SHIFT macro must be the single source of truth for defining the mblock size, and changing it should only affect performance, not correctness. This patch makes it truly possible to reconfigure mblock size, at least on 32-bit targets, by fixing places which implicitly relied on the previous MBLOCK_SHIFT constant. Fixes #22901. - - - - - 78aa3b39 by Simon Hengel at 2023-02-14T11:33:06-05:00 Update outdated references to notes - - - - - e8baecd2 by meooow25 at 2023-02-14T11:33:49-05:00 Documentation: Improve Foldable1 documentation * Explain foldrMap1, foldlMap1, foldlMap1', and foldrMap1' in greater detail, the text is mostly adapted from documentation of Foldable. * Describe foldr1, foldl1, foldl1' and foldr1' in terms of the above functions instead of redoing the full explanation. * Small updates to documentation of fold1, foldMap1 and toNonEmpty, again adapting from Foldable. * Update the foldMap1 example to lists instead of Sum since this is recommended for lazy right-associative folds. Fixes #22847 - - - - - 85a1a575 by romes at 2023-02-14T11:34:25-05:00 fix: Mark ghci Prelude import as implicit Fixes #22829 In GHCi, we were creating an import declaration for Prelude but we were not setting it as an implicit declaration. Therefore, ghci's import of Prelude triggered -Wmissing-import-lists. Adds regression test T22829 to testsuite - - - - - 3b019a7a by Cheng Shao at 2023-02-14T11:35:03-05:00 compiler: fix generateCgIPEStub for no-tables-next-to-code builds generateCgIPEStub already correctly implements the CmmTick finding logic for when tables-next-to-code is on/off, but it used the wrong predicate to decide when to switch between the two. Previously it switches based on whether the codegen is unregisterised, but there do exist registerised builds that disable tables-next-to-code! This patch corrects that problem. Fixes #22896. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-05:00 rts: add the rts_clearMemory function This patch adds the rts_clearMemory function that does its best to zero out unused RTS memory for a wasm backend use case. See the comment above rts_clearMemory() prototype declaration for more detailed explanation. Closes #22920. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-05:00 Add -single-threaded flag to force single threaded rts This is the small part of implementing https://github.com/ghc-proposals/ghc-proposals/pull/240 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05:00 Narrow the dont-decompose-newtype test Following #22924 this patch narrows the test that stops us decomposing newtypes. The key change is the use of noGivenNewtypeReprEqs in GHC.Tc.Solver.Canonical.canTyConApp. We went to and fro on the solution, as you can see in #22924. The result is carefully documented in Note [Decomoposing newtype equalities] On the way I had revert most of commit 3e827c3f74ef76d90d79ab6c4e71aa954a1a6b90 Author: Richard Eisenberg <rae at cs.brynmawr.edu> Date: Mon Dec 5 10:14:02 2022 -0500 Do newtype unwrapping in the canonicaliser and rewriter See Note [Unwrap newtypes first], which has the details. It turns out that (a) 3e827c3f makes GHC behave worse on some recursive newtypes (see one of the tests on this commit) (b) the finer-grained test (namely noGivenNewtypeReprEqs) renders 3e827c3f unnecessary - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05:00 unicode: Don't inline bitmap in generalCategory generalCategory contains a huge literal string but is marked INLINE, this will duplicate the string into any use site of generalCategory. In particular generalCategory is used in functions like isSpace and the literal gets inlined into this function which makes it massive. https://github.com/haskell/core-libraries-committee/issues/130 Fixes #22949 ------------------------- Metric Decrease: T4029 T18304 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01:00 Improve GHC.Tc.Gen.App.tcInstFun It wasn't behaving right when inst_final=False, and the function had no type variables f :: Foo => Int Rather a corner case, but we might as well do it right. Fixes #22908 Unexpectedly, three test cases (all using :type in GHCi) got slightly better output as a result: T17403, T14796, T12447 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-05:00 Don't generate datacon wrappers for `type data` declarations Data constructor wrappers only make sense for _value_-level data constructors, but data constructors for `type data` declarations only exist at the _type_ level. This patch does the following: * The criteria in `GHC.Types.Id.Make.mkDataConRep` for whether a data constructor receives a wrapper now consider whether or not its parent data type was declared with `type data`, omitting a wrapper if this is the case. * Now that `type data` data constructors no longer receive wrappers, there is a spot of code in `refineDefaultAlt` that panics when it encounters a value headed by a `type data` type constructor. I've fixed this with a special case in `refineDefaultAlt` and expanded `Note [Refine DEFAULT case alternatives]` to explain why we do this. Fixes #22948. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-05:00 Treat type data declarations as empty when checking pattern-matching coverage The data constructors for a `type data` declaration don't exist at the value level, so we don't want GHC to warn users to match on them. Fixes #22964. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-05:00 Disallow `tagToEnum#` on `type data` types We don't want to allow users to conjure up values of a `type data` type using `tagToEnum#`, as these simply don't exist at the value level. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Statically assert alignment of Capability In #22965 we noticed that changes in the size of `Capability` can result in unsound behavior due to the `align` pragma claiming an alignment which we don't in practice observe. Avoid this by statically asserting that the size is a multiple of the alignment. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Correctly align Capability allocations Previously we failed to tell the C allocator that `Capability`s needed to be aligned, resulting in #22965. Fixes #22965. Fixes #22975. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00:00 Constraint simplification loop now depends on `ExpansionFuel` instead of a boolean flag for `CDictCan.cc_pend_sc`. Pending givens get a fuel of 3 while Wanted and quantified constraints get a fuel of 1. This helps pending given constraints to keep up with pending wanted constraints in case of `UndecidableSuperClasses` and superclass expansions while simplifying the infered type. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/BlockAlloc: Allow disabling of internal assertions These can be quite expensive and it is sometimes useful to compile a DEBUG RTS without them. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't push empty arrays to update remembered set Previously the write barrier of resizeSmallArray# incorrectly handled resizing of zero-sized arrays, pushing an invalid pointer to the update remembered set. Fixes #22931. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix handling of weak pointers This fixes an interaction between aging and weak pointer handling which prevented the finalization of some weak pointers. In particular, weak pointers could have their keys incorrectly marked by the preparatory collector, preventing their finalization by the subsequent concurrent collection. While in the area, we also significantly improve the assertions regarding weak pointers. Fixes #22327. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check mutable list Assert that entries in the nonmoving generation's generational remembered set (a.k.a. mutable list) live in nonmoving generation. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix tracking of FILLED_SWEEPING segments Previously we only updated the state of the segment at the head of each allocator's filled list. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Handle new closures in nonmovingIsNowAlive We must conservatively assume that new closures are reachable since we are not guaranteed to mark such blocks. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't clobber update rem sets of old capabilities Previously `storageAddCapabilities` (called by `setNumCapabilities`) would clobber the update remembered sets of existing capabilities when increasing the capability count. Fix this by only initializing the update remembered sets of the newly-created capabilities. Fixes #22927. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing write barriers in selector optimisation This fixes the selector optimisation, adding a few write barriers which are necessary for soundness. See the inline comments for details. Fixes #22930. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Be more paranoid in segment tracking Previously we left various segment link pointers dangling. None of this wrong per se, but it did make it harder than necessary to debug. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Sync-phase mark budgeting Here we significantly improve the bound on sync phase pause times by imposing a limit on the amount of work that we can perform during the sync. If we find that we have exceeded our marking budget then we allow the mutators to resume, return to concurrent marking, and try synchronizing again later. Fixes #22929. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move current segment array into Capability The current segments are conceptually owned by the mutator, not the collector. Consequently, it was quite tricky to prove that the mutator would not race with the collect due to this shared state. It turns out that such races are possible: when resizing the current segment array we may concurrently try to take a heap census. This will attempt to walk the current segment array, causing a data race. Fix this by moving the current segment array into `Capability`, where it belongs. Fixes #22926. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts/Sanity: Fix block count assertion with non-moving collector The nonmoving collector does not use `oldest_gen->blocks` to track its block list. However, it nevertheless updates `oldest_gen->n_blocks` to ensure that its size is accounted for by the storage manager. Consequently, we must not attempt to assert consistency between the two. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't call prepareUnloadCheck When the nonmoving GC is in use we do not call `checkUnload` (since we don't unload code) and therefore should not call `prepareUnloadCheck`, lest we run into assertions. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - fa6550f1 by Ben Gamari at 2023-07-24T16:06:34+02:00 Drop ghcPrimIfaceHook - - - - - cf3f938d by Ben Gamari at 2023-07-24T16:11:56+02:00 Rip out hacks surrounding GHC.Prim and primops - - - - - 92757eb0 by Ben Gamari at 2023-07-24T16:11:59+02:00 primops Add missing primtype declaration for TYPE - - - - - 0e2f36a1 by Ben Gamari at 2023-07-24T16:11:59+02:00 IsInteresting - - - - - f7799e55 by Ben Gamari at 2023-07-24T16:11:59+02:00 testsuite - - - - - 349ec2a7 by sheaf at 2023-07-26T12:06:25+02:00 WIP stuff - - - - - 19 changed files: - − .appveyor.sh - .editorconfig - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - + .gitlab/generate-ci/hie.yaml - − .gitlab/generate_jobs - + .gitlab/hello.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81b78b1969c4bc862ead14327973c070cc011520...349ec2a740e312a5e9eebdc53c8b7ecb22832f70 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81b78b1969c4bc862ead14327973c070cc011520...349ec2a740e312a5e9eebdc53c8b7ecb22832f70 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 10:13:48 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 26 Jul 2023 06:13:48 -0400 Subject: [Git][ghc/ghc][wip/T20155] WIP stuff Message-ID: <64c0f1dc214a3_2fb451b9aa024634b@gitlab.mail> sheaf pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: bc4ecba4 by sheaf at 2023-07-26T12:13:33+02:00 WIP stuff - - - - - 13 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Make.hs - libraries/base/Control/Exception/Base.hs - libraries/ghc-prim/GHC/Prim/Panic.hs - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -223,6 +223,7 @@ defaults -- nor `a_levpoly` and `a_reppoly`, etc. primtype TYPE +primtype CONSTRAINT section "The word size story." {Haskell98 specifies that signed integers (type 'Int') ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1774,7 +1774,7 @@ lintIdBndr :: TopLevelFlag -> BindingSite lintIdBndr top_lvl bind_site id thing_inside = assertPpr (isId id) (ppr id) $ do { flags <- getLintFlags - ; checkL (not (lf_check_global_ids flags) || isLocalId id || isWiredIn id) + ; checkL (not (lf_check_global_ids flags) || isLocalId id) (text "Non-local Id binder" <+> ppr id) -- See Note [Checking for global Ids] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -20,12 +20,6 @@ import GHC.Types.Demand -- All of it import GHC.Core import GHC.Core.DataCon -<<<<<<< HEAD -======= -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id -import GHC.Types.Name ( isWiredIn ) ->>>>>>> f0e0cfda35 (Rip out hacks surrounding GHC.Prim and primops) import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type @@ -150,7 +144,7 @@ isInterestingTopLevelFn :: Id -> Bool -- If there was a gain, that regression might be acceptable. -- Plus, we could use LetUp for thunks and share some code with local let -- bindings. -isInterestingTopLevelFn id = isLocalId id && typeArity (idType id) > 0 +isInterestingTopLevelFn id = typeArity (idType id) > 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1021,8 +1015,7 @@ dmdTransform env var sd = -- pprTrace "dmdTransform:DictSel" (ppr var $$ ppr (idDmdSig var) $$ ppr sd) $ dmdTransformDictSelSig (idDmdSig var) sd -- Imported functions - -- N.B. wired-in names may be GlobalIds and yet not imported. - | isGlobalId var && not (isWiredIn var) + | isGlobalId var , let res = dmdTransformSig (idDmdSig var) sd = -- pprTrace "dmdTransform:import" (vcat [ppr var, ppr (idDmdSig var), ppr sd, ppr res]) res @@ -1912,7 +1905,7 @@ along in boxed form and as such dissuade the creation of reboxing workers. -} -- | How many registers does this type take after unarisation? -unariseArity :: Type -> Arity +unariseArity :: HasDebugCallStack => Type -> Arity unariseArity ty = length (typePrimRep ty) data Budgets = MkB !Arity Budgets -- An infinite list of arity budgets ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -547,8 +547,10 @@ coreToStgApp f args ticks = do -- Some primitive operator that might be implemented as a library call. -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps -- we require that primop applications be saturated. + -- SLD TODO: I think unsaturated primops are fine now? PrimOpId op _ | saturated -> StgOpApp (StgPrimOp op) args' res_ty + -- | otherwise -> pprPanic "coreToStg unsaturated PrimOp" (ppr op) -- A call to some primitive Cmm function. FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True) ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -529,10 +529,7 @@ warnUnusedPackages us dflags mod_graph = mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs) $ concatMap ms_imps home_mod_sum - any_import_ghc_prim = any ms_ghc_prim_import home_mod_sum - used_args = Set.fromList (map unitId loadedPackages) - `Set.union` Set.fromList [ primUnitId | any_import_ghc_prim ] resolve (u,mflag) = do -- The units which we depend on via the command line explicitly ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -110,7 +110,7 @@ import GHC.Types.CostCentre ( isCurrentCCS ) import GHC.Types.Error ( DiagnosticReason(WarningWithoutFlag) ) import GHC.Types.Id import GHC.Types.Var.Set -import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom ) +import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom, isWiredInName ) import GHC.Types.RepType import GHC.Types.SrcLoc @@ -561,12 +561,16 @@ getStgPprOpts :: LintM StgPprOpts getStgPprOpts = LintM $ \_mod _lf _df opts _loc _scope errs -> (opts, errs) checkInScope :: Id -> LintM () -checkInScope id = LintM $ \mod _lf diag_opts _opts loc scope errs - -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then +checkInScope id + = LintM $ \mod _lf diag_opts _opts loc scope errs -> + if not (isWiredInName nm) && (nameIsLocalOrFrom mod nm && not (id `elemVarSet` scope)) then + -- SLD TODO? ((), addErr diag_opts errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) else ((), errs) + where + nm = idName id mkUnliftedTyMsg :: OutputablePass a => StgPprOpts -> Id -> GenStgRhs a -> SDoc mkUnliftedTyMsg opts binder rhs ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -233,7 +233,7 @@ stackSlotType i idPrimReps :: Id -> [PrimRep] idPrimReps = typePrimReps . idType -typePrimReps :: Type -> [PrimRep] +typePrimReps :: HasDebugCallStack => Type -> [PrimRep] typePrimReps = typePrimRep . unwrapType primRepSize :: PrimRep -> SlotCount ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1042,9 +1042,6 @@ tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType) -- Look up an occurrence of an Id -- Do not instantiate its type tcInferId id_name - -- TODO: Note - | Just (AnId id) <- wiredInNameTyThing_maybe id_name = do - return (HsVar noExtField (noLocA id), idType id) | id_name `hasKey` assertIdKey = do { dflags <- getDynFlags ; if gopt Opt_IgnoreAsserts dflags ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -153,7 +153,6 @@ import GHC.Types.Name import GHC.Unit.Module import GHC.Core.Class import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) -import {-# SOURCE #-} GHC.Types.TyThing (tyThingId) import GHC.Types.ForeignCall import GHC.Data.Maybe import GHC.Types.SrcLoc @@ -307,7 +306,6 @@ mkVanillaGlobalWithInfo = mkGlobalId VanillaId -- | For an explanation of global vs. local 'Id's, see "GHC.Types.Var#globalvslocal" mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id -mkLocalId name _ _ | Just thing <- wiredInNameTyThing_maybe name = tyThingId thing mkLocalId name w ty = mkLocalIdWithInfo name w (assert (not (isCoVarType ty)) ty) vanillaIdInfo -- | Make a local CoVar @@ -585,11 +583,13 @@ hasNoBinding :: Id -> Bool -- exception to this is unboxed tuples and sums datacons, which definitely have -- no binding hasNoBinding id = case Var.idDetails id of - PrimOpId _ lev_poly -> lev_poly - - FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc - _ -> isCompulsoryUnfolding (realIdUnfolding id) + PrimOpId _ _conc_tvs -> True -- not $ isEmptyNameEnv conc_tvs + RepPolyId _conc_tvs -> True +-- RepPolyId conc_tvs -> not $ isEmptyNameEnv conc_tvs +-- SLD TODO: not enough, e.g. some lev-poly stuff with no conc tvs have no binding + FCallId _ -> True + DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc + _ -> isCompulsoryUnfolding (realIdUnfolding id) -- Note: this function must be very careful not to force -- any of the fields that aren't the 'uf_src' field of -- the 'Unfolding' of the 'Id'. This is because these fields are computed ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Types.Id.Make ( unboxedUnitExpr, -- And some particular Ids; see below for why they are wired in - wiredInIds, ghcPrimIds, + wiredInIds, ghcPrimIds, magicIds, realWorldPrimId, voidPrimId, voidArgId, nullAddrId, seqId, lazyId, lazyIdKey, @@ -35,6 +35,7 @@ module GHC.Types.Id.Make ( proxyHashId, nospecId, nospecIdName, noinlineId, noinlineIdName, + oneShotId, oneShotName, noinlineConstraintId, noinlineConstraintIdName, coerceName, leftSectionName, rightSectionName, pcRepPolyId, ===================================== libraries/base/Control/Exception/Base.hs ===================================== @@ -426,7 +426,20 @@ typeError s = throw (TypeError (unpackCStringUtf8# s)) impossibleError, impossibleConstraintError :: Addr# -> a -- These two are used for impossible case alternatives, and lack location info impossibleError s = errorWithoutStackTrace (unpackCStringUtf8# s) -impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +--impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +impossibleConstraintError = impossibleConstraintError -- SLD TODO + -- impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +{- +libraries\base\Control\Exception\Base.hs:429:33: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘CONSTRAINT q’ + When matching types + a0 :: * + a :: CONSTRAINT q + • In the expression: errorWithoutStackTrace (unpackCStringUtf8# s) + In an equation for ‘impossibleConstraintError’: + impossibleConstraintError s + = errorWithoutStackTrace (unpackCStringUtf8# s) +-} -- GHC's RTS calls this ===================================== libraries/ghc-prim/GHC/Prim/Panic.hs ===================================== @@ -116,4 +116,18 @@ absentConstraintError :: forall (a :: Type). Addr# -> a -- type; the type in the interface file is never looked at. -- The only purpose of this definition is to give a function to call, -- and for that purpose, delegating to absentError is fine. -absentConstraintError errmsg = absentError errmsg +absentConstraintError = absentConstraintError -- SLD TODO: errmsg = absentError errmsg +{- +libraries\ghc-prim\GHC\Prim\Panic.hs:119:32: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘Constraint’ + When matching types + a0 :: * + a :: Constraint + • In the expression: absentError errmsg + In an equation for ‘absentConstraintError’: + absentConstraintError errmsg = absentError errmsg + • Relevant bindings include + absentConstraintError :: Addr# -=> a + (bound at libraries\ghc-prim\GHC\Prim\Panic.hs:119:1) + +-} ===================================== utils/genprimopcode/Main.hs ===================================== @@ -339,7 +339,7 @@ gen_hs_source (Info defaults entries) = prim_func :: String -> Ty -> Bool -> [String] prim_func n t llvm_only - | not (opTyHasFixedRuntimeRep t) = + | True = --not (opTyHasFixedRuntimeRep t) = [ "-- No wrapper due to RuntimeRep polymorphism:" , "-- " ++ wrapOp n ++ " :: " ++ pprTy t ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc4ecba4b94b88b294921023c21bce16b56a4522 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc4ecba4b94b88b294921023c21bce16b56a4522 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 11:04:40 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 26 Jul 2023 07:04:40 -0400 Subject: [Git][ghc/ghc][wip/T20155] WIP stuff Message-ID: <64c0fdc8a240d_2fb451b9a282627ec@gitlab.mail> sheaf pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: 3d98d3f9 by sheaf at 2023-07-26T13:04:30+02:00 WIP stuff - - - - - 13 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Make.hs - libraries/base/Control/Exception/Base.hs - libraries/ghc-prim/GHC/Prim/Panic.hs - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -223,6 +223,7 @@ defaults -- nor `a_levpoly` and `a_reppoly`, etc. primtype TYPE +primtype CONSTRAINT section "The word size story." {Haskell98 specifies that signed integers (type 'Int') ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1774,7 +1774,7 @@ lintIdBndr :: TopLevelFlag -> BindingSite lintIdBndr top_lvl bind_site id thing_inside = assertPpr (isId id) (ppr id) $ do { flags <- getLintFlags - ; checkL (not (lf_check_global_ids flags) || isLocalId id || isWiredIn id) + ; checkL (not (lf_check_global_ids flags) || isLocalId id) (text "Non-local Id binder" <+> ppr id) -- See Note [Checking for global Ids] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -20,12 +20,6 @@ import GHC.Types.Demand -- All of it import GHC.Core import GHC.Core.DataCon -<<<<<<< HEAD -======= -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id -import GHC.Types.Name ( isWiredIn ) ->>>>>>> f0e0cfda35 (Rip out hacks surrounding GHC.Prim and primops) import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type @@ -150,7 +144,7 @@ isInterestingTopLevelFn :: Id -> Bool -- If there was a gain, that regression might be acceptable. -- Plus, we could use LetUp for thunks and share some code with local let -- bindings. -isInterestingTopLevelFn id = isLocalId id && typeArity (idType id) > 0 +isInterestingTopLevelFn id = typeArity (idType id) > 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1021,8 +1015,7 @@ dmdTransform env var sd = -- pprTrace "dmdTransform:DictSel" (ppr var $$ ppr (idDmdSig var) $$ ppr sd) $ dmdTransformDictSelSig (idDmdSig var) sd -- Imported functions - -- N.B. wired-in names may be GlobalIds and yet not imported. - | isGlobalId var && not (isWiredIn var) + | isGlobalId var , let res = dmdTransformSig (idDmdSig var) sd = -- pprTrace "dmdTransform:import" (vcat [ppr var, ppr (idDmdSig var), ppr sd, ppr res]) res @@ -1912,7 +1905,7 @@ along in boxed form and as such dissuade the creation of reboxing workers. -} -- | How many registers does this type take after unarisation? -unariseArity :: Type -> Arity +unariseArity :: HasDebugCallStack => Type -> Arity unariseArity ty = length (typePrimRep ty) data Budgets = MkB !Arity Budgets -- An infinite list of arity budgets ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -547,8 +547,10 @@ coreToStgApp f args ticks = do -- Some primitive operator that might be implemented as a library call. -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps -- we require that primop applications be saturated. + -- SLD TODO: I think unsaturated primops are fine now? PrimOpId op _ | saturated -> StgOpApp (StgPrimOp op) args' res_ty + -- | otherwise -> pprPanic "coreToStg unsaturated PrimOp" (ppr op) -- A call to some primitive Cmm function. FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True) ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -529,10 +529,7 @@ warnUnusedPackages us dflags mod_graph = mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs) $ concatMap ms_imps home_mod_sum - any_import_ghc_prim = any ms_ghc_prim_import home_mod_sum - used_args = Set.fromList (map unitId loadedPackages) - `Set.union` Set.fromList [ primUnitId | any_import_ghc_prim ] resolve (u,mflag) = do -- The units which we depend on via the command line explicitly ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -110,7 +110,7 @@ import GHC.Types.CostCentre ( isCurrentCCS ) import GHC.Types.Error ( DiagnosticReason(WarningWithoutFlag) ) import GHC.Types.Id import GHC.Types.Var.Set -import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom ) +import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom, isWiredInName ) import GHC.Types.RepType import GHC.Types.SrcLoc @@ -561,12 +561,16 @@ getStgPprOpts :: LintM StgPprOpts getStgPprOpts = LintM $ \_mod _lf _df opts _loc _scope errs -> (opts, errs) checkInScope :: Id -> LintM () -checkInScope id = LintM $ \mod _lf diag_opts _opts loc scope errs - -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then +checkInScope id + = LintM $ \mod _lf diag_opts _opts loc scope errs -> + if not (isWiredInName nm) && (nameIsLocalOrFrom mod nm && not (id `elemVarSet` scope)) then + -- SLD TODO? ((), addErr diag_opts errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) else ((), errs) + where + nm = idName id mkUnliftedTyMsg :: OutputablePass a => StgPprOpts -> Id -> GenStgRhs a -> SDoc mkUnliftedTyMsg opts binder rhs ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -233,7 +233,7 @@ stackSlotType i idPrimReps :: Id -> [PrimRep] idPrimReps = typePrimReps . idType -typePrimReps :: Type -> [PrimRep] +typePrimReps :: HasDebugCallStack => Type -> [PrimRep] typePrimReps = typePrimRep . unwrapType primRepSize :: PrimRep -> SlotCount ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1042,9 +1042,6 @@ tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType) -- Look up an occurrence of an Id -- Do not instantiate its type tcInferId id_name - -- TODO: Note - | Just (AnId id) <- wiredInNameTyThing_maybe id_name = do - return (HsVar noExtField (noLocA id), idType id) | id_name `hasKey` assertIdKey = do { dflags <- getDynFlags ; if gopt Opt_IgnoreAsserts dflags ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -153,7 +153,6 @@ import GHC.Types.Name import GHC.Unit.Module import GHC.Core.Class import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) -import {-# SOURCE #-} GHC.Types.TyThing (tyThingId) import GHC.Types.ForeignCall import GHC.Data.Maybe import GHC.Types.SrcLoc @@ -307,7 +306,6 @@ mkVanillaGlobalWithInfo = mkGlobalId VanillaId -- | For an explanation of global vs. local 'Id's, see "GHC.Types.Var#globalvslocal" mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id -mkLocalId name _ _ | Just thing <- wiredInNameTyThing_maybe name = tyThingId thing mkLocalId name w ty = mkLocalIdWithInfo name w (assert (not (isCoVarType ty)) ty) vanillaIdInfo -- | Make a local CoVar @@ -585,11 +583,13 @@ hasNoBinding :: Id -> Bool -- exception to this is unboxed tuples and sums datacons, which definitely have -- no binding hasNoBinding id = case Var.idDetails id of - PrimOpId _ lev_poly -> lev_poly - - FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc - _ -> isCompulsoryUnfolding (realIdUnfolding id) + PrimOpId _ _conc_tvs -> True -- not $ isEmptyNameEnv conc_tvs + RepPolyId _conc_tvs -> True +-- RepPolyId conc_tvs -> not $ isEmptyNameEnv conc_tvs +-- SLD TODO: not enough, e.g. some lev-poly stuff with no conc tvs have no binding + FCallId _ -> True + DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc + _ -> isCompulsoryUnfolding (realIdUnfolding id) -- Note: this function must be very careful not to force -- any of the fields that aren't the 'uf_src' field of -- the 'Unfolding' of the 'Id'. This is because these fields are computed ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Types.Id.Make ( unboxedUnitExpr, -- And some particular Ids; see below for why they are wired in - wiredInIds, ghcPrimIds, + wiredInIds, ghcPrimIds, magicIds, realWorldPrimId, voidPrimId, voidArgId, nullAddrId, seqId, lazyId, lazyIdKey, @@ -35,6 +35,7 @@ module GHC.Types.Id.Make ( proxyHashId, nospecId, nospecIdName, noinlineId, noinlineIdName, + oneShotId, oneShotName, noinlineConstraintId, noinlineConstraintIdName, coerceName, leftSectionName, rightSectionName, pcRepPolyId, ===================================== libraries/base/Control/Exception/Base.hs ===================================== @@ -426,7 +426,20 @@ typeError s = throw (TypeError (unpackCStringUtf8# s)) impossibleError, impossibleConstraintError :: Addr# -> a -- These two are used for impossible case alternatives, and lack location info impossibleError s = errorWithoutStackTrace (unpackCStringUtf8# s) -impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +--impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +impossibleConstraintError = impossibleConstraintError -- SLD TODO + -- impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +{- +libraries\base\Control\Exception\Base.hs:429:33: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘CONSTRAINT q’ + When matching types + a0 :: * + a :: CONSTRAINT q + • In the expression: errorWithoutStackTrace (unpackCStringUtf8# s) + In an equation for ‘impossibleConstraintError’: + impossibleConstraintError s + = errorWithoutStackTrace (unpackCStringUtf8# s) +-} -- GHC's RTS calls this ===================================== libraries/ghc-prim/GHC/Prim/Panic.hs ===================================== @@ -116,4 +116,18 @@ absentConstraintError :: forall (a :: Type). Addr# -> a -- type; the type in the interface file is never looked at. -- The only purpose of this definition is to give a function to call, -- and for that purpose, delegating to absentError is fine. -absentConstraintError errmsg = absentError errmsg +absentConstraintError = absentConstraintError -- SLD TODO: errmsg = absentError errmsg +{- +libraries\ghc-prim\GHC\Prim\Panic.hs:119:32: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘Constraint’ + When matching types + a0 :: * + a :: Constraint + • In the expression: absentError errmsg + In an equation for ‘absentConstraintError’: + absentConstraintError errmsg = absentError errmsg + • Relevant bindings include + absentConstraintError :: Addr# -=> a + (bound at libraries\ghc-prim\GHC\Prim\Panic.hs:119:1) + +-} ===================================== utils/genprimopcode/Main.hs ===================================== @@ -339,7 +339,7 @@ gen_hs_source (Info defaults entries) = prim_func :: String -> Ty -> Bool -> [String] prim_func n t llvm_only - | not (opTyHasFixedRuntimeRep t) = + | True = --not (opTyHasFixedRuntimeRep t) = [ "-- No wrapper due to RuntimeRep polymorphism:" , "-- " ++ wrapOp n ++ " :: " ++ pprTy t ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d98d3f9faf124cd87d1a7d972cd7069f8e4459e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d98d3f9faf124cd87d1a7d972cd7069f8e4459e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 11:07:57 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 26 Jul 2023 07:07:57 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-full-ci] 3 commits: bootstrap: Remove ghc-9_2_* plans Message-ID: <64c0fe8d49caa_2fb451b9adc2634be@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-full-ci at Glasgow Haskell Compiler / GHC Commits: 774001a6 by Matthew Pickering at 2023-07-26T12:07:22+01:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 34480374 by Matthew Pickering at 2023-07-26T12:07:40+01:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies - - - - - a9f5b4d7 by Matthew Pickering at 2023-07-26T12:07:40+01:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - 9 changed files: - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7b16d0f77bae4e295088cc3d1baeec19899e584...a9f5b4d7f29419ec2a9d4e83fb0627d84825b923 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7b16d0f77bae4e295088cc3d1baeec19899e584...a9f5b4d7f29419ec2a9d4e83fb0627d84825b923 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 11:08:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 26 Jul 2023 07:08:31 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-full-ci] 2 commits: Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Message-ID: <64c0feaf7f73e_2fb451b9a78263844@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-full-ci at Glasgow Haskell Compiler / GHC Commits: 1f38b47e by Matthew Pickering at 2023-07-26T12:08:04+01:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - 4d1c46a4 by Matthew Pickering at 2023-07-26T12:08:24+01:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - 6 changed files: - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_4_1.json - hadrian/bootstrap/plan-9_4_2.json - hadrian/bootstrap/plan-9_4_3.json - hadrian/bootstrap/plan-9_4_4.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9f5b4d7f29419ec2a9d4e83fb0627d84825b923...4d1c46a4b0bbad401c7398a122bcdb988996607b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9f5b4d7f29419ec2a9d4e83fb0627d84825b923...4d1c46a4b0bbad401c7398a122bcdb988996607b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 11:09:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 26 Jul 2023 07:09:22 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 37 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64c0fee27f7f6_2fb451b9adc264265@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 6ae42f56 by Simon Peyton Jones at 2023-07-26T10:27:25+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 1% CoOpt_Read(normal) ghc/alloc 766,003,076 748,985,544 -2.2% GOOD T10858(normal) ghc/alloc 120,782,748 118,735,744 -1.7% T11545(normal) ghc/alloc 79,829,332 78,722,128 -1.4% T12150(optasm) ghc/alloc 73,881,192 72,854,208 -1.4% T13056(optasm) ghc/alloc 294,495,436 290,226,600 -1.4% T13253(normal) ghc/alloc 364,663,144 361,043,432 -1.0% T13253-spj(normal) ghc/alloc 118,248,796 59,996,856 -49.3% GOOD T15164(normal) ghc/alloc 1,102,607,920 1,087,375,984 -1.4% T15304(normal) ghc/alloc 1,196,061,524 1,155,296,336 -3.4% T15630(normal) ghc/alloc 148,707,300 147,104,768 -1.1% T17516(normal) ghc/alloc 1,657,993,132 1,626,735,192 -1.9% T17836(normal) ghc/alloc 395,306,932 391,219,640 -1.0% T18140(normal) ghc/alloc 71,948,496 73,206,920 +1.7% T18282(normal) ghc/alloc 129,090,864 131,483,440 +1.9% T18698b(normal) ghc/alloc 230,313,396 233,017,416 +1.2% BAD T4801(normal) ghc/alloc 247,568,452 250,836,624 +1.3% T9233(normal) ghc/alloc 709,634,020 685,363,720 -3.4% GOOD T9630(normal) ghc/alloc 965,838,132 942,010,984 -2.5% GOOD T9675(optasm) ghc/alloc 444,583,940 429,417,416 -3.4% GOOD T9961(normal) ghc/alloc 303,041,544 307,384,192 +1.4% BAD WWRec(normal) ghc/alloc 503,706,372 495,554,224 -1.6% geo. mean -1.0% minimum -49.3% maximum +1.9% The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 Metric Increase: T18698b T9961 - - - - - fb18db2e by Simon Peyton Jones at 2023-07-26T10:33:03+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 3241f424 by Simon Peyton Jones at 2023-07-26T10:33:03+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The net result is good: a 2% improvement in compile time. The table below shows changes over 1%. The main changes are: * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * When making join points, don't do so if the join point is so small it will immediately be inlined. See Note [Duplicating alternatives] * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * Many new or rewritten Notes. E.g. Note [Avoiding simplifying repeatedly] I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I added an INLINE pragma to it. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -4.3% GOOD LargeRecord(normal) -23.3% GOOD PmSeriesS(normal) -2.4% T11195(normal) -1.7% T12227(normal) -20.0% GOOD T12545(normal) -5.4% T13253-spj(normal) -50.7% GOOD T13386(normal) -5.1% GOOD T14766(normal) -2.4% GOOD T15164(normal) -1.7% T15304(normal) +1.0% T15630(normal) -7.7% T15630a(normal) NEW T15703(normal) -7.5% GOOD T16577(normal) -5.1% GOOD T17516(normal) -3.6% T18223(normal) -16.8% GOOD T18282(normal) -1.5% T18304(normal) +1.9% T21839c(normal) -3.5% GOOD T3064(normal) -1.5% T5030(normal) -16.2% GOOD T5321Fun(normal) -1.6% T6048(optasm) -2.1% GOOD T8095(normal) -6.1% GOOD T9630(normal) -5.1% GOOD WWRec(normal) -1.6% geo. mean -2.1% minimum -50.7% maximum +1.9% Metric Decrease: CoOpt_Singletons LargeRecord T12227 T13253-spj T13386 T14766 T15703 T16577 T18223 T21839c T5030 T6048 T8095 T9630 - - - - - 9e54f7b0 by Simon Peyton Jones at 2023-07-26T10:33:03+01:00 No postInlineUnconditionally for strict bindings Does not save allocation! - - - - - 4aad7d06 by Simon Peyton Jones at 2023-07-26T10:33:03+01:00 No preInlineConditionally for join points Does not save allocation! - - - - - 0e060faa by Simon Peyton Jones at 2023-07-26T10:33:03+01:00 Don't use Plan A for a case continuation See carryPropagate in digits-of-e2 Really I'm moving more towards Plan B. - - - - - 06c72027 by Simon Peyton Jones at 2023-07-26T10:33:03+01:00 Fix merge bugs - - - - - 21d05c53 by Simon Peyton Jones at 2023-07-26T10:33:04+01:00 Further wibbles In particular simplifying SelCo in Coercion.Opt - - - - - 17 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f86cc3bddfd6ca88d437cf86fef2d221c114001...21d05c534c05bd4c9b9ec16589199e6a446a2ec6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6f86cc3bddfd6ca88d437cf86fef2d221c114001...21d05c534c05bd4c9b9ec16589199e6a446a2ec6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 11:13:00 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 26 Jul 2023 07:13:00 -0400 Subject: [Git][ghc/ghc][wip/bootstrap-full-ci] 3 commits: bootstrap: Remove ghc-9_2_* plans Message-ID: <64c0ffbcba22_2fb451b9a78265087@gitlab.mail> Matthew Pickering pushed to branch wip/bootstrap-full-ci at Glasgow Haskell Compiler / GHC Commits: 704d02b6 by Matthew Pickering at 2023-07-26T12:12:53+01:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - e619ebb0 by Matthew Pickering at 2023-07-26T12:12:53+01:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - 60a392ce by Matthew Pickering at 2023-07-26T12:12:53+01:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - 10 changed files: - .gitlab-ci.yml - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d1c46a4b0bbad401c7398a122bcdb988996607b...60a392ce4545c1e50ef35d3b8e8b800cef865392 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d1c46a4b0bbad401c7398a122bcdb988996607b...60a392ce4545c1e50ef35d3b8e8b800cef865392 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 11:54:41 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Wed, 26 Jul 2023 07:54:41 -0400 Subject: [Git][ghc/ghc][wip/T20155] WIP stuff Message-ID: <64c1098160d90_2fb451b9a282732d2@gitlab.mail> sheaf pushed to branch wip/T20155 at Glasgow Haskell Compiler / GHC Commits: f807c83e by sheaf at 2023-07-26T13:54:31+02:00 WIP stuff - - - - - 13 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Make.hs - libraries/base/Control/Exception/Base.hs - libraries/ghc-prim/GHC/Prim/Panic.hs - utils/genprimopcode/Main.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -223,6 +223,7 @@ defaults -- nor `a_levpoly` and `a_reppoly`, etc. primtype TYPE +primtype CONSTRAINT section "The word size story." {Haskell98 specifies that signed integers (type 'Int') ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -1774,7 +1774,7 @@ lintIdBndr :: TopLevelFlag -> BindingSite lintIdBndr top_lvl bind_site id thing_inside = assertPpr (isId id) (ppr id) $ do { flags <- getLintFlags - ; checkL (not (lf_check_global_ids flags) || isLocalId id || isWiredIn id) + ; checkL (not (lf_check_global_ids flags) || isLocalId id) (text "Non-local Id binder" <+> ppr id) -- See Note [Checking for global Ids] ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -20,12 +20,6 @@ import GHC.Types.Demand -- All of it import GHC.Core import GHC.Core.DataCon -<<<<<<< HEAD -======= -import GHC.Types.ForeignCall ( isSafeForeignCall ) -import GHC.Types.Id -import GHC.Types.Name ( isWiredIn ) ->>>>>>> f0e0cfda35 (Rip out hacks surrounding GHC.Prim and primops) import GHC.Core.Utils import GHC.Core.TyCon import GHC.Core.Type @@ -150,7 +144,7 @@ isInterestingTopLevelFn :: Id -> Bool -- If there was a gain, that regression might be acceptable. -- Plus, we could use LetUp for thunks and share some code with local let -- bindings. -isInterestingTopLevelFn id = isLocalId id && typeArity (idType id) > 0 +isInterestingTopLevelFn id = typeArity (idType id) > 0 {- Note [Stamp out space leaks in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1021,8 +1015,7 @@ dmdTransform env var sd = -- pprTrace "dmdTransform:DictSel" (ppr var $$ ppr (idDmdSig var) $$ ppr sd) $ dmdTransformDictSelSig (idDmdSig var) sd -- Imported functions - -- N.B. wired-in names may be GlobalIds and yet not imported. - | isGlobalId var && not (isWiredIn var) + | isGlobalId var , let res = dmdTransformSig (idDmdSig var) sd = -- pprTrace "dmdTransform:import" (vcat [ppr var, ppr (idDmdSig var), ppr sd, ppr res]) res @@ -1912,7 +1905,7 @@ along in boxed form and as such dissuade the creation of reboxing workers. -} -- | How many registers does this type take after unarisation? -unariseArity :: Type -> Arity +unariseArity :: HasDebugCallStack => Type -> Arity unariseArity ty = length (typePrimRep ty) data Budgets = MkB !Arity Budgets -- An infinite list of arity budgets ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -547,8 +547,10 @@ coreToStgApp f args ticks = do -- Some primitive operator that might be implemented as a library call. -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps -- we require that primop applications be saturated. + -- SLD TODO: I think unsaturated primops are fine now? PrimOpId op _ | saturated -> StgOpApp (StgPrimOp op) args' res_ty + -- | otherwise -> pprPanic "coreToStg unsaturated PrimOp" (ppr op) -- A call to some primitive Cmm function. FCallId (CCall (CCallSpec (StaticTarget _ lbl (Just pkgId) True) ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -529,10 +529,7 @@ warnUnusedPackages us dflags mod_graph = mapMaybe (\(fs, mn) -> lookupModulePackage us (unLoc mn) fs) $ concatMap ms_imps home_mod_sum - any_import_ghc_prim = any ms_ghc_prim_import home_mod_sum - used_args = Set.fromList (map unitId loadedPackages) - `Set.union` Set.fromList [ primUnitId | any_import_ghc_prim ] resolve (u,mflag) = do -- The units which we depend on via the command line explicitly ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -110,7 +110,7 @@ import GHC.Types.CostCentre ( isCurrentCCS ) import GHC.Types.Error ( DiagnosticReason(WarningWithoutFlag) ) import GHC.Types.Id import GHC.Types.Var.Set -import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom ) +import GHC.Types.Name ( getSrcLoc, nameIsLocalOrFrom, isWiredInName ) import GHC.Types.RepType import GHC.Types.SrcLoc @@ -561,12 +561,16 @@ getStgPprOpts :: LintM StgPprOpts getStgPprOpts = LintM $ \_mod _lf _df opts _loc _scope errs -> (opts, errs) checkInScope :: Id -> LintM () -checkInScope id = LintM $ \mod _lf diag_opts _opts loc scope errs - -> if nameIsLocalOrFrom mod (idName id) && not (id `elemVarSet` scope) then +checkInScope id + = LintM $ \mod _lf diag_opts _opts loc scope errs -> + if not (isWiredInName nm) && (nameIsLocalOrFrom mod nm && not (id `elemVarSet` scope)) then + -- SLD TODO? ((), addErr diag_opts errs (hsep [ppr id, dcolon, ppr (idType id), text "is out of scope"]) loc) else ((), errs) + where + nm = idName id mkUnliftedTyMsg :: OutputablePass a => StgPprOpts -> Id -> GenStgRhs a -> SDoc mkUnliftedTyMsg opts binder rhs ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -233,7 +233,7 @@ stackSlotType i idPrimReps :: Id -> [PrimRep] idPrimReps = typePrimReps . idType -typePrimReps :: Type -> [PrimRep] +typePrimReps :: HasDebugCallStack => Type -> [PrimRep] typePrimReps = typePrimRep . unwrapType primRepSize :: PrimRep -> SlotCount ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1042,9 +1042,6 @@ tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType) -- Look up an occurrence of an Id -- Do not instantiate its type tcInferId id_name - -- TODO: Note - | Just (AnId id) <- wiredInNameTyThing_maybe id_name = do - return (HsVar noExtField (noLocA id), idType id) | id_name `hasKey` assertIdKey = do { dflags <- getDynFlags ; if gopt Opt_IgnoreAsserts dflags ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -153,7 +153,6 @@ import GHC.Types.Name import GHC.Unit.Module import GHC.Core.Class import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp) -import {-# SOURCE #-} GHC.Types.TyThing (tyThingId) import GHC.Types.ForeignCall import GHC.Data.Maybe import GHC.Types.SrcLoc @@ -307,7 +306,6 @@ mkVanillaGlobalWithInfo = mkGlobalId VanillaId -- | For an explanation of global vs. local 'Id's, see "GHC.Types.Var#globalvslocal" mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id -mkLocalId name _ _ | Just thing <- wiredInNameTyThing_maybe name = tyThingId thing mkLocalId name w ty = mkLocalIdWithInfo name w (assert (not (isCoVarType ty)) ty) vanillaIdInfo -- | Make a local CoVar @@ -585,11 +583,13 @@ hasNoBinding :: Id -> Bool -- exception to this is unboxed tuples and sums datacons, which definitely have -- no binding hasNoBinding id = case Var.idDetails id of - PrimOpId _ lev_poly -> lev_poly - - FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc - _ -> isCompulsoryUnfolding (realIdUnfolding id) + PrimOpId _ _conc_tvs -> True -- not $ isEmptyNameEnv conc_tvs + RepPolyId _conc_tvs -> True +-- RepPolyId conc_tvs -> not $ isEmptyNameEnv conc_tvs +-- SLD TODO: not enough, e.g. some lev-poly stuff with no conc tvs have no binding + FCallId _ -> True + DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc + _ -> isCompulsoryUnfolding (realIdUnfolding id) -- Note: this function must be very careful not to force -- any of the fields that aren't the 'uf_src' field of -- the 'Unfolding' of the 'Id'. This is because these fields are computed ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Types.Id.Make ( unboxedUnitExpr, -- And some particular Ids; see below for why they are wired in - wiredInIds, ghcPrimIds, + wiredInIds, ghcPrimIds, magicIds, realWorldPrimId, voidPrimId, voidArgId, nullAddrId, seqId, lazyId, lazyIdKey, @@ -35,6 +35,7 @@ module GHC.Types.Id.Make ( proxyHashId, nospecId, nospecIdName, noinlineId, noinlineIdName, + oneShotId, oneShotName, noinlineConstraintId, noinlineConstraintIdName, coerceName, leftSectionName, rightSectionName, pcRepPolyId, ===================================== libraries/base/Control/Exception/Base.hs ===================================== @@ -426,7 +426,20 @@ typeError s = throw (TypeError (unpackCStringUtf8# s)) impossibleError, impossibleConstraintError :: Addr# -> a -- These two are used for impossible case alternatives, and lack location info impossibleError s = errorWithoutStackTrace (unpackCStringUtf8# s) -impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +--impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +impossibleConstraintError = impossibleConstraintError -- SLD TODO + -- impossibleConstraintError s = errorWithoutStackTrace (unpackCStringUtf8# s) +{- +libraries\base\Control\Exception\Base.hs:429:33: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘CONSTRAINT q’ + When matching types + a0 :: * + a :: CONSTRAINT q + • In the expression: errorWithoutStackTrace (unpackCStringUtf8# s) + In an equation for ‘impossibleConstraintError’: + impossibleConstraintError s + = errorWithoutStackTrace (unpackCStringUtf8# s) +-} -- GHC's RTS calls this ===================================== libraries/ghc-prim/GHC/Prim/Panic.hs ===================================== @@ -116,4 +116,18 @@ absentConstraintError :: forall (a :: Type). Addr# -> a -- type; the type in the interface file is never looked at. -- The only purpose of this definition is to give a function to call, -- and for that purpose, delegating to absentError is fine. -absentConstraintError errmsg = absentError errmsg +absentConstraintError = absentConstraintError -- SLD TODO: errmsg = absentError errmsg +{- +libraries\ghc-prim\GHC\Prim\Panic.hs:119:32: error: [GHC-18872] + • Couldn't match kind ‘*’ with ‘Constraint’ + When matching types + a0 :: * + a :: Constraint + • In the expression: absentError errmsg + In an equation for ‘absentConstraintError’: + absentConstraintError errmsg = absentError errmsg + • Relevant bindings include + absentConstraintError :: Addr# -=> a + (bound at libraries\ghc-prim\GHC\Prim\Panic.hs:119:1) + +-} ===================================== utils/genprimopcode/Main.hs ===================================== @@ -339,7 +339,7 @@ gen_hs_source (Info defaults entries) = prim_func :: String -> Ty -> Bool -> [String] prim_func n t llvm_only - | not (opTyHasFixedRuntimeRep t) = + | tyHasNegativePosRepPoly t = [ "-- No wrapper due to RuntimeRep polymorphism:" , "-- " ++ wrapOp n ++ " :: " ++ pprTy t ] @@ -694,28 +694,30 @@ splitFunTy = go [] go acc (TyC arg res) = go (arg:acc) res go acc ty = (reverse acc, ty) --- | This should match the levity polymorphism check in --- GHC.Builtin.PrimOps.Ids.mkPrimOpId. -opTyHasFixedRuntimeRep :: Ty -> Bool -opTyHasFixedRuntimeRep ty = - let (args, res) = splitFunTy ty - in all typeHasFixedRuntimeRep args && typeHasFixedRuntimeRep res - --- | Is a type representationally monomorphic? -typeHasFixedRuntimeRep :: Ty -> Bool -typeHasFixedRuntimeRep (TyF a b) = True -typeHasFixedRuntimeRep (TyC a b) = True -typeHasFixedRuntimeRep (TyApp _ as) = True -typeHasFixedRuntimeRep (TyVar v) = tyVarHasFixedRuntimeRep v -typeHasFixedRuntimeRep (TyUTup as) = all typeHasFixedRuntimeRep as - --- | Does a tyvar have a representationally polymorphic kind? -tyVarHasFixedRuntimeRep :: TyVar -> Bool -tyVarHasFixedRuntimeRep "o" = False -tyVarHasFixedRuntimeRep "p" = False -tyVarHasFixedRuntimeRep "v" = False -tyVarHasFixedRuntimeRep "w" = False -tyVarHasFixedRuntimeRep _ = True +-- | Does the type have representation-polymorphic type variables +-- in negative position? +-- +-- Should match the logic in 'GHC.Builtin.PrimOps.Ids.computePrimOpConcTyVarsFromType', +-- i.e. this function should return 'True' precisely when 'computePrimOpConcTyVarsFromType' +-- returns a non-empty collection of concrete type variables. +tyHasNegativePosRepPoly :: Ty -> Bool +tyHasNegativePosRepPoly = rep_poly False + where + rep_poly :: Bool -- True <=> looking for rep-poly in positive position + -- False <=> '' ... '' negative position + -> Ty + -> Bool + rep_poly want_pos ty + | (args@(_:_), res) <- splitFunTy ty + = any (rep_poly $ not want_pos) args || rep_poly want_pos res + rep_poly want_pos (TyUTup as) + = any (rep_poly want_pos) as + rep_poly True (TyVar v) + = v `elem` [ "a_reppoly", "b_reppoly", "a_levpoly", "b_levpoly" ] + rep_poly _ _ + = False + -- There are no TyCons in GHC.Prim with representation-polymorphic kinds, + -- other than unboxed tuples (which use TyUTup instead of TyApp). ppTyVar :: TyVar -> PrimOpTyVarBinder ppTyVar "a" = nonDepTyVarBinder "alphaTyVarSpec" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f807c83edf5de19015bd7fb58e0f26ba16ca5e7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f807c83edf5de19015bd7fb58e0f26ba16ca5e7a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 11:59:27 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Wed, 26 Jul 2023 07:59:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/9.4.6-backports Message-ID: <64c10a9fa0e1b_2fb451b9a64273950@gitlab.mail> Zubin pushed new branch wip/9.4.6-backports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/9.4.6-backports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 12:40:16 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 26 Jul 2023 08:40:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-toolchain-fixes Message-ID: <64c11430383f8_2fb451b9adc2842e1@gitlab.mail> Matthew Pickering pushed new branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-toolchain-fixes You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 13:12:44 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 26 Jul 2023 09:12:44 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/sand-witch/DIB-INSTANCES Message-ID: <64c11bcc4f21a_2fb451b9a6431161e@gitlab.mail> Andrei Borzenkov deleted branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 13:12:55 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 26 Jul 2023 09:12:55 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/sand-witch/dib-instances Message-ID: <64c11bd7ab1eb_2fb451b9a8c311821@gitlab.mail> Andrei Borzenkov deleted branch wip/sand-witch/dib-instances at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 13:13:10 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 26 Jul 2023 09:13:10 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/sand-witch/dib-INSTANCES Message-ID: <64c11be6513f3_2fb451b9ac8312048@gitlab.mail> Andrei Borzenkov deleted branch wip/sand-witch/dib-INSTANCES at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 13:13:15 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 26 Jul 2023 09:13:15 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/sand-witch/DIB-instances Message-ID: <64c11beb1c3b5_2fb451b9a5031382f@gitlab.mail> Andrei Borzenkov deleted branch wip/sand-witch/DIB-instances at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 14:17:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 10:17:51 -0400 Subject: [Git][ghc/ghc][master] EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c12b0f93c1d_2fb451b9a8c3408b8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,7 +1026,7 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> @@ -1034,7 +1034,7 @@ export :: { OrdList (LIE GhcPs) } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> - in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } + in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } : '{-# DEPRECATED' strings '#-}' @@ -1079,7 +1079,7 @@ qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } qcname_ext :: { LocatedA ImpExpQcSpec } : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 - ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} + ; return $ sLLa $1 $> (ImpExpQcType (glAA $1) n) }} qcname :: { LocatedN RdrName } -- Variable or type constructor : qvar { $1 } -- Things which look like functions @@ -1134,7 +1134,7 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $ + ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 @@ -1211,7 +1211,7 @@ importlist1 :: { OrdList (LIE GhcPs) } import :: { OrdList (LIE GhcPs) } : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1314,7 +1314,7 @@ ty_decl :: { LTyClDecl GhcPs } where_type_family -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkFamDecl (comb5 $1 (reLoc $3) $4 $5 $6) (snd $ unLoc $6) TopLevel $3 + {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3 (snd $ unLoc $4) (snd $ unLoc $5) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4) ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) } @@ -1576,13 +1576,13 @@ opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} @@ -1592,7 +1592,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] - , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } + , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, -- which takes the form @@ -2128,7 +2128,7 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } sigktype :: { LHsSigType GhcPs } : sigtype { $1 } | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + sLLa $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2172,7 +2172,7 @@ ktype :: { LHsType GhcPs } -- A ctype is a for-all type ctype :: { LHsType GhcPs } - : forall_telescope ctype { reLocA $ sLL $1 (reLoc $>) $ + : forall_telescope ctype { sLLa $1 $> $ HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } @@ -2305,13 +2305,13 @@ atype :: { LHsType GhcPs } -- so you have to quote those.) | '[' ktype ',' comma_types1 ']' {% do { h <- addTrailingCommaA $2 (gl $3) ; acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mos $1,mcs $5] cs) NotPromoted (h:$4)) }} - | INTEGER { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) + | INTEGER { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) (il_value (getINTEGER $1)) } - | CHAR { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) + | CHAR { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) (getCHAR $1) } - | STRING { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) + | STRING { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) (getSTRING $1) } - | '_' { reLocA $ sL1 $1 $ mkAnonWildCardTy } + | '_' { sL1a $1 $ mkAnonWildCardTy } -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer. -- We let it pass the parser because the renamer can generate a better error message. | QVARID {% let qname = mkQual tvName (getQVARID $1) @@ -2470,8 +2470,8 @@ constrs1 :: { Located [LConDecl GhcPs] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff {% acsA (\cs -> let (con,details) = unLoc $4 in - (L (comb4 $1 (reLoc $2) $3 $4) (mkConDeclH98 - (EpAnn (spanAsAnchor (comb4 $1 (reLoc $2) $3 $4)) + (L (comb4 $1 $2 $3 $4) (mkConDeclH98 + (EpAnn (spanAsAnchor (comb4 $1 $2 $3 $4)) (mu AnnDarrow $3:(fst $ unLoc $1)) cs) con (snd $ unLoc $1) @@ -2763,7 +2763,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (sLLa $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2877,8 +2877,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLL $1 $> - [reLocA $ sLL $1 $> + (sLLa $1 $> + [sLLa $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2934,7 +2934,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -2951,7 +2951,7 @@ aexp1 :: { ECP } | aexp1 TIGHT_INFIX_PROJ field {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> - let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in + let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } @@ -3037,8 +3037,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3062,7 +3062,7 @@ cmdargs :: { [LHsCmdTop GhcPs] } acmd :: { LHsCmdTop GhcPs } : aexp {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) -> runPV (checkCmdBlockArguments cmd) >>= \ _ -> - return (sL1a (reLoc cmd) $ HsCmdTop noExtField cmd) } + return (sL1a cmd $ HsCmdTop noExtField cmd) } cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 @@ -3098,7 +3098,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } + sLLa $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3350,7 +3350,7 @@ ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> - return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } + return $ sLL gdpats gdpat (gdpat : unLoc gdpats) } | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to @@ -3517,7 +3517,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3562,11 +3562,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } + ; return (sLLa $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLL (head $1) (last $1) (And ($1)) } + { sLLa (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -4099,15 +4099,15 @@ comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` combineSrcSpans (getHasLoc a) (combineHasLocs b c) -comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan +comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) (getLoc d)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) (getHasLoc d)) -comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ combineSrcSpans (getHasLoc d) (getHasLoc e)) -- strict constructor version: {-# INLINE sL #-} @@ -4138,7 +4138,7 @@ sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} -sLLa :: Located a -> Located b -> c -> LocatedAn t c +sLLa :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/355e1792d814779de82c1800fde218a89fb1595c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/355e1792d814779de82c1800fde218a89fb1595c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 14:18:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 10:18:43 -0400 Subject: [Git][ghc/ghc][master] compiler: make -ddump-asm work with wasm backend NCG Message-ID: <64c12b43bb1e4_2fb451b9ab4344644@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 2 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs Changes: ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -170,7 +170,7 @@ nativeCodeGen logger ts config modLoc h us cmms ArchLoongArch64->panic "nativeCodeGen: No NCG for LoongArch64" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" - ArchWasm32 -> Wasm32.ncgWasm platform ts us modLoc h cmms + ArchWasm32 -> Wasm32.ncgWasm logger platform ts us modLoc h cmms -- | Data accumulated during code generation. Mostly about statistics, -- but also collects debug data for DWARF generation. ===================================== compiler/GHC/CmmToAsm/Wasm.hs ===================================== @@ -5,6 +5,7 @@ module GHC.CmmToAsm.Wasm (ncgWasm) where import Data.ByteString.Builder +import Data.ByteString.Lazy.Char8 (unpack) import Data.Maybe import Data.Semigroup import GHC.Cmm @@ -12,15 +13,18 @@ import GHC.CmmToAsm.Wasm.Asm import GHC.CmmToAsm.Wasm.FromCmm import GHC.CmmToAsm.Wasm.Types import GHC.Data.Stream (Stream, StreamS (..), runStream) +import GHC.Driver.DynFlags import GHC.Platform import GHC.Prelude import GHC.Settings import GHC.Types.Unique.Supply import GHC.Unit -import GHC.Utils.CliOption +import GHC.Utils.Logger +import GHC.Utils.Outputable (text) import System.IO ncgWasm :: + Logger -> Platform -> ToolSettings -> UniqSupply -> @@ -28,15 +32,24 @@ ncgWasm :: Handle -> Stream IO RawCmmGroup a -> IO a -ncgWasm platform ts us loc h cmms = do +ncgWasm logger platform ts us loc h cmms = do (r, s) <- streamCmmGroups platform us cmms - hPutBuilder h $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" - hPutBuilder h $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s + outputWasm $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" + outputWasm $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s pure r where -- See Note [WasmTailCall] do_tail_call = doTailCall ts + outputWasm builder = do + putDumpFileMaybe + logger + Opt_D_dump_asm + "Asm Code" + FormatASM + (text . unpack $ toLazyByteString builder) + hPutBuilder h builder + streamCmmGroups :: Platform -> UniqSupply -> View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9393df839707b31d87ae00d7370401c0ef3df6a0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9393df839707b31d87ae00d7370401c0ef3df6a0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 14:19:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 10:19:22 -0400 Subject: [Git][ghc/ghc][master] llvm: Restore accidentally deleted code in 0fc5cb97 Message-ID: <64c12b6aa1eea_2fb451b9aa03484d2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 1 changed file: - compiler/GHC/CmmToLlvm/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -181,6 +181,9 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease +genCall (PrimTarget MO_Touch) _ _ = + return (nilOL, []) + genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/794630364631809d728a42466dcb8cf57b11b944 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/794630364631809d728a42466dcb8cf57b11b944 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 14:20:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 10:20:00 -0400 Subject: [Git][ghc/ghc][master] configure: Default missing options to False when preparing ghc-toolchain Targets Message-ID: <64c12b907a9e3_2fb451b9a2835362f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - 1 changed file: - m4/prep_target_file.m4 Changes: ===================================== m4/prep_target_file.m4 ===================================== @@ -58,7 +58,8 @@ AC_DEFUN([PREP_BOOLEAN],[ $1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + $1Bool=False ;; esac AC_SUBST([$1Bool]) @@ -78,7 +79,8 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ Not$1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + Not$1Bool=False ;; esac AC_SUBST([Not$1Bool]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20db7e26d1dd3cab7e73ab19fd4f14dd038bbd00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20db7e26d1dd3cab7e73ab19fd4f14dd038bbd00 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 14:20:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 10:20:34 -0400 Subject: [Git][ghc/ghc][master] docs: Fix typo Message-ID: <64c12bb2af681_2fb451b9a64357039@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 1 changed file: - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -687,7 +687,7 @@ instance heads which unify with @nm tys@, they need not actually be satisfiable. @B@ themselves implement 'Eq' - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available - instance of 'Eq' + instance of 'Show' There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given). View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fac9e84e65b89116131a14981ffb7233c32bd544 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fac9e84e65b89116131a14981ffb7233c32bd544 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 14:36:34 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 26 Jul 2023 10:36:34 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] 4 commits: ghc-toolchain: Match CPP args with configure script Message-ID: <64c12f72371a3_2fb451b9aa035922f@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: 8e29fba4 by Matthew Pickering at 2023-07-26T15:02:21+01:00 ghc-toolchain: Match CPP args with configure script At the moment we need ghc-toolchain to precisely match the output as provided by the normal configure script. The normal configure script (FP_HSCPP_CMD_WITH_ARGS) branches on whether we are using clang or gcc so we match that logic exactly in ghc-toolchain. The old implementation (which checks if certain flags are supported) is better but for now we have to match to catch any potential errors in the configuration. Ticket: #23720 - - - - - ca2b4835 by Matthew Pickering at 2023-07-26T15:02:21+01:00 configure: Fix `-Wl,--no-as-needed` check The check was failing because the args supplied by $$1 were quoted which failed because then the C compiler thought they were an input file. Fixes #23720 - - - - - e7b92e83 by Matthew Pickering at 2023-07-26T15:02:21+01:00 configure: Add flag which turns ghc-toolchain check into error We want to catch these errors in CI, but first we need to a flag which turns this check into an error. - - - - - 5480008f by Matthew Pickering at 2023-07-26T15:07:51+01:00 ci: Enable --enable-strict-ghc-toolchain-check for all CI jobs This will cause any CI job to fail if we have a mismatch between what ghc-toolchain reports and what ./configure natively reports. Fixing these kinds of issues is highest priority for 9.10 release. - - - - - 6 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - configure.ac - m4/fp_link_supports_no_as_needed.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -157,6 +157,7 @@ configureArgsStr bc = unwords $ ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] ++ ["--enable-ipe-data-compression" | withZstd bc ] + ++ ["--enable-strict-ghc-toolchain-check"] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour ===================================== .gitlab/jobs.yaml ===================================== @@ -56,7 +56,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -121,7 +121,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } @@ -182,7 +182,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate" } @@ -243,7 +243,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -309,7 +309,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" @@ -371,7 +371,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -433,7 +433,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" @@ -495,7 +495,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -564,7 +564,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -629,7 +629,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -694,7 +694,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -759,7 +759,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -823,7 +823,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -887,7 +887,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -951,7 +951,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -1015,7 +1015,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", @@ -1078,7 +1078,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" @@ -1140,7 +1140,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" @@ -1202,7 +1202,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", @@ -1265,7 +1265,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" @@ -1327,7 +1327,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" @@ -1389,7 +1389,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" @@ -1451,7 +1451,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -1513,7 +1513,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -1577,7 +1577,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -1641,7 +1641,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -1706,7 +1706,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" @@ -1768,7 +1768,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" @@ -1830,7 +1830,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" @@ -1892,7 +1892,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -1956,7 +1956,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", @@ -2021,7 +2021,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -2085,7 +2085,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", @@ -2148,7 +2148,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" @@ -2210,7 +2210,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" @@ -2268,7 +2268,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2330,7 +2330,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2396,7 +2396,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2463,7 +2463,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2527,7 +2527,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2591,7 +2591,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2662,7 +2662,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2728,7 +2728,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2794,7 +2794,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2859,7 +2859,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2923,7 +2923,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2987,7 +2987,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3051,7 +3051,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3115,7 +3115,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc", "BUILD_FLAVOUR": "release+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", @@ -3179,7 +3179,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3243,7 +3243,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3309,7 +3309,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3375,7 +3375,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url --hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3441,7 +3441,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3505,7 +3505,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3569,7 +3569,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3629,7 +3629,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3692,7 +3692,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3759,7 +3759,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -3827,7 +3827,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -3891,7 +3891,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -3954,7 +3954,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4018,7 +4018,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4082,7 +4082,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4145,7 +4145,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } @@ -4207,7 +4207,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } @@ -4268,7 +4268,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" @@ -4330,7 +4330,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } @@ -4391,7 +4391,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } @@ -4452,7 +4452,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } @@ -4513,7 +4513,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } @@ -4575,7 +4575,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -4638,7 +4638,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -4701,7 +4701,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -4765,7 +4765,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } @@ -4826,7 +4826,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -4885,7 +4885,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", ===================================== configure.ac ===================================== @@ -171,6 +171,14 @@ AC_ARG_ENABLE(ghc-toolchain, ) AC_SUBST([EnableGhcToolchain]) +AC_ARG_ENABLE(strict-ghc-toolchain-check, +[AS_HELP_STRING([--enable-strict-ghc-toolchain-check], + [Whether to raise an error if the output of ghc-toolchain differs from configure])], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableStrictGhcToolchainCheck])], + [EnableStrictGhcToolchainCheck=NO] +) +AC_SUBST([EnableStrictGhcToolchainCheck]) + dnl CC_STAGE0, LD_STAGE0, AR_STAGE0 are like the "previous" variable dnl CC, LD, AR (inherited by CC_STAGE[123], etc.) dnl but instead used by stage0 for bootstrapping stage1 ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -8,9 +8,9 @@ AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) echo 'int f(int a) {return 2*a;}' > conftest.a.c echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c - $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 - $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 - if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + $CC -c -o conftest.a.o conftest.a.c 2>&1 + $CC -c -o conftest.b.o conftest.b.c 2>&1 + if "$CC" ${$1:+$$1} -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o 2>&1 then $1="$$1 -Wl,--no-as-needed" AC_MSG_RESULT([yes]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -151,6 +151,11 @@ AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ In light of it, if you've spotted this difference, please report a GHC bug at https://www.haskell.org/ghc/reportabug ]) + + case "$EnableStrictGhcToolchainCheck" in + YES) + AC_MSG_ERROR([Failing due to --enable-strict-ghc-toolchain-check]) + esac fi ]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -4,6 +4,7 @@ module GHC.Toolchain.Tools.Cpp (HsCpp(..), findHsCpp, Cpp(..), findCpp) where import Control.Monad import System.FilePath +import Data.List(isInfixOf) import GHC.Toolchain.Prelude import GHC.Toolchain.Program @@ -39,10 +40,29 @@ findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do -- Haskell source. findHsCppArgs :: Program -> M [String] findHsCppArgs cpp = withTempDir $ \dir -> do + + (_, stdout0, stderr0) <- readProgram cpp ["-x", "c", "/dev/null", "-dM", "-E"] + + if "__clang__" `isInfixOf` stdout0 || "__clang__" `isInfixOf` stderr0 + then return ["-undef", "-traditional", "-Wno-invalid-pp-token", "-Wno-unicode", "-Wno-trigraphs"] + else do + (_, stdout1, stderr1) <- readProgram cpp ["-v"] + if "gcc" `isInfixOf` stdout1 || "gcc" `isInfixOf` stderr1 + then return ["-undef", "-traditional"] + else do + logDebug "Can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly" + return [] + + +{- TODO: We want to just check which flags are accepted rather than branching on which compiler + we are using but this does not match what ./configure does (#23720) + + When we retire configure then this more precise logic can be reinstated. + let tmp_h = dir "tmp.h" -- Werror to ensure that unrecognized warnings result in an error - checkFlag flag = + let checkFlag flag = checking ("for "++flag++" support") $ callProgram cpp ["-Werror", flag, tmp_h] tryFlag flag = @@ -56,6 +76,7 @@ findHsCppArgs cpp = withTempDir $ \dir -> do , tryFlag "-Wno-unicode" , tryFlag "-Wno-trigraphs" ] + -} ----- C preprocessor ----- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb7d9791d1a4968da5c63ee063bcc9dcf7d93079...5480008f170067a9106f37b887492a8771601f80 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb7d9791d1a4968da5c63ee063bcc9dcf7d93079...5480008f170067a9106f37b887492a8771601f80 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 14:37:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 26 Jul 2023 10:37:40 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] 9 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c12fb4debb1_2fb451b9adc359741@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 6abb12e2 by Matthew Pickering at 2023-07-26T14:37:26+00:00 ghc-toolchain: Match CPP args with configure script At the moment we need ghc-toolchain to precisely match the output as provided by the normal configure script. The normal configure script (FP_HSCPP_CMD_WITH_ARGS) branches on whether we are using clang or gcc so we match that logic exactly in ghc-toolchain. The old implementation (which checks if certain flags are supported) is better but for now we have to match to catch any potential errors in the configuration. Ticket: #23720 - - - - - b4405aa6 by Matthew Pickering at 2023-07-26T14:37:26+00:00 configure: Fix `-Wl,--no-as-needed` check The check was failing because the args supplied by $$1 were quoted which failed because then the C compiler thought they were an input file. Fixes #23720 - - - - - b812748b by Matthew Pickering at 2023-07-26T14:37:26+00:00 configure: Add flag which turns ghc-toolchain check into error We want to catch these errors in CI, but first we need to a flag which turns this check into an error. - - - - - e485d938 by Matthew Pickering at 2023-07-26T14:37:26+00:00 ci: Enable --enable-strict-ghc-toolchain-check for all CI jobs This will cause any CI job to fail if we have a mismatch between what ghc-toolchain reports and what ./configure natively reports. Fixing these kinds of issues is highest priority for 9.10 release. - - - - - 12 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Parser.y - configure.ac - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - m4/fp_link_supports_no_as_needed.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -157,6 +157,7 @@ configureArgsStr bc = unwords $ ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] ++ ["--enable-ipe-data-compression" | withZstd bc ] + ++ ["--enable-strict-ghc-toolchain-check"] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour ===================================== .gitlab/jobs.yaml ===================================== @@ -56,7 +56,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -121,7 +121,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } @@ -182,7 +182,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate" } @@ -243,7 +243,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -309,7 +309,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" @@ -371,7 +371,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -433,7 +433,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" @@ -495,7 +495,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -564,7 +564,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -629,7 +629,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -694,7 +694,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -759,7 +759,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -823,7 +823,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -887,7 +887,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -951,7 +951,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -1015,7 +1015,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", @@ -1078,7 +1078,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" @@ -1140,7 +1140,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" @@ -1202,7 +1202,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", @@ -1265,7 +1265,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" @@ -1327,7 +1327,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" @@ -1389,7 +1389,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" @@ -1451,7 +1451,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -1513,7 +1513,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -1577,7 +1577,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -1641,7 +1641,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -1706,7 +1706,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" @@ -1768,7 +1768,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" @@ -1830,7 +1830,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" @@ -1892,7 +1892,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -1956,7 +1956,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", @@ -2021,7 +2021,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -2085,7 +2085,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", @@ -2148,7 +2148,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" @@ -2210,7 +2210,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" @@ -2268,7 +2268,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2330,7 +2330,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2396,7 +2396,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2463,7 +2463,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2527,7 +2527,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2591,7 +2591,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2662,7 +2662,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2728,7 +2728,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2794,7 +2794,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2859,7 +2859,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2923,7 +2923,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2987,7 +2987,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3051,7 +3051,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3115,7 +3115,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc", "BUILD_FLAVOUR": "release+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", @@ -3179,7 +3179,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3243,7 +3243,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3309,7 +3309,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3375,7 +3375,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url --hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3441,7 +3441,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3505,7 +3505,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3569,7 +3569,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3629,7 +3629,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3692,7 +3692,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3759,7 +3759,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -3827,7 +3827,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -3891,7 +3891,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -3954,7 +3954,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4018,7 +4018,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4082,7 +4082,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4145,7 +4145,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } @@ -4207,7 +4207,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } @@ -4268,7 +4268,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" @@ -4330,7 +4330,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } @@ -4391,7 +4391,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } @@ -4452,7 +4452,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } @@ -4513,7 +4513,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } @@ -4575,7 +4575,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -4638,7 +4638,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -4701,7 +4701,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -4765,7 +4765,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } @@ -4826,7 +4826,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -4885,7 +4885,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -170,7 +170,7 @@ nativeCodeGen logger ts config modLoc h us cmms ArchLoongArch64->panic "nativeCodeGen: No NCG for LoongArch64" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" - ArchWasm32 -> Wasm32.ncgWasm platform ts us modLoc h cmms + ArchWasm32 -> Wasm32.ncgWasm logger platform ts us modLoc h cmms -- | Data accumulated during code generation. Mostly about statistics, -- but also collects debug data for DWARF generation. ===================================== compiler/GHC/CmmToAsm/Wasm.hs ===================================== @@ -5,6 +5,7 @@ module GHC.CmmToAsm.Wasm (ncgWasm) where import Data.ByteString.Builder +import Data.ByteString.Lazy.Char8 (unpack) import Data.Maybe import Data.Semigroup import GHC.Cmm @@ -12,15 +13,18 @@ import GHC.CmmToAsm.Wasm.Asm import GHC.CmmToAsm.Wasm.FromCmm import GHC.CmmToAsm.Wasm.Types import GHC.Data.Stream (Stream, StreamS (..), runStream) +import GHC.Driver.DynFlags import GHC.Platform import GHC.Prelude import GHC.Settings import GHC.Types.Unique.Supply import GHC.Unit -import GHC.Utils.CliOption +import GHC.Utils.Logger +import GHC.Utils.Outputable (text) import System.IO ncgWasm :: + Logger -> Platform -> ToolSettings -> UniqSupply -> @@ -28,15 +32,24 @@ ncgWasm :: Handle -> Stream IO RawCmmGroup a -> IO a -ncgWasm platform ts us loc h cmms = do +ncgWasm logger platform ts us loc h cmms = do (r, s) <- streamCmmGroups platform us cmms - hPutBuilder h $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" - hPutBuilder h $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s + outputWasm $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" + outputWasm $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s pure r where -- See Note [WasmTailCall] do_tail_call = doTailCall ts + outputWasm builder = do + putDumpFileMaybe + logger + Opt_D_dump_asm + "Asm Code" + FormatASM + (text . unpack $ toLazyByteString builder) + hPutBuilder h builder + streamCmmGroups :: Platform -> UniqSupply -> ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -181,6 +181,9 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease +genCall (PrimTarget MO_Touch) _ _ = + return (nilOL, []) + genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,7 +1026,7 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> @@ -1034,7 +1034,7 @@ export :: { OrdList (LIE GhcPs) } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> - in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } + in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } : '{-# DEPRECATED' strings '#-}' @@ -1079,7 +1079,7 @@ qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } qcname_ext :: { LocatedA ImpExpQcSpec } : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 - ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} + ; return $ sLLa $1 $> (ImpExpQcType (glAA $1) n) }} qcname :: { LocatedN RdrName } -- Variable or type constructor : qvar { $1 } -- Things which look like functions @@ -1134,7 +1134,7 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $ + ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 @@ -1211,7 +1211,7 @@ importlist1 :: { OrdList (LIE GhcPs) } import :: { OrdList (LIE GhcPs) } : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1314,7 +1314,7 @@ ty_decl :: { LTyClDecl GhcPs } where_type_family -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkFamDecl (comb5 $1 (reLoc $3) $4 $5 $6) (snd $ unLoc $6) TopLevel $3 + {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3 (snd $ unLoc $4) (snd $ unLoc $5) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4) ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) } @@ -1576,13 +1576,13 @@ opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} @@ -1592,7 +1592,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] - , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } + , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, -- which takes the form @@ -2128,7 +2128,7 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } sigktype :: { LHsSigType GhcPs } : sigtype { $1 } | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + sLLa $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2172,7 +2172,7 @@ ktype :: { LHsType GhcPs } -- A ctype is a for-all type ctype :: { LHsType GhcPs } - : forall_telescope ctype { reLocA $ sLL $1 (reLoc $>) $ + : forall_telescope ctype { sLLa $1 $> $ HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } @@ -2305,13 +2305,13 @@ atype :: { LHsType GhcPs } -- so you have to quote those.) | '[' ktype ',' comma_types1 ']' {% do { h <- addTrailingCommaA $2 (gl $3) ; acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mos $1,mcs $5] cs) NotPromoted (h:$4)) }} - | INTEGER { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) + | INTEGER { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) (il_value (getINTEGER $1)) } - | CHAR { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) + | CHAR { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) (getCHAR $1) } - | STRING { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) + | STRING { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) (getSTRING $1) } - | '_' { reLocA $ sL1 $1 $ mkAnonWildCardTy } + | '_' { sL1a $1 $ mkAnonWildCardTy } -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer. -- We let it pass the parser because the renamer can generate a better error message. | QVARID {% let qname = mkQual tvName (getQVARID $1) @@ -2470,8 +2470,8 @@ constrs1 :: { Located [LConDecl GhcPs] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff {% acsA (\cs -> let (con,details) = unLoc $4 in - (L (comb4 $1 (reLoc $2) $3 $4) (mkConDeclH98 - (EpAnn (spanAsAnchor (comb4 $1 (reLoc $2) $3 $4)) + (L (comb4 $1 $2 $3 $4) (mkConDeclH98 + (EpAnn (spanAsAnchor (comb4 $1 $2 $3 $4)) (mu AnnDarrow $3:(fst $ unLoc $1)) cs) con (snd $ unLoc $1) @@ -2763,7 +2763,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (sLLa $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2877,8 +2877,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLL $1 $> - [reLocA $ sLL $1 $> + (sLLa $1 $> + [sLLa $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2934,7 +2934,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -2951,7 +2951,7 @@ aexp1 :: { ECP } | aexp1 TIGHT_INFIX_PROJ field {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> - let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in + let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } @@ -3037,8 +3037,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3062,7 +3062,7 @@ cmdargs :: { [LHsCmdTop GhcPs] } acmd :: { LHsCmdTop GhcPs } : aexp {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) -> runPV (checkCmdBlockArguments cmd) >>= \ _ -> - return (sL1a (reLoc cmd) $ HsCmdTop noExtField cmd) } + return (sL1a cmd $ HsCmdTop noExtField cmd) } cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 @@ -3098,7 +3098,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } + sLLa $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3350,7 +3350,7 @@ ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> - return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } + return $ sLL gdpats gdpat (gdpat : unLoc gdpats) } | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to @@ -3517,7 +3517,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3562,11 +3562,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } + ; return (sLLa $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLL (head $1) (last $1) (And ($1)) } + { sLLa (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -4099,15 +4099,15 @@ comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` combineSrcSpans (getHasLoc a) (combineHasLocs b c) -comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan +comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) (getLoc d)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) (getHasLoc d)) -comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ combineSrcSpans (getHasLoc d) (getHasLoc e)) -- strict constructor version: {-# INLINE sL #-} @@ -4138,7 +4138,7 @@ sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} -sLLa :: Located a -> Located b -> c -> LocatedAn t c +sLLa :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} ===================================== configure.ac ===================================== @@ -171,6 +171,14 @@ AC_ARG_ENABLE(ghc-toolchain, ) AC_SUBST([EnableGhcToolchain]) +AC_ARG_ENABLE(strict-ghc-toolchain-check, +[AS_HELP_STRING([--enable-strict-ghc-toolchain-check], + [Whether to raise an error if the output of ghc-toolchain differs from configure])], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableStrictGhcToolchainCheck])], + [EnableStrictGhcToolchainCheck=NO] +) +AC_SUBST([EnableStrictGhcToolchainCheck]) + dnl CC_STAGE0, LD_STAGE0, AR_STAGE0 are like the "previous" variable dnl CC, LD, AR (inherited by CC_STAGE[123], etc.) dnl but instead used by stage0 for bootstrapping stage1 ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -687,7 +687,7 @@ instance heads which unify with @nm tys@, they need not actually be satisfiable. @B@ themselves implement 'Eq' - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available - instance of 'Eq' + instance of 'Show' There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given). ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -8,9 +8,9 @@ AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) echo 'int f(int a) {return 2*a;}' > conftest.a.c echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c - $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 - $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 - if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + $CC -c -o conftest.a.o conftest.a.c 2>&1 + $CC -c -o conftest.b.o conftest.b.c 2>&1 + if "$CC" ${$1:+$$1} -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o 2>&1 then $1="$$1 -Wl,--no-as-needed" AC_MSG_RESULT([yes]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -151,6 +151,11 @@ AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ In light of it, if you've spotted this difference, please report a GHC bug at https://www.haskell.org/ghc/reportabug ]) + + case "$EnableStrictGhcToolchainCheck" in + YES) + AC_MSG_ERROR([Failing due to --enable-strict-ghc-toolchain-check]) + esac fi ]) ===================================== m4/prep_target_file.m4 ===================================== @@ -58,7 +58,8 @@ AC_DEFUN([PREP_BOOLEAN],[ $1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + $1Bool=False ;; esac AC_SUBST([$1Bool]) @@ -78,7 +79,8 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ Not$1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + Not$1Bool=False ;; esac AC_SUBST([Not$1Bool]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -4,6 +4,7 @@ module GHC.Toolchain.Tools.Cpp (HsCpp(..), findHsCpp, Cpp(..), findCpp) where import Control.Monad import System.FilePath +import Data.List(isInfixOf) import GHC.Toolchain.Prelude import GHC.Toolchain.Program @@ -39,10 +40,29 @@ findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do -- Haskell source. findHsCppArgs :: Program -> M [String] findHsCppArgs cpp = withTempDir $ \dir -> do + + (_, stdout0, stderr0) <- readProgram cpp ["-x", "c", "/dev/null", "-dM", "-E"] + + if "__clang__" `isInfixOf` stdout0 || "__clang__" `isInfixOf` stderr0 + then return ["-undef", "-traditional", "-Wno-invalid-pp-token", "-Wno-unicode", "-Wno-trigraphs"] + else do + (_, stdout1, stderr1) <- readProgram cpp ["-v"] + if "gcc" `isInfixOf` stdout1 || "gcc" `isInfixOf` stderr1 + then return ["-undef", "-traditional"] + else do + logDebug "Can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly" + return [] + + +{- TODO: We want to just check which flags are accepted rather than branching on which compiler + we are using but this does not match what ./configure does (#23720) + + When we retire configure then this more precise logic can be reinstated. + let tmp_h = dir "tmp.h" -- Werror to ensure that unrecognized warnings result in an error - checkFlag flag = + let checkFlag flag = checking ("for "++flag++" support") $ callProgram cpp ["-Werror", flag, tmp_h] tryFlag flag = @@ -56,6 +76,7 @@ findHsCppArgs cpp = withTempDir $ \dir -> do , tryFlag "-Wno-unicode" , tryFlag "-Wno-trigraphs" ] + -} ----- C preprocessor ----- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5480008f170067a9106f37b887492a8771601f80...e485d938fb36d3985571b71cd00ec09e06082cd1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5480008f170067a9106f37b887492a8771601f80...e485d938fb36d3985571b71cd00ec09e06082cd1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 15:22:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 11:22:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c13a3180d01_2fb451b9adc3696a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - d51e5999 by Bartłomiej Cieślar at 2023-07-26T11:22:09-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - 702e3410 by Arnaud Spiwack at 2023-07-26T11:22:21-04:00 Fix user-facing label in MR template - - - - - 30 changed files: - .gitlab/merge_request_templates/Default.md - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/TyThing.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-warnings.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a96933f78e99fee2e27b3cf7f129a04a3c94cdc2...702e3410358013be82c82c47237740c4a7d0b533 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a96933f78e99fee2e27b3cf7f129a04a3c94cdc2...702e3410358013be82c82c47237740c4a7d0b533 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 16:04:23 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 26 Jul 2023 12:04:23 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] 6 commits: ghc-toolchain: Match CPP args with configure script Message-ID: <64c14407ff98_2fb451b9a3c379172@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: d06a6e02 by Matthew Pickering at 2023-07-26T17:03:49+01:00 ghc-toolchain: Match CPP args with configure script At the moment we need ghc-toolchain to precisely match the output as provided by the normal configure script. The normal configure script (FP_HSCPP_CMD_WITH_ARGS) branches on whether we are using clang or gcc so we match that logic exactly in ghc-toolchain. The old implementation (which checks if certain flags are supported) is better but for now we have to match to catch any potential errors in the configuration. Ticket: #23720 - - - - - 0dc0bcf7 by Matthew Pickering at 2023-07-26T17:03:49+01:00 configure: Fix `-Wl,--no-as-needed` check The check was failing because the args supplied by $$1 were quoted which failed because then the C compiler thought they were an input file. Fixes #23720 - - - - - be861800 by Matthew Pickering at 2023-07-26T17:03:49+01:00 configure: Add flag which turns ghc-toolchain check into error We want to catch these errors in CI, but first we need to a flag which turns this check into an error. - - - - - 924a142a by Matthew Pickering at 2023-07-26T17:03:49+01:00 ci: Enable --enable-strict-ghc-toolchain-check for all CI jobs This will cause any CI job to fail if we have a mismatch between what ghc-toolchain reports and what ./configure natively reports. Fixing these kinds of issues is highest priority for 9.10 release. - - - - - 6b70f880 by Rodrigo Mesquita at 2023-07-26T17:03:49+01:00 Pass user-specified options to ghc-toolchain The current user interface to configuring target toolchains is `./configure`. In !9263 we added a new tool to configure target toolchains called `ghc-toolchain`, but the blessed way of creating these toolchains is still through configure. However, we were not passing the user-specified options given with the `./configure` invocation to the ghc-toolchain tool. This commit remedies that by storing the user options and environment variables in USER_* variables, which then get passed to GHC-toolchain. The exception to the rule is the windows bundled toolchain, which overrides the USER_* variables with whatever flags the windows bundled toolchain requires to work. We consider the bundled toolchain to be effectively the user specifying options, since the actual user delegated that configuration work. Closes #23678 - - - - - 0c2ba60d by Matthew Pickering at 2023-07-26T17:03:49+01:00 HACK: remove dependency on hadrian-ghci job - - - - - 10 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - configure.ac - m4/fp_cpp_cmd_with_args.m4 - m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_link_supports_no_as_needed.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -157,6 +157,7 @@ configureArgsStr bc = unwords $ ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] ++ ["--enable-ipe-data-compression" | withZstd bc ] + ++ ["--enable-strict-ghc-toolchain-check"] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -728,7 +729,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAllowFailure = False jobStage = "full-build" - jobNeeds = ["hadrian-ghc-in-ghci"] + jobNeeds = [] --["hadrian-ghc-in-ghci"] --------------------------------------------------------------------------- -- Job Modifiers ===================================== .gitlab/jobs.yaml ===================================== @@ -29,12 +29,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -56,7 +51,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -94,12 +89,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -121,7 +111,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } @@ -155,12 +145,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -182,7 +167,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate" } @@ -216,12 +201,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -243,7 +223,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -282,12 +262,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -309,7 +284,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" @@ -344,12 +319,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -371,7 +341,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -406,12 +376,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -433,7 +398,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" @@ -468,12 +433,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -495,7 +455,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -537,12 +497,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -564,7 +519,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -601,12 +556,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -629,7 +579,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -666,12 +616,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -694,7 +639,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -731,12 +676,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -759,7 +699,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -796,12 +736,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -823,7 +758,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -860,12 +795,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -887,7 +817,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -924,12 +854,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -951,7 +876,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -988,12 +913,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-centos7:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1015,7 +935,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", @@ -1051,12 +971,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1078,7 +993,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" @@ -1113,12 +1028,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1140,7 +1050,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" @@ -1175,12 +1085,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1202,7 +1107,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", @@ -1238,12 +1143,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1265,7 +1165,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" @@ -1300,12 +1200,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1327,7 +1222,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" @@ -1362,12 +1257,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1389,7 +1279,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" @@ -1424,12 +1314,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1451,7 +1336,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -1486,12 +1371,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1513,7 +1393,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -1550,12 +1430,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1577,7 +1452,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -1614,12 +1489,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1641,7 +1511,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -1679,12 +1549,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1706,7 +1571,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" @@ -1741,12 +1606,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1768,7 +1628,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" @@ -1803,12 +1663,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1830,7 +1685,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" @@ -1865,12 +1720,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1892,7 +1742,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -1929,12 +1779,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1956,7 +1801,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", @@ -1994,12 +1839,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2021,7 +1861,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -2058,12 +1898,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-rocky8:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2085,7 +1920,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", @@ -2121,12 +1956,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu18_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2148,7 +1978,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" @@ -2183,12 +2013,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu20_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2210,7 +2035,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" @@ -2241,12 +2066,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2268,7 +2088,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2303,12 +2123,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2330,7 +2145,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2369,12 +2184,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2396,7 +2206,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2436,12 +2246,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2463,7 +2268,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2500,12 +2305,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2527,7 +2327,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2564,12 +2364,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2591,7 +2386,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2634,12 +2429,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2662,7 +2452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2700,12 +2490,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2728,7 +2513,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2766,12 +2551,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2794,7 +2574,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2832,12 +2612,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-centos7:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2859,7 +2634,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2896,12 +2671,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2923,7 +2693,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2960,12 +2730,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2987,7 +2752,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3024,12 +2789,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3051,7 +2811,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3088,12 +2848,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3115,7 +2870,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc", "BUILD_FLAVOUR": "release+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", @@ -3152,12 +2907,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3179,7 +2929,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3216,12 +2966,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3243,7 +2988,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3282,12 +3027,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3309,7 +3049,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3348,12 +3088,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3375,7 +3110,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url --hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3414,12 +3149,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-rocky8:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3441,7 +3171,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3478,12 +3208,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu18_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3505,7 +3230,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3542,12 +3267,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu20_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3569,7 +3289,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3602,12 +3322,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3629,7 +3344,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3665,12 +3380,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3692,7 +3402,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3732,12 +3442,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3759,7 +3464,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -3800,12 +3505,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3827,7 +3527,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -3863,12 +3563,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3891,7 +3586,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -3927,12 +3622,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3954,7 +3644,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -3990,12 +3680,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4018,7 +3703,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4054,12 +3739,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4082,7 +3762,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4118,12 +3798,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4145,7 +3820,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } @@ -4179,12 +3854,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4207,7 +3877,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } @@ -4241,12 +3911,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4268,7 +3933,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" @@ -4303,12 +3968,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4330,7 +3990,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } @@ -4364,12 +4024,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", @@ -4391,7 +4046,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } @@ -4425,12 +4080,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4452,7 +4102,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } @@ -4486,12 +4136,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4513,7 +4158,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } @@ -4547,12 +4192,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4575,7 +4215,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -4611,12 +4251,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4638,7 +4273,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -4674,12 +4309,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4701,7 +4331,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -4738,12 +4368,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4765,7 +4390,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } @@ -4799,12 +4424,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4826,7 +4446,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -4858,12 +4478,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4885,7 +4500,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", ===================================== configure.ac ===================================== @@ -42,6 +42,15 @@ dnl works as expected, since we're slightly modifying how Autoconf dnl interprets build/host/target and how this interacts with $CC tests test -n "$target_alias" && ac_tool_prefix=$target_alias- +dnl ---------------------------------------------------------- +dnl ** Store USER specified environment variables to pass them on to +dnl ** ghc-toolchain (in m4/ghc-toolchain.m4) +USER_CFLAGS="$CFLAGS" +USER_LDFLAGS="$LDFLAGS" +USER_LIBS="$LIBS" +USER_CXXFLAGS="$CXXFLAGS" + + dnl ---------------------------------------------------------- dnl ** Find unixy sort and find commands, dnl ** which are needed by FP_SETUP_PROJECT_VERSION @@ -171,6 +180,14 @@ AC_ARG_ENABLE(ghc-toolchain, ) AC_SUBST([EnableGhcToolchain]) +AC_ARG_ENABLE(strict-ghc-toolchain-check, +[AS_HELP_STRING([--enable-strict-ghc-toolchain-check], + [Whether to raise an error if the output of ghc-toolchain differs from configure])], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableStrictGhcToolchainCheck])], + [EnableStrictGhcToolchainCheck=NO] +) +AC_SUBST([EnableStrictGhcToolchainCheck]) + dnl CC_STAGE0, LD_STAGE0, AR_STAGE0 are like the "previous" variable dnl CC, LD, AR (inherited by CC_STAGE[123], etc.) dnl but instead used by stage0 for bootstrapping stage1 ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -45,6 +45,7 @@ AC_ARG_WITH(cpp-flags, # Use whatever flags were manually set, ignoring previously configured # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) CPP_ARGS="$CPP_ARGS $withval" + USER_CPP_ARGS="$withval" fi ], [ ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -39,6 +39,7 @@ AC_ARG_WITH(hs-cpp-flags, AC_MSG_WARN([Request to use $withval will be ignored]) else HS_CPP_ARGS=$withval + USER_HS_CPP_ARGS=$withval fi ], [ ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -8,9 +8,9 @@ AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) echo 'int f(int a) {return 2*a;}' > conftest.a.c echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c - $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 - $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 - if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + $CC -c -o conftest.a.o conftest.a.c 2>&1 + $CC -c -o conftest.b.o conftest.b.c 2>&1 + if "$CC" ${$1:+$$1} -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o 2>&1 then $1="$$1 -Wl,--no-as-needed" AC_MSG_RESULT([yes]) ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -127,4 +127,13 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ MergeObjsCmd="" MergeObjsArgs="" AC_PATH_PROG([Genlib],[genlib]) + + + dnl We override the USER_* flags here since the user delegated + dnl configuration to the bundled windows toolchain, and these are the + dnl options required by the bundled windows toolchain. + USER_CFLAGS="$CFLAGS" + USER_CXXFLAGS="$CXXFLAGS" + USER_HS_CPP_ARGS="$HaskellCPPArgs" + USER_LDFLAGS="$CONF_GCC_LINKER_OPTS_STAGE2" ]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -93,6 +93,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], # the usual system locations, including the PATH, we are just explicit when # calling it through configure. rm -f acargs + echo "--triple=$target" >> acargs echo "--output=$1/default.target.ghc-toolchain" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs @@ -107,9 +108,20 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs + ENABLE_GHC_TOOLCHAIN_NOT_ARG([locally-executable], [$CrossCompiling]) ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) + ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) + ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + + dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. + ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$USER_CFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LDFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LIBS]) + ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$USER_CXXFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$USER_CPP_ARGS]) + ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) INVOKE_GHC_TOOLCHAIN() @@ -151,6 +163,11 @@ AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ In light of it, if you've spotted this difference, please report a GHC bug at https://www.haskell.org/ghc/reportabug ]) + + case "$EnableStrictGhcToolchainCheck" in + YES) + AC_MSG_ERROR([Failing due to --enable-strict-ghc-toolchain-check]) + esac fi ]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -37,21 +37,7 @@ findCc :: String -- ^ The llvm target to use if Cc supports --target findCc llvmTarget progOpt = checking "for C compiler" $ do -- TODO: We keep the candidate order we had in configure, but perhaps -- there's a more optimal one - ccProgram' <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] - - -- FIXME: This is a dreadful hack! - -- In reality, configure should pass these options to ghc-toolchain when - -- using the bundled windows toolchain, and ghc-toolchain should drop this around. - -- See #23678 - let ccProgram = if "mingw32" `isInfixOf` llvmTarget && takeBaseName (prgPath ccProgram') == "clang" - -- we inline the is-windows check here because we need Cc to call parseTriple - then - -- Signal that we are linking against UCRT with the _UCRT macro. This is - -- necessary on windows clang to ensure correct behavior when - -- MinGW-w64 headers are in the header include path (#22159). - ccProgram' & _prgFlags %++ "--rtlib=compiler-rt -D_UCRT" - else - ccProgram' + ccProgram <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] cc' <- ignoreUnusedArgs $ Cc {ccProgram} cc <- ccSupportsTarget llvmTarget cc' ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -4,6 +4,7 @@ module GHC.Toolchain.Tools.Cpp (HsCpp(..), findHsCpp, Cpp(..), findCpp) where import Control.Monad import System.FilePath +import Data.List(isInfixOf) import GHC.Toolchain.Prelude import GHC.Toolchain.Program @@ -38,11 +39,30 @@ findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. findHsCppArgs :: Program -> M [String] -findHsCppArgs cpp = withTempDir $ \dir -> do +findHsCppArgs cpp = do + + (_, stdout0, stderr0) <- readProgram cpp ["-x", "c", "/dev/null", "-dM", "-E"] + + if "__clang__" `isInfixOf` stdout0 || "__clang__" `isInfixOf` stderr0 + then return ["-undef", "-traditional", "-Wno-invalid-pp-token", "-Wno-unicode", "-Wno-trigraphs"] + else do + (_, stdout1, stderr1) <- readProgram cpp ["-v"] + if "gcc" `isInfixOf` stdout1 || "gcc" `isInfixOf` stderr1 + then return ["-undef", "-traditional"] + else do + logDebug "Can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly" + return [] + + +{- TODO: We want to just check which flags are accepted rather than branching on which compiler + we are using but this does not match what ./configure does (#23720) + + When we retire configure then this more precise logic can be reinstated. + withTmpDir $ \dir -> do let tmp_h = dir "tmp.h" -- Werror to ensure that unrecognized warnings result in an error - checkFlag flag = + let checkFlag flag = checking ("for "++flag++" support") $ callProgram cpp ["-Werror", flag, tmp_h] tryFlag flag = @@ -56,6 +76,7 @@ findHsCppArgs cpp = withTempDir $ \dir -> do , tryFlag "-Wno-unicode" , tryFlag "-Wno-trigraphs" ] + -} ----- C preprocessor ----- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e485d938fb36d3985571b71cd00ec09e06082cd1...0c2ba60da2991a08bdd01af9d3d267da1c9f5086 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e485d938fb36d3985571b71cd00ec09e06082cd1...0c2ba60da2991a08bdd01af9d3d267da1c9f5086 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 16:30:48 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 26 Jul 2023 12:30:48 -0400 Subject: [Git][ghc/ghc][wip/T22404] 6 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c14a389f4f7_2fb451b9a3c387648@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 9a23a293 by Simon Peyton Jones at 2023-07-26T17:30:05+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 1% CoOpt_Read(normal) ghc/alloc 766,003,076 748,985,544 -2.2% GOOD T10858(normal) ghc/alloc 120,782,748 118,735,744 -1.7% T11545(normal) ghc/alloc 79,829,332 78,722,128 -1.4% T12150(optasm) ghc/alloc 73,881,192 72,854,208 -1.4% T13056(optasm) ghc/alloc 294,495,436 290,226,600 -1.4% T13253(normal) ghc/alloc 364,663,144 361,043,432 -1.0% T13253-spj(normal) ghc/alloc 118,248,796 59,996,856 -49.3% GOOD T15164(normal) ghc/alloc 1,102,607,920 1,087,375,984 -1.4% T15304(normal) ghc/alloc 1,196,061,524 1,155,296,336 -3.4% T15630(normal) ghc/alloc 148,707,300 147,104,768 -1.1% T17516(normal) ghc/alloc 1,657,993,132 1,626,735,192 -1.9% T17836(normal) ghc/alloc 395,306,932 391,219,640 -1.0% T18140(normal) ghc/alloc 71,948,496 73,206,920 +1.7% T18282(normal) ghc/alloc 129,090,864 131,483,440 +1.9% T18698b(normal) ghc/alloc 230,313,396 233,017,416 +1.2% BAD T4801(normal) ghc/alloc 247,568,452 250,836,624 +1.3% T9233(normal) ghc/alloc 709,634,020 685,363,720 -3.4% GOOD T9630(normal) ghc/alloc 965,838,132 942,010,984 -2.5% GOOD T9675(optasm) ghc/alloc 444,583,940 429,417,416 -3.4% GOOD T9961(normal) ghc/alloc 303,041,544 307,384,192 +1.4% BAD WWRec(normal) ghc/alloc 503,706,372 495,554,224 -1.6% geo. mean -1.0% minimum -49.3% maximum +1.9% The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 Metric Increase: T18698b T9961 - - - - - 19 changed files: - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Parser.y - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Var.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - m4/prep_target_file.m4 - + testsuite/tests/simplCore/should_compile/T22404.hs - + testsuite/tests/simplCore/should_compile/T22404.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/CmmToAsm.hs ===================================== @@ -170,7 +170,7 @@ nativeCodeGen logger ts config modLoc h us cmms ArchLoongArch64->panic "nativeCodeGen: No NCG for LoongArch64" ArchUnknown -> panic "nativeCodeGen: No NCG for unknown arch" ArchJavaScript-> panic "nativeCodeGen: No NCG for JavaScript" - ArchWasm32 -> Wasm32.ncgWasm platform ts us modLoc h cmms + ArchWasm32 -> Wasm32.ncgWasm logger platform ts us modLoc h cmms -- | Data accumulated during code generation. Mostly about statistics, -- but also collects debug data for DWARF generation. ===================================== compiler/GHC/CmmToAsm/Wasm.hs ===================================== @@ -5,6 +5,7 @@ module GHC.CmmToAsm.Wasm (ncgWasm) where import Data.ByteString.Builder +import Data.ByteString.Lazy.Char8 (unpack) import Data.Maybe import Data.Semigroup import GHC.Cmm @@ -12,15 +13,18 @@ import GHC.CmmToAsm.Wasm.Asm import GHC.CmmToAsm.Wasm.FromCmm import GHC.CmmToAsm.Wasm.Types import GHC.Data.Stream (Stream, StreamS (..), runStream) +import GHC.Driver.DynFlags import GHC.Platform import GHC.Prelude import GHC.Settings import GHC.Types.Unique.Supply import GHC.Unit -import GHC.Utils.CliOption +import GHC.Utils.Logger +import GHC.Utils.Outputable (text) import System.IO ncgWasm :: + Logger -> Platform -> ToolSettings -> UniqSupply -> @@ -28,15 +32,24 @@ ncgWasm :: Handle -> Stream IO RawCmmGroup a -> IO a -ncgWasm platform ts us loc h cmms = do +ncgWasm logger platform ts us loc h cmms = do (r, s) <- streamCmmGroups platform us cmms - hPutBuilder h $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" - hPutBuilder h $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s + outputWasm $ "# " <> string7 (fromJust $ ml_hs_file loc) <> "\n\n" + outputWasm $ execWasmAsmM do_tail_call $ asmTellEverything TagI32 s pure r where -- See Note [WasmTailCall] do_tail_call = doTailCall ts + outputWasm builder = do + putDumpFileMaybe + logger + Opt_D_dump_asm + "Asm Code" + FormatASM + (text . unpack $ toLazyByteString builder) + hPutBuilder h builder + streamCmmGroups :: Platform -> UniqSupply -> ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -181,6 +181,9 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease +genCall (PrimTarget MO_Touch) _ _ = + return (nilOL, []) + genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1948,6 +1948,7 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- manifest arity for join points = -- pprTrace "finaliseArgBoxities" ( -- vcat [text "function:" <+> ppr fn + -- , text "max" <+> ppr max_wkr_args -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ (arg_dmds', set_lam_dmds arg_dmds' rhs) ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1,7 +1,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} +{-# OPTIONS_GHC -cpp -Wno-incomplete-record-updates #-} + +{-# OPTIONS_GHC -fmax-worker-args=12 #-} +-- The -fmax-worker-args=12 is there because the main functions +-- are strict in the OccEnv, and it turned out that with the default settting +-- some functions would unbox the OccEnv ad some would not, depending on how +-- many /other/ arguments the function has. Inconsistent unboxing is very +-- bad for performance, so I increased the limit to allow it to unbox +-- consistently. {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -58,9 +66,7 @@ import GHC.Utils.Misc import GHC.Builtin.Names( runRWKey ) import GHC.Unit.Module( Module ) -import Data.List (mapAccumL, mapAccumR) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE +import Data.List (mapAccumL) {- ************************************************************************ @@ -76,7 +82,7 @@ Here's the externally-callable interface: occurAnalyseExpr :: CoreExpr -> CoreExpr occurAnalyseExpr expr = expr' where - (WithUsageDetails _ expr') = occAnal initOccEnv expr + WUD _ expr' = occAnal initOccEnv expr occurAnalysePgm :: Module -- Used only in debug output -> (Id -> Bool) -- Active unfoldings @@ -94,8 +100,8 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds init_env = initOccEnv { occ_rule_act = active_rule , occ_unf_act = active_unf } - (WithUsageDetails final_usage occ_anald_binds) = go init_env binds - (WithUsageDetails _ occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel + WUD final_usage occ_anald_binds = go binds init_env + WUD _ occ_anald_glommed_binds = occAnalRecBind init_env TopLevel imp_rule_edges (flattenBinds binds) initial_uds @@ -127,14 +133,10 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds -- Not BuiltinRules; see Note [Plugin rules] , let rhs_fvs = exprFreeIds rhs `delVarSetList` bndrs ] - go :: OccEnv -> [CoreBind] -> WithUsageDetails [CoreBind] - go !_ [] - = WithUsageDetails initial_uds [] - go env (bind:binds) - = WithUsageDetails final_usage (bind' ++ binds') - where - (WithUsageDetails bs_usage binds') = go env binds - (WithUsageDetails final_usage bind') = occAnalBind env TopLevel imp_rule_edges bind bs_usage + go :: [CoreBind] -> OccEnv -> WithUsageDetails [CoreBind] + go [] _ = WUD initial_uds [] + go (bind:binds) env = occAnalBind env TopLevel + imp_rule_edges bind (go binds) (++) {- ********************************************************************* * * @@ -599,7 +601,144 @@ This showed up when compiling Control.Concurrent.Chan.getChanContents. Hence the transitive rule_fv_env stuff described in Note [Rules and loop breakers]. ------------------------------------------------------------- +Note [Occurrence analysis for join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider these two somewhat artificial programs (#22404) + + Program (P1) Program (P2) + ------------------------------ ------------------------------------- + let v = in let v = in + join j = case v of (a,b) -> a + in case x of in case x of + A -> case v of (a,b) -> a A -> j + B -> case v of (a,b) -> a B -> j + C -> case v of (a,b) -> b C -> case v of (a,b) -> b + D -> [] D -> [] + +In (P1), `v` gets allocated, as a thunk, every time this code is executed. But +notice that `v` occurs at most once in any case branch; the occurrence analyser +spots this and returns a OneOcc{ occ_n_br = 3 } for `v`. Then the code in +GHC.Core.Opt.Simplify.Utils.postInlineUnconditionally inlines `v` at its three +use sites, and discards the let-binding. That way, we avoid allocating `v` in +the A,B,C branches (though we still compute it of course), and branch D +doesn't involve at all. This sometimes makes a Really Big +Difference. + +In (P2) we have shared the common RHS of A, B, in a join point `j`. We would +like to inline `v` in just the same way as in (P1). But the usual strategy +for let bindings is conservative and uses `andUDs` to combine usage from j's +RHS to its body; as if `j` was called on every code path (once, albeit). In +the case of (P2), we'll get ManyOccs for `v`. Important optimisation lost! + +Solving this problem makes the Simplifier less fragile. For example, +the Simplifier might inline `j`, and convert (P2) into (P1)... or it might +not, depending in a perhaps-fragile way on the size of the join point. +I was motivated to implement this feature of the occurrence analyser +when trying to make optimisation join points simpler and more robust +(see e.g. #23627). + +The occurrence analyser therefore has clever code that behaves just as +if you inlined `j` at all its call sites. Here is a tricky variant +to keep in mind: + + Program (P3) + ------------------------------- + join j = case v of (a,b) -> a + in case f v of + A -> j + B -> j + C -> [] + +If you mentally inline `j` you'll see that `v` is used twice on the path +through A, so it should have ManyOcc. Bear this case in mind! + +* We treat /non-recursive/ join points specially. Recursive join points are + treated like any other letrec, as before. Moreover, we only give this special + treatment to /pre-existing/ non-recursive join points, not the ones that we + discover for the first time in this sweep of the occurrence analyser. + +* In occ_env, the new (occ_join_points :: IdEnv OccInfoEnv) maps + each in-scope non-recursive join point, such as `j` above, to + a "zeroed form" of its RHS's usage details. The "zeroed form" + * deletes ManyOccs + * maps a OneOcc to OneOcc{ occ_n_br = 0 } + In our example, occ_join_points will be extended with + [j :-> [v :-> OneOcc{occ_n_br=0}]] + See addJoinPoint. + +* At an occurence of a join point, we do everything as normal, but add in the + UsageDetails from the occ_join_points. See mkOneOcc. + +* Crucially, at the NonRec binding of the join point, in `occAnalBind`, we use + `orUDs`, not `andUDs` to combine the usage from the RHS with the usage from + the body. + +Here are the consequences + +* Because of the perhaps-surprising OneOcc{occ_n_br=0} idea of the zeroed + form, the occ_n_br field of a OneOcc binder still counts the number of + /actual lexical occurrences/ of the variable. In Program P2, for example, + `v` will end up with OneOcc{occ_n_br=2}, not occ_n_br=3. + There are two lexical occurrences of `v`! + (NB: `orUDs` adds occ_n_br together, so occ_n_br=1 is impossible, too.) + +* In the tricky (P3) we'll get an `andUDs` of + * OneOcc{occ_n_br=0} from the occurrences of `j`) + * OneOcc{occ_n_br=1} from the (f v) + These are `andUDs` together in `addOccInfo`, and hence + `v` gets ManyOccs, just as it should. Clever! + +There are a couple of tricky wrinkles + +(W1) Consider this example which shadows `j`: + join j = rhs in + in case x of { K j -> ..j..; ... } + Clearly when we come to the pattern `K j` we must drop the `j` + entry in occ_join_points. + + This is done by `drop_shadowed_joins` in `addInScope`. + +(W2) Consider this example which shadows `v`: + join j = ...v... + in case x of { K v -> ..j..; ... } + + We can't make j's occurrences in the K alternative give rise to an + occurrence of `v` (via occ_join_points), because it'll just be deleted by + the `K v` pattern. Yikes. This is rare because shadowing is rare, but + it definitely can happen. Solution: when bringing `v` into scope at + the `K v` pattern, chuck out of occ_join_points any elements whose + UsageDetails mentions `v`. Instead, just `andUDs` all that usage in + right here. + + This requires work in two places. + * In `preprocess_env`, we detect if the newly-bound variables intersect + the free vars of occ_join_points. (These free vars are conveniently + simply the domain of the OccInfoEnv for that join point.) If so, + we zap the entire occ_join_points. + * In `postprcess_uds`, we add the chucked-out join points to the + returned UsageDetails, with `andUDs`. + +(W3) Consider this example, which shadows `j`, but this time in an argument + join j = rhs + in f (case x of { K j -> ...; ... }) + We can zap the entire occ_join_points when looking at the argument, + because `j` can't posibly occur -- it's a join point! And the smaller + occ_join_points is, the better. Smaller to look up in mkOneOcc, and + more important, less looking-up when checking (W2). + + This is done in setNonTailCtxt. It's important /not/ to do this for + join-point RHS's because of course `j` can occur there! + + NB: this is just about efficiency: it is always safe /not/ to zap the + occ_join_points. + +(W4) What if the join point binding has a stable unfolding, or RULES? + They are just alternative right-hand sides, and at each call site we + will use only one of them. So again, we can use `orUDs` to combine + usage info from all these alternatives RHSs. + +Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3). + Note [Finding join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~ It's the occurrence analyser's job to find bindings that we can turn into join @@ -817,78 +956,134 @@ of both functions, serving as a specification: Non-recursive case: 'adjustNonRecRhs' -} -data WithUsageDetails a = WithUsageDetails !UsageDetails !a - -data WithTailUsageDetails a = WithTailUsageDetails !TailUsageDetails !a - ------------------------------------------------------------------ -- occAnalBind ------------------------------------------------------------------ -occAnalBind :: OccEnv -- The incoming OccEnv - -> TopLevelFlag - -> ImpRuleEdges - -> CoreBind - -> UsageDetails -- Usage details of scope - -> WithUsageDetails [CoreBind] -- Of the whole let(rec) - -occAnalBind !env lvl top_env (NonRec binder rhs) body_usage - = occAnalNonRecBind env lvl top_env binder rhs body_usage -occAnalBind env lvl top_env (Rec pairs) body_usage - = occAnalRecBind env lvl top_env pairs body_usage - ------------------ -occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr - -> UsageDetails -> WithUsageDetails [CoreBind] -occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage +occAnalBind + :: OccEnv + -> TopLevelFlag + -> ImpRuleEdges + -> CoreBind + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> ([CoreBind] -> r -> r) -- How to combine the scope with new binds + -> WithUsageDetails r -- Of the whole let(rec) + +occAnalBind env lvl ire (Rec pairs) thing_inside combine + = addInScopeList env (map fst pairs) $ \env -> + let WUD body_uds body' = thing_inside env + WUD bind_uds binds' = occAnalRecBind env lvl ire pairs body_uds + in WUD bind_uds (combine binds' body') + +occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine | isTyVar bndr -- A type let; we don't gather usage info - = WithUsageDetails body_usage [NonRec bndr rhs] + = let !(WUD body_uds res) = addInScopeOne env bndr thing_inside + in WUD body_uds (combine [NonRec bndr rhs] res) + + -- /Existing/ non-recursive join points + -- See Note [Occurrence analysis for join points] + | mb_join@(Just {}) <- isJoinId_maybe bndr + = -- Analyse the RHS and /then/ the body + let -- Analyse the rhs first, generating rhs_uds + !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs + rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of + -- Note [Occurrence analysis for join points] + + -- Now analyse the body, adding the join point + -- into the environment with addJoinPoint + !(WUD body_uds (occ, body)) = occAnalNonRecBody env bndr' $ \env -> + thing_inside (addJoinPoint env bndr' rhs_uds) + in + if isDeadOcc occ -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` + (combine [NonRec (tagNonRecBinder lvl occ bndr') rhs'] + body) + + -- The normal case, including newly-discovered join points + -- Analyse the body and /then/ the RHS + | WUD body_uds (occ,body) <- occAnalNonRecBody env bndr thing_inside + = if isDeadOcc occ -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else let + -- Get the join info from the *new* decision; NB: bndr is not already a JoinId + -- See Note [Join points and unfoldings/rules] + -- => join arity O of Note [Join arity prediction based on joinRhsArity] + tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join = case tailCallInfo occ of + AlwaysTailCalled arity -> Just arity + _ -> Nothing + + !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs + in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs` + (combine [NonRec final_bndr rhs'] body) - | not (bndr `usedIn` body_usage) - = WithUsageDetails body_usage [] -- See Note [Dead code] +----------------- +occAnalNonRecBody :: OccEnv -> Id + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> (WithUsageDetails (OccInfo, r)) +occAnalNonRecBody env bndr thing_inside + = addInScopeOne env bndr $ \env -> + let !(WUD inner_uds res) = thing_inside env + !occ = lookupLetOccInfo inner_uds bndr + in WUD inner_uds (occ, res) - | otherwise -- It's mentioned in the body - = WithUsageDetails (body_usage' `andUDs` rhs_usage) [NonRec final_bndr final_rhs] +----------------- +occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity + -> Id -> CoreExpr + -> ([UsageDetails], Id, CoreExpr) +occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs + | null rules, null imp_rule_infos + = -- Fast path for common case of no rules. This is only worth + -- 0.1% perf on average, but it's also only a line or two of code + ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs ) + | otherwise + = (adj_rhs_uds : adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs ) where - WithUsageDetails body_usage' tagged_bndr = tagNonRecBinder lvl body_usage bndr - - -- Get the join info from the *new* decision - -- See Note [Join points and unfoldings/rules] - -- => join arity O of Note [Join arity prediction based on joinRhsArity] - mb_join_arity = willBeJoinId_maybe tagged_bndr - is_join_point = isJust mb_join_arity + is_join_point = isJust mb_join --------- Right hand side --------- - env1 | is_join_point = env -- See Note [Join point RHSs] - | certainly_inline = env -- See Note [Cascading inlines] - | otherwise = rhsCtxt env + -- For join points, set occ_encl to OccVanilla, via setTailCtxt. If we have + -- join j = Just (f x) in ... + -- we do not want to float the (f x) to + -- let y = f x in join j = Just y in ... + -- That's that OccRhs would do; but there's no point because + -- j will never be scrutinised. + env1 | is_join_point = setTailCtxt env + | otherwise = setNonTailCtxt rhs_ctxt env -- Zap occ_join_points + rhs_ctxt = mkNonRecRhsCtxt bndr unf -- See Note [Sources of one-shot information] - rhs_env = env1 { occ_one_shots = argOneShots dmd } + rhs_env = addOneShotsFromDmd bndr env1 -- See Note [Join arity prediction based on joinRhsArity] -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS - WithUsageDetails adj_rhs_uds final_rhs - = adjustNonRecRhs mb_join_arity $ occAnalLamTail rhs_env rhs - rhs_usage = adj_rhs_uds `andUDs` adj_unf_uds `andUDs` adj_rule_uds - final_bndr = tagged_bndr `setIdSpecialisation` mkRuleInfo rules' - `setIdUnfolding` unf2 + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ + occAnalLamTail rhs_env rhs + final_bndr_with_rules + | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdSpecialisation` mkRuleInfo rules' + `setIdUnfolding` unf2 + final_bndr_no_rules + | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdUnfolding` unf2 --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] - unf | isId bndr = idUnfolding bndr - | otherwise = NoUnfolding - WithTailUsageDetails unf_uds unf1 = occAnalUnfolding rhs_env unf - unf2 = markNonRecUnfoldingOneShots mb_join_arity unf1 - adj_unf_uds = adjustTailArity mb_join_arity unf_uds + unf = idUnfolding bndr + WTUD unf_tuds unf1 = occAnalUnfolding rhs_env unf + unf2 = markNonRecUnfoldingOneShots mb_join unf1 + adj_unf_uds = adjustTailArity mb_join unf_tuds --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] -- and Note [Join points and unfoldings/rules] - rules_w_uds = occAnalRules rhs_env bndr + rules = idCoreRules bndr + rules_w_uds = map (occAnalRule rhs_env) rules rules' = map fstOf3 rules_w_uds - imp_rule_uds = impRulesScopeUsage (lookupImpRules imp_rule_edges bndr) + imp_rule_infos = lookupImpRules imp_rule_edges bndr + imp_rule_uds = [impRulesScopeUsage imp_rule_infos] -- imp_rule_uds: consider -- h = ... -- g = ... @@ -897,21 +1092,27 @@ occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage -- that g is (since the RULE might turn g into h), so -- we make g mention h. - adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds - add_rule_uds (_, l, r) uds - = l `andUDs` adjustTailArity mb_join_arity r `andUDs` uds + adj_rule_uds :: [UsageDetails] + adj_rule_uds = imp_rule_uds ++ + [ l `andUDs` adjustTailArity mb_join r + | (_,l,r) <- rules_w_uds ] - ---------- - occ = idOccInfo tagged_bndr +mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl +-- Precondition: Id is not a join point +mkNonRecRhsCtxt bndr unf + | certainly_inline = OccVanilla -- See Note [Cascading inlines] + | otherwise = OccRhs + where certainly_inline -- See Note [Cascading inlines] - = case occ of + = -- mkNonRecRhsCtxt is only used for non-join points, so occAnalBind + -- has set the OccInfo for this binder before calling occAnalNonRecRhs + case idOccInfo bndr of OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 } -> active && not_stable _ -> False - dmd = idDemandInfo bndr active = isAlwaysActive (idInlineActivation bndr) - not_stable = not (isStableUnfolding (idUnfolding bndr)) + not_stable = not (isStableUnfolding unf) ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] @@ -921,38 +1122,17 @@ occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] -- * compute strongly-connected components -- * feed those components to occAnalRec -- See Note [Recursive bindings: the grand plan] -occAnalRecBind !env lvl imp_rule_edges pairs body_usage - = foldr (occAnalRec rhs_env lvl) (WithUsageDetails body_usage []) sccs +occAnalRecBind !rhs_env lvl imp_rule_edges pairs body_usage + = foldr (occAnalRec rhs_env lvl) (WUD body_usage []) sccs where sccs :: [SCC NodeDetails] - sccs = {-# SCC "occAnalBind.scc" #-} - stronglyConnCompFromEdgedVerticesUniq nodes + sccs = stronglyConnCompFromEdgedVerticesUniq nodes nodes :: [LetrecNode] - nodes = {-# SCC "occAnalBind.assoc" #-} - map (makeNode rhs_env imp_rule_edges bndr_set) pairs + nodes = map (makeNode rhs_env imp_rule_edges bndr_set) pairs bndrs = map fst pairs bndr_set = mkVarSet bndrs - rhs_env = env `addInScope` bndrs - -adjustNonRecRhs :: Maybe JoinArity -> WithTailUsageDetails CoreExpr -> WithUsageDetails CoreExpr --- ^ This function concentrates shared logic between occAnalNonRecBind and the --- AcyclicSCC case of occAnalRec. --- * It applies 'markNonRecJoinOneShots' to the RHS --- * and returns the adjusted rhs UsageDetails combined with the body usage -adjustNonRecRhs mb_join_arity (WithTailUsageDetails rhs_tuds rhs) - = WithUsageDetails rhs_uds' rhs' - where - --------- Marking (non-rec) join binders one-shot --------- - !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs - | otherwise = rhs - --------- Adjusting right-hand side usage --------- - rhs_uds' = adjustTailUsage mb_join_arity rhs' rhs_tuds - -bindersOfSCC :: SCC NodeDetails -> [Var] -bindersOfSCC (AcyclicSCC nd) = [nd_bndr nd] -bindersOfSCC (CyclicSCC ds) = map nd_bndr ds ----------------------------- occAnalRec :: OccEnv -> TopLevelFlag @@ -960,39 +1140,47 @@ occAnalRec :: OccEnv -> TopLevelFlag -> WithUsageDetails [CoreBind] -> WithUsageDetails [CoreBind] --- Check for Note [Dead code] --- NB: Only look at body_uds, ignoring uses in the SCC -occAnalRec !_ _ scc (WithUsageDetails body_uds binds) - | not (any (`usedIn` body_uds) (bindersOfSCC scc)) - = WithUsageDetails body_uds binds - -- The NonRec case is just like a Let (NonRec ...) above occAnalRec !_ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds })) - (WithUsageDetails body_uds binds) - = WithUsageDetails (body_uds' `andUDs` rhs_uds') (NonRec bndr' rhs' : binds) + (WUD body_uds binds) + | isDeadOcc occ -- Check for dead code: see Note [Dead code] + = WUD body_uds binds + | otherwise + = let tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join_arity = willBeJoinId_maybe tagged_bndr + !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join_arity wtuds + !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) + !bndr' = tagged_bndr `setIdUnfolding` unf' + in WUD (body_uds `andUDs` rhs_uds') + (NonRec bndr' rhs' : binds) where - WithUsageDetails body_uds' tagged_bndr = tagNonRecBinder lvl body_uds bndr - mb_join_arity = willBeJoinId_maybe tagged_bndr - WithUsageDetails rhs_uds' rhs' = adjustNonRecRhs mb_join_arity wtuds - !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) - !bndr' = tagged_bndr `setIdUnfolding` unf' + occ = lookupLetOccInfo body_uds bndr -- The Rec case is the interesting one -- See Note [Recursive bindings: the grand plan] -- See Note [Loop breaking] -occAnalRec env lvl (CyclicSCC details_s) (WithUsageDetails body_uds binds) - = -- pprTrace "occAnalRec" (ppr loop_breaker_nodes) - WithUsageDetails final_uds (Rec pairs : binds) +occAnalRec env lvl (CyclicSCC details_s) (WUD body_uds binds) + | not (any needed details_s) + = -- Check for dead code: see Note [Dead code] + -- NB: Only look at body_uds, ignoring uses in the SCC + WUD body_uds binds + + | otherwise + = WUD final_uds (Rec pairs : binds) where all_simple = all nd_simple details_s + needed :: NodeDetails -> Bool + needed (ND { nd_bndr = bndr }) = isExportedId bndr || bndr `elemVarEnv` body_env + body_env = ud_env body_uds + ------------------------------ -- Make the nodes for the loop-breaker analysis -- See Note [Choosing loop breakers] for loop_breaker_nodes final_uds :: UsageDetails loop_breaker_nodes :: [LoopBreakerNode] - (WithUsageDetails final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s + WUD final_uds loop_breaker_nodes = mkLoopBreakerNodes env lvl body_uds details_s ------------------------------ weak_fvs :: VarSet @@ -1481,7 +1669,8 @@ instance Outputable NodeDetails where , text "simple =" <+> ppr (nd_simple nd) , text "active_rule_fvs =" <+> ppr (nd_active_rule_fvs nd) ]) - where WithTailUsageDetails uds _ = nd_rhs nd + where + WTUD uds _ = nd_rhs nd -- | Digraph with simplified and completely occurrence analysed -- 'SimpleNodeDetails', retaining just the info we need for breaking loops. @@ -1517,7 +1706,8 @@ makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> LetrecNode -- See Note [Recursive bindings: the grand plan] makeNode !env imp_rule_edges bndr_set (bndr, rhs) - = DigraphNode { node_payload = details + = -- pprTrace "makeNode" (ppr bndr <+> ppr (sizeVarSet bndr_set)) $ + DigraphNode { node_payload = details , node_key = varUnique bndr , node_dependencies = nonDetKeysUniqSet scope_fvs } -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR @@ -1525,20 +1715,20 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. where details = ND { nd_bndr = bndr' - , nd_rhs = WithTailUsageDetails scope_uds rhs' + , nd_rhs = WTUD (TUD rhs_ja unadj_scope_uds) rhs' , nd_inl = inl_fvs , nd_simple = null rules_w_uds && null imp_rule_info , nd_weak_fvs = weak_fvs , nd_active_rule_fvs = active_rule_fvs } - bndr' = bndr `setIdUnfolding` unf' - `setIdSpecialisation` mkRuleInfo rules' + bndr' | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' -- NB: Both adj_unf_uds and adj_rule_uds have been adjusted to match the -- JoinArity rhs_ja of unadj_rhs_uds. unadj_inl_uds = unadj_rhs_uds `andUDs` adj_unf_uds unadj_scope_uds = unadj_inl_uds `andUDs` adj_rule_uds - scope_uds = TUD rhs_ja unadj_scope_uds -- Note [Rules are extra RHSs] -- Note [Rule dependency info] scope_fvs = udFreeVars bndr_set unadj_scope_uds @@ -1547,7 +1737,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) inl_fvs = udFreeVars bndr_set unadj_inl_uds -- inl_fvs: vars that would become free if the function was inlined. - -- We conservatively approximate that by thefree vars from the RHS + -- We conservatively approximate that by the free vars from the RHS -- and the unfolding together. -- See Note [inl_fvs] @@ -1566,15 +1756,18 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- Instead, do the occAnalLamTail call here and postpone adjustTailUsage -- until occAnalRec. In effect, we pretend that the RHS becomes a -- non-recursive join point and fix up later with adjustTailUsage. - rhs_env = rhsCtxt env - WithTailUsageDetails (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs - -- corresponding call to adjustTailUsage in occAnalRec and tagRecBinders + rhs_env | isJoinId bndr = setTailCtxt env + | otherwise = setNonTailCtxt OccRhs env + -- If bndr isn't an /existing/ join point, it's safe to zap the + -- occ_join_points, because they can't occur in RHS. + WTUD (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs + -- The corresponding call to adjustTailUsage is in occAnalRec and tagRecBinders --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness -- here because that is what we are setting! - WithTailUsageDetails unf_tuds unf' = occAnalUnfolding rhs_env unf + WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf adj_unf_uds = adjustTailArity (Just rhs_ja) unf_tuds -- `rhs_ja` is `joinRhsArity rhs` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] @@ -1590,8 +1783,9 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- `rhs_ja` is `joinRhsArity rhs'` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_tuds) - | (r,l,rhs_tuds) <- occAnalRules rhs_env bndr ] + rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_wuds) + | rule <- idCoreRules bndr + , let (r,l,rhs_wuds) = occAnalRule rhs_env rule ] rules' = map fstOf3 rules_w_uds adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds @@ -1624,11 +1818,12 @@ mkLoopBreakerNodes :: OccEnv -> TopLevelFlag -- d) adjust each RHS's usage details according to -- the binder's (new) shotness and join-point-hood mkLoopBreakerNodes !env lvl body_uds details_s - = WithUsageDetails final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') + = WUD final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') where - WithUsageDetails final_uds bndrs' = tagRecBinders lvl body_uds details_s + WUD final_uds bndrs' = tagRecBinders lvl body_uds details_s - mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs }) new_bndr + mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs + , nd_rhs = WTUD _ rhs }) new_bndr = DigraphNode { node_payload = simple_nd , node_key = varUnique old_bndr , node_dependencies = nonDetKeysUniqSet lb_deps } @@ -1637,7 +1832,6 @@ mkLoopBreakerNodes !env lvl body_uds details_s -- in nondeterministic order as explained in -- Note [Deterministic SCC] in GHC.Data.Graph.Directed. where - WithTailUsageDetails _ rhs = nd_rhs nd simple_nd = SND { snd_bndr = new_bndr, snd_rhs = rhs, snd_score = score } score = nodeScore env new_bndr lb_deps nd lb_deps = extendFvs_ rule_fv_env inl_fvs @@ -1677,7 +1871,7 @@ nodeScore :: OccEnv -> NodeDetails -> NodeScore nodeScore !env new_bndr lb_deps - (ND { nd_bndr = old_bndr, nd_rhs = WithTailUsageDetails _ bind_rhs }) + (ND { nd_bndr = old_bndr, nd_rhs = WTUD _ bind_rhs }) | not (isId old_bndr) -- A type or coercion variable is never a loop breaker = (100, 0, False) @@ -1974,36 +2168,47 @@ occAnalLamTail :: OccEnv -> CoreExpr -> WithTailUsageDetails CoreExpr -- In effect, the analysis result is for a non-recursive join point with -- manifest arity and adjustTailUsage does the fixup. -- See Note [Adjusting right-hand sides] -occAnalLamTail env (Lam bndr expr) - | isTyVar bndr - , let env1 = addOneInScope env bndr - , WithTailUsageDetails (TUD ja usage) expr' <- occAnalLamTail env1 expr - = WithTailUsageDetails (TUD (ja+1) usage) (Lam bndr expr') - -- Important: Keep the 'env' unchanged so that with a RHS like - -- \(@ x) -> K @x (f @x) - -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain - -- from inlining f. See the beginning of Note [Cascading inlines]. - - | otherwise -- So 'bndr' is an Id - = let (env_one_shots', bndr1) - = case occ_one_shots env of - [] -> ([], bndr) - (os : oss) -> (oss, updOneShotInfo bndr os) - -- Use updOneShotInfo, not setOneShotInfo, as pre-existing - -- one-shot info might be better than what we can infer, e.g. - -- due to explicit use of the magic 'oneShot' function. - -- See Note [The oneShot function] - - env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - env2 = addOneInScope env1 bndr - WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env2 expr - (usage', bndr2) = tagLamBinder usage bndr1 - in WithTailUsageDetails (TUD (ja+1) usage') (Lam bndr2 expr') +occAnalLamTail env expr + = let !(WUD usage expr') = occ_anal_lam_tail env expr + in WTUD (TUD (joinRhsArity expr) usage) expr' + +occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr +-- Does not markInsidLam etc for the outmost batch of lambdas +occ_anal_lam_tail env expr@(Lam {}) + = go env emptyVarSet [] expr + where + go :: OccEnv -> IdSet -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env id_set rev_bndrs (Lam bndr body) + | isTyVar bndr + = go env id_set (bndr:rev_bndrs) body + -- Important: Do not modify occ_encl, so that with a RHS like + -- \(@ x) -> K @x (f @x) + -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain + -- from inlining f. See the beginning of Note [Cascading inlines]. + + | otherwise + = let (env_one_shots', bndr') + = case occ_one_shots env of + [] -> ([], bndr) + (os : oss) -> (oss, updOneShotInfo bndr os) + -- Use updOneShotInfo, not setOneShotInfo, as pre-existing + -- one-shot info might be better than what we can infer, e.g. + -- due to explicit use of the magic 'oneShot' function. + -- See Note [The oneShot function] + env' = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } + in go env' (id_set `extendVarSet` bndr') (bndr':rev_bndrs) body + + go env id_set rev_bndrs body + = addInScope env id_set $ \env -> + let !(WUD usage body') = occ_anal_lam_tail env body + wrap_lam body bndr = Lam (tagLamBinder usage bndr) body + in WUD (usage `addLamCoVarOccs` rev_bndrs) + (foldl' wrap_lam body' rev_bndrs) -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] -occAnalLamTail env (Cast expr co) - = let WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env expr +occ_anal_lam_tail env (Cast expr co) + = let WUD usage expr' = occ_anal_lam_tail env expr -- usage1: see Note [Gather occurrences of coercion variables] usage1 = addManyOccs usage (coVarsOfCo co) @@ -2019,10 +2224,10 @@ occAnalLamTail env (Cast expr co) -- GHC.Core.Lint: Note Note [Join points and casts] usage3 = markAllNonTail usage2 - in WithTailUsageDetails (TUD ja usage3) (Cast expr' co) + in WUD usage3 (Cast expr' co) -occAnalLamTail env expr = case occAnal env expr of - WithUsageDetails usage expr' -> WithTailUsageDetails (TUD 0 usage) expr' +occ_anal_lam_tail env expr -- Not Lam, not Cast + = occAnal env expr {- Note [Occ-anal and cast worker/wrapper] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2063,13 +2268,12 @@ occAnalUnfolding !env unf unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) | isStableSource src -> let - WithTailUsageDetails (TUD rhs_ja usage) rhs' = occAnalLamTail env rhs - - unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] - | otherwise = unf { uf_tmpl = rhs' } - in WithTailUsageDetails (TUD rhs_ja (markAllMany usage)) unf' + WTUD (TUD rhs_ja uds) rhs' = occAnalLamTail env rhs + unf' = unf { uf_tmpl = rhs' } + in WTUD (TUD rhs_ja (markAllMany uds)) unf' -- markAllMany: see Note [Occurrences in stable unfoldings] - | otherwise -> WithTailUsageDetails (TUD 0 emptyDetails) unf + + | otherwise -> WTUD (TUD 0 emptyDetails) unf -- For non-Stable unfoldings we leave them undisturbed, but -- don't count their usage because the simplifier will discard them. -- We leave them undisturbed because nodeScore uses their size info @@ -2078,43 +2282,36 @@ occAnalUnfolding !env unf -- scope remain in scope; there is no cloning etc. unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) - -> WithTailUsageDetails (TUD 0 final_usage) (unf { df_args = args' }) - where - env' = env `addInScope` bndrs - (WithUsageDetails usage args') = occAnalList env' args - final_usage = usage `addLamCoVarOccs` bndrs `delDetailsList` bndrs - -- delDetailsList; no need to use tagLamBinders because we + -> let WUD uds args' = addInScopeList env bndrs $ \ env -> + occAnalList env args + in WTUD (TUD 0 uds) (unf { df_args = args' }) + -- No need to use tagLamBinders because we -- never inline DFuns so the occ-info on binders doesn't matter - unf -> WithTailUsageDetails (TUD 0 emptyDetails) unf + unf -> WTUD (TUD 0 emptyDetails) unf -occAnalRules :: OccEnv - -> Id -- Get rules from here - -> [(CoreRule, -- Each (non-built-in) rule - UsageDetails, -- Usage details for LHS - TailUsageDetails)] -- Usage details for RHS -occAnalRules !env bndr - = map occ_anal_rule (idCoreRules bndr) +occAnalRule :: OccEnv + -> CoreRule + -> (CoreRule, -- Each (non-built-in) rule + UsageDetails, -- Usage details for LHS + TailUsageDetails) -- Usage details for RHS +occAnalRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) + = (rule', lhs_uds', TUD rhs_ja rhs_uds') where - occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) - = (rule', lhs_uds', TUD rhs_ja rhs_uds') - where - env' = env `addInScope` bndrs - rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] - | otherwise = rule { ru_args = args', ru_rhs = rhs' } + rule' = rule { ru_args = args', ru_rhs = rhs' } - (WithUsageDetails lhs_uds args') = occAnalList env' args - lhs_uds' = markAllManyNonTail (lhs_uds `delDetailsList` bndrs) - `addLamCoVarOccs` bndrs + WUD lhs_uds args' = addInScopeList env bndrs $ \env -> + occAnalList env args - (WithUsageDetails rhs_uds rhs') = occAnal env' rhs - -- Note [Rules are extra RHSs] - -- Note [Rule dependency info] - rhs_uds' = markAllMany $ - rhs_uds `delDetailsList` bndrs - rhs_ja = length args -- See Note [Join points and unfoldings/rules] + lhs_uds' = markAllManyNonTail lhs_uds + WUD rhs_uds rhs' = addInScopeList env bndrs $ \env -> + occAnal env rhs + -- Note [Rules are extra RHSs] + -- Note [Rule dependency info] + rhs_uds' = markAllMany rhs_uds + rhs_ja = length args -- See Note [Join points and unfoldings/rules] - occ_anal_rule other_rule = (other_rule, emptyDetails, TUD 0 emptyDetails) +occAnalRule _ other_rule = (other_rule, emptyDetails, TUD 0 emptyDetails) {- Note [Join point RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2178,7 +2375,7 @@ have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ -By default we use an rhsCtxt for the RHS of a binding. This tells the +By default we use an OccRhs for the RHS of a binding. This tells the occ anal n that it's looking at an RHS, which has an effect in occAnalApp. In particular, for constructor applications, it makes the arguments appear to have NoOccInfo, so that we don't inline into @@ -2199,7 +2396,7 @@ Result: multiple simplifier iterations. Sigh. So, when analysing the RHS of x3 we notice that x3 will itself definitely inline the next time round, and so we analyse x3's rhs in -an ordinary context, not rhsCtxt. Hence the "certainly_inline" stuff. +an OccVanilla context, not OccRhs. Hence the "certainly_inline" stuff. Annoyingly, we have to approximate GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally. If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and @@ -2229,17 +2426,17 @@ for the various clauses. -} occAnalList :: OccEnv -> [CoreExpr] -> WithUsageDetails [CoreExpr] -occAnalList !_ [] = WithUsageDetails emptyDetails [] +occAnalList !_ [] = WUD emptyDetails [] occAnalList env (e:es) = let - (WithUsageDetails uds1 e') = occAnal env e - (WithUsageDetails uds2 es') = occAnalList env es - in WithUsageDetails (uds1 `andUDs` uds2) (e' : es') + (WUD uds1 e') = occAnal env e + (WUD uds2 es') = occAnalList env es + in WUD (uds1 `andUDs` uds2) (e' : es') occAnal :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Gives info only about the "interesting" Ids -occAnal !_ expr@(Lit _) = WithUsageDetails emptyDetails expr +occAnal !_ expr@(Lit _) = WUD emptyDetails expr occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- At one stage, I gathered the idRuleVars for the variable here too, @@ -2250,9 +2447,9 @@ occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- weren't used at all. occAnal _ expr@(Type ty) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfType ty)) expr + = WUD (addManyOccs emptyDetails (coVarsOfType ty)) expr occAnal _ expr@(Coercion co) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfCo co)) expr + = WUD (addManyOccs emptyDetails (coVarsOfCo co)) expr -- See Note [Gather occurrences of coercion variables] {- Note [Gather occurrences of coercion variables] @@ -2288,7 +2485,7 @@ We gather CoVar occurrences from: * The (Type ty) and (Coercion co) cases of occAnal * The type 'ty' of a lambda-binder (\(x:ty). blah) - See addLamCoVarOccs + See addCoVarOccs But it is not necessary to gather CoVars from the types of other binders. @@ -2301,22 +2498,22 @@ But it is not necessary to gather CoVars from the types of other binders. occAnal env (Tick tickish body) | SourceNote{} <- tickish - = WithUsageDetails usage (Tick tickish body') + = WUD usage (Tick tickish body') -- SourceNotes are best-effort; so we just proceed as usual. -- If we drop a tick due to the issues described below it's -- not the end of the world. | tickish `tickishScopesLike` SoftScope - = WithUsageDetails (markAllNonTail usage) (Tick tickish body') + = WUD (markAllNonTail usage) (Tick tickish body') | Breakpoint _ _ ids _ <- tickish - = WithUsageDetails (usage_lam `andUDs` foldr addManyOcc emptyDetails ids) (Tick tickish body') + = WUD (addManyOccs usage_lam (mkVarSet ids)) (Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise - = WithUsageDetails usage_lam (Tick tickish body') + = WUD usage_lam (Tick tickish body') where - (WithUsageDetails usage body') = occAnal env body + (WUD usage body') = occAnal env body -- for a non-soft tick scope, we can inline lambdas only usage_lam = markAllNonTail (markAllInsideLam usage) -- TODO There may be ways to make ticks and join points play @@ -2328,59 +2525,77 @@ occAnal env (Tick tickish body) -- See #14242. occAnal env (Cast expr co) - = let (WithUsageDetails usage expr') = occAnal env expr + = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] usage2 = markAllNonTail usage1 -- usage3: calls inside expr aren't tail calls any more - in WithUsageDetails usage2 (Cast expr' co) + in WUD usage2 (Cast expr' co) occAnal env app@(App _ _) = occAnalApp env (collectArgsTicks tickishFloatable app) occAnal env expr@(Lam {}) - = adjustNonRecRhs Nothing $ occAnalLamTail env expr -- mb_join_arity == Nothing <=> markAllManyNonTail + = adjustNonRecRhs Nothing $ -- Nothing <=> markAllManyNonTail + occAnalLamTail env expr occAnal env (Case scrut bndr ty alts) = let - (WithUsageDetails scrut_usage scrut') = occAnal (scrutCtxt env alts) scrut - alt_env = addBndrSwap scrut' bndr $ env { occ_encl = OccVanilla } `addOneInScope` bndr - (alts_usage_s, alts') = mapAndUnzip (do_alt alt_env) alts - alts_usage = foldr orUDs emptyDetails alts_usage_s - (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr - total_usage = markAllNonTail scrut_usage `andUDs` alts_usage1 + WUD scrut_usage scrut' = occAnal (setScrutCtxt env alts) scrut + + WUD alts_usage (tagged_bndr, alts') + = addInScopeOne env bndr $ \env -> + let alt_env = addBndrSwap scrut' bndr $ + setTailCtxt env -- Kill off OccRhs + WUD alts_usage alts' = do_alts alt_env alts + tagged_bndr = tagLamBinder alts_usage bndr + in WUD alts_usage (tagged_bndr, alts') + + total_usage = markAllNonTail scrut_usage `andUDs` alts_usage -- Alts can have tail calls, but the scrutinee can't - in WithUsageDetails total_usage (Case scrut' tagged_bndr ty alts') + + in WUD total_usage (Case scrut' tagged_bndr ty alts') where + do_alts :: OccEnv -> [CoreAlt] -> WithUsageDetails [CoreAlt] + do_alts _ [] = WUD emptyDetails [] + do_alts env (alt:alts) = WUD (uds1 `orUDs` uds2) (alt':alts') + where + WUD uds1 alt' = do_alt env alt + WUD uds2 alts' = do_alts env alts + do_alt !env (Alt con bndrs rhs) - = let - (WithUsageDetails rhs_usage1 rhs1) = occAnal (env `addInScope` bndrs) rhs - (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs - in -- See Note [Binders in case alternatives] - (alt_usg, Alt con tagged_bndrs rhs1) + = addInScopeList env bndrs $ \ env -> + let WUD rhs_usage rhs' = occAnal env rhs + tagged_bndrs = tagLamBinders rhs_usage bndrs + in -- See Note [Binders in case alternatives] + WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) - = let - body_env = env { occ_encl = OccVanilla } `addInScope` bindersOf bind - (WithUsageDetails body_usage body') = occAnal body_env body - (WithUsageDetails final_usage binds') = occAnalBind env NotTopLevel - noImpRuleEdges bind body_usage - in WithUsageDetails final_usage (mkLets binds' body') + = occAnalBind env NotTopLevel noImpRuleEdges bind + (\env -> occAnal env body) mkLets -occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -> WithUsageDetails CoreExpr +occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] + -> [OneShots] -- Very commonly empty, notably prior to dmd anal + -> WithUsageDetails CoreExpr -- The `fun` argument is just an accumulating parameter, -- the base for building the application we return occAnalArgs !env fun args !one_shots = go emptyDetails fun args one_shots where - go uds fun [] _ = WithUsageDetails uds fun + env_args = setNonTailCtxt OccVanilla env + + go uds fun [] _ = WUD uds fun go uds fun (arg:args) one_shots = go (uds `andUDs` arg_uds) (fun `App` arg') args one_shots' where - !(WithUsageDetails arg_uds arg') = occAnal arg_env arg + !(WUD arg_uds arg') = occAnal arg_env arg !(arg_env, one_shots') - | isTypeArg arg = (env, one_shots) - | otherwise = valArgCtxt env one_shots + | isTypeArg arg + = (env_args, one_shots) + | otherwise + = case one_shots of + [] -> (env_args, []) -- Fast path; one_shots is often empty + (os : one_shots') -> (addOneShots os env_args, one_shots') {- Applications are dealt with specially because we want @@ -2414,19 +2629,19 @@ occAnalApp !env (Var fun, args, ticks) -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , WithUsageDetails usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg - = WithUsageDetails usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + , WUD usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg + = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun_id, args, ticks) - = WithUsageDetails all_uds (mkTicks ticks app') + = WUD all_uds (mkTicks ticks app') where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which -- will ultimately be forced. !(fun', fun_id') = lookupBndrSwap env fun_id - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args one_shots + !(WUD args_uds app') = occAnalArgs env fun' args one_shots - fun_uds = mkOneOcc fun_id' int_cxt n_args + fun_uds = mkOneOcc env fun_id' int_cxt n_args -- NB: fun_uds is computed for fun_id', not fun_id -- See (BS1) in Note [The binder-swap substitution] @@ -2434,6 +2649,7 @@ occAnalApp env (Var fun_id, args, ticks) !final_args_uds = markAllNonTail $ markAllInsideLamIf (isRhsEnv env && is_exp) $ + -- isRhsEnv: see Note [OccEncl] args_uds -- We mark the free vars of the argument of a constructor or PAP -- as "inside-lambda", if it is the RHS of a let(rec). @@ -2462,13 +2678,13 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = WithUsageDetails (markAllNonTail (fun_uds `andUDs` args_uds)) + = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) (mkTicks ticks app') where - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args [] - !(WithUsageDetails fun_uds fun') = occAnal (addAppCtxt env args) fun + !(WUD args_uds app') = occAnalArgs env fun' args [] + !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun -- The addAppCtxt is a bit cunning. One iteration of the simplifier - -- often leaves behind beta redexs like + -- often leaves behind beta redexes like -- (\x y -> e) a1 a2 -- Here we would like to mark x,y as one-shot, and treat the whole -- thing much like a let. We do this by pushing some OneShotLam items @@ -2595,33 +2811,45 @@ data OccEnv -- then please replace x by (y |> mco) -- Invariant of course: idType x = exprType (y |> mco) , occ_bs_env :: !(IdEnv (OutId, MCoercion)) - -- Domain is Global and Local Ids - -- Range is just Local Ids + -- Domain is Global and Local Ids + -- Range is just Local Ids , occ_bs_rng :: !VarSet - -- Vars (TyVars and Ids) free in the range of occ_bs_env + -- Vars (TyVars and Ids) free in the range of occ_bs_env + + -- Usage details of the RHS of in-scope non-recursive join points + -- Invariant: no Id maps to an empty OccInfoEnv + -- See Note [Occurrence analysis for join points] + , occ_join_points :: !JoinPointInfo } +type JoinPointInfo = IdEnv OccInfoEnv ----------------------------- --- OccEncl is used to control whether to inline into constructor arguments --- For example: --- x = (p,q) -- Don't inline p or q --- y = /\a -> (p a, q a) -- Still don't inline p or q --- z = f (p,q) -- Do inline p,q; it may make a rule fire --- So OccEncl tells enough about the context to know what to do when --- we encounter a constructor application or PAP. --- --- OccScrut is used to set the "interesting context" field of OncOcc +{- Note [OccEncl] +~~~~~~~~~~~~~~~~~ +OccEncl is used to control whether to inline into constructor arguments. -data OccEncl - = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda - -- Don't inline into constructor args here +* OccRhs: consider + let p = in + let x = Just p + in ...case p of ... - | OccScrut -- Scrutintee of a case - -- Can inline into constructor args + Here `p` occurs syntactically once, but we want to mark it as InsideLam + to stop `p` inlining. We want to leave the x-binding as a constructor + applied to variables, so that the Simplifier can simplify that inner `case`. + + The OccRhs just tells occAnalApp to mark occurrences in constructor args + +* OccScrut: consider (case x of ...). Here we want to give `x` OneOcc + with "interesting context" field int_cxt = True. The OccScrut tells + occAnalApp (which deals with lone variables too) when to set this field + to True. +-} - | OccVanilla -- Argument of function, body of lambda, etc - -- Do inline into constructor args here +data OccEncl -- See Note [OccEncl] + = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda + | OccScrut -- Scrutintee of a case + | OccVanilla -- Everything else instance Outputable OccEncl where ppr OccRhs = text "occRhs" @@ -2641,17 +2869,20 @@ initOccEnv , occ_unf_act = \_ -> True , occ_rule_act = \_ -> True + , occ_join_points = emptyVarEnv , occ_bs_env = emptyVarEnv , occ_bs_rng = emptyVarSet } noBinderSwaps :: OccEnv -> Bool noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env -scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv -scrutCtxt !env alts - | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } - | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } +setScrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv +setScrutCtxt !env alts + = setNonTailCtxt encl env where + encl | interesting_alts = OccScrut + | otherwise = OccVanilla + interesting_alts = case alts of [] -> False [alt] -> not (isDefaultAlt alt) @@ -2660,34 +2891,141 @@ scrutCtxt !env alts -- non-default alternative. That in turn influences -- pre/postInlineUnconditionally. Grep for "occ_int_cxt"! -rhsCtxt :: OccEnv -> OccEnv -rhsCtxt !env = env { occ_encl = OccRhs, occ_one_shots = [] } - -valArgCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) -valArgCtxt !env [] - = (env { occ_encl = OccVanilla, occ_one_shots = [] }, []) -valArgCtxt env (one_shots:one_shots_s) - = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s) +setNonTailCtxt :: OccEncl -> OccEnv -> OccEnv +setNonTailCtxt ctxt !env + = env { occ_encl = ctxt + , occ_one_shots = [] + , occ_join_points = zapped_jp_env } + where + -- zapped_jp_env is basically just emptyVarEnv (hence zapped). See (W3) of + -- Note [Occurrence analysis for join points] Zapping improves efficiency, + -- slightly, if you accidentally introduce a bug, in which you zap [jx :-> uds] and + -- then find an occurrence of jx anyway, you might lose those uds, and + -- that might mean we don't record all occurrencs, and that means we + -- duplicate a redex.... a very nasty bug (which I encountered!). Hence + -- this DEBUG code which doesn't remove jx from the envt; it just gives it + -- emptyDetails, which in turn causes a panic in mkOneOcc. That will catch + -- this bug before it does any damage. +#ifdef DEBUG + zapped_jp_env = mapVarEnv (\ _ -> emptyVarEnv) (occ_join_points env) +#else + zapped_jp_env = emptyVarEnv +#endif + +setTailCtxt :: OccEnv -> OccEnv +setTailCtxt !env + = env { occ_encl = OccVanilla } + -- Preserve occ_one_shots, occ_join points + -- Do not use OccRhs for the RHS of a join point (which is a tail ctxt): + -- see Note [Join point RHSs] + +addOneShots :: OneShots -> OccEnv -> OccEnv +addOneShots os !env + | null os = env -- Fast path for common case + | otherwise = env { occ_one_shots = os } + +addOneShotsFromDmd :: Id -> OccEnv -> OccEnv +addOneShotsFromDmd bndr = addOneShots (argOneShots (idDemandInfo bndr)) isRhsEnv :: OccEnv -> Bool isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of OccRhs -> True _ -> False -addOneInScope :: OccEnv -> CoreBndr -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addOneInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndr - | bndr `elemVarSet` rng_vars = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnv` bndr } - -addInScope :: OccEnv -> [Var] -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndrs - | any (`elemVarSet` rng_vars) bndrs = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnvList` bndrs } +addInScopeList :: OccEnv -> [Var] + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeList #-} +addInScopeList env bndrs = addInScope env (mkVarSet bndrs) + +addInScopeOne :: OccEnv -> Id + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeOne #-} +addInScopeOne env bndr = addInScope env (unitVarSet bndr) + +addInScope :: OccEnv -> IdSet + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScope #-} +-- This function is called a lot, so we want to inline the fast path +addInScope env bndr_set thing_inside + = WUD uds' res + where + !(env', bad_joins) = preprocess_env env bndr_set + !(WUD uds res) = thing_inside env' + uds' = postprocess_uds bndr_set bad_joins uds + +preprocess_env :: OccEnv -> VarSet -> (OccEnv, JoinPointInfo) +preprocess_env env@(OccEnv { occ_join_points = join_points + , occ_bs_rng = bs_rng_vars }) + bndr_set + | bad_joins = (drop_shadowed_swaps (drop_shadowed_joins env), join_points) + | otherwise = (drop_shadowed_swaps env, emptyVarEnv) + where + drop_shadowed_swaps :: OccEnv -> OccEnv + -- See Note [The binder-swap substitution] (BS3) + drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env }) + | bs_rng_vars `intersectsVarSet` bndr_set + = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } + | otherwise + = env { occ_bs_env = swap_env `minusUFM` bndr_fm } + + drop_shadowed_joins :: OccEnv -> OccEnv + -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) + drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } + + -- bad_joins is true if it would be wrong to push occ_join_points inwards + -- (a) `bndrs` includes any of the occ_join_points + -- (b) `bndrs` includes any variables free in the RHSs of occ_join_points + bad_joins :: Bool + bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points + + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set + + is_bad :: Unique -> OccInfoEnv -> Bool -> Bool + is_bad uniq join_uds rest + = uniq `elemUniqSet_Directly` bndr_set || + not (bndr_fm `disjointUFM` join_uds) || + rest + +postprocess_uds :: VarSet -> JoinPointInfo -> UsageDetails -> UsageDetails +postprocess_uds bndr_set bad_joins uds + = add_bad_joins (delBndrsFromUDs bndr_set uds) + where + add_bad_joins :: UsageDetails -> UsageDetails + -- Add usage info for occ_join_points that we cannot push inwards + -- because of shadowing + -- See Note [Occurrence analysis for join points] wrinkle (W2) + add_bad_joins uds + | isEmptyVarEnv bad_joins = uds + | otherwise = modifyUDEnv extend_with_bad_joins uds + + extend_with_bad_joins :: OccInfoEnv -> OccInfoEnv + extend_with_bad_joins env + = nonDetStrictFoldUFM_Directly add_bad_join env bad_joins + + add_bad_join :: Unique -> OccInfoEnv -> OccInfoEnv -> OccInfoEnv + -- Behave like `andUDs` when adding in the bad_joins + add_bad_join uniq join_env env + | uniq `elemVarEnvByKey` env = plusVarEnv_C andLocalOcc env join_env + | otherwise = env + +addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv +addJoinPoint env bndr rhs_uds + | isEmptyVarEnv zeroed_form + = env + | otherwise + = env { occ_join_points = extendVarEnv (occ_join_points env) bndr zeroed_form } + where + zeroed_form = mkZeroedForm rhs_uds +mkZeroedForm :: UsageDetails -> OccInfoEnv +-- See Note [Occurrence analysis for join points] for "zeroed form" +mkZeroedForm (UD { ud_env = rhs_occs }) + = mapMaybeUFM do_one rhs_occs + where + do_one :: LocalOcc -> Maybe LocalOcc + do_one (ManyOccL {}) = Nothing + do_one occ@(OneOccL {}) = Just (occ { lo_n_br = 0 }) -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet @@ -3106,11 +3444,40 @@ with the 'OccInfoEnv'. Each of these extra environments is a "zapped set" recording which variables have been zapped in some way. Zapping all occurrence info then simply means setting the corresponding zapped set to the whole 'OccInfoEnv', a fast O(1) operation. + +Note [LocalOcc] +~~~~~~~~~~~~~~~ +LocalOcc is used purely internally, in the occurrence analyser. It differs from +GHC.Types.Basic.OccInfo because it has only OneOcc and ManyOcc; it does not need +IAmDead or IAmALoopBreaker. + +Note that `OneOccL` doesn't meant that it occurs /syntactially/ only once; it +means that it is /used/ only once. It might occur syntactically many times. +For example, in (case x of A -> y; B -> y; C -> True), +* `y` is used only once +* but it occurs syntactically twice + -} -type OccInfoEnv = IdEnv OccInfo -- A finite map from ids to their usage - -- INVARIANT: never IAmDead - -- (Deadness is signalled by not being in the map at all) +type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's + -- free variables to their usage + +data LocalOcc -- See Note [LocalOcc] + = OneOccL { lo_n_br :: {-# UNPACK #-} !BranchCount -- Number of syntactic occurrences + , lo_tail :: !TailCallInfo + -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3) + -- gives NoTailCallInfo + , lo_int_cxt :: !InterestingCxt } + | ManyOccL !TailCallInfo + +instance Outputable LocalOcc where + ppr (OneOccL { lo_n_br = n, lo_tail = tci }) + = text "OneOccL" <> braces (ppr n <> comma <> ppr tci) + ppr (ManyOccL tci) = text "ManyOccL" <> braces (ppr tci) + +localTailCallInfo :: LocalOcc -> TailCallInfo +localTailCallInfo (OneOccL { lo_tail = tci }) = tci +localTailCallInfo (ManyOccL tci) = tci type ZappedSet = OccInfoEnv -- Values are ignored @@ -3118,53 +3485,67 @@ data UsageDetails = UD { ud_env :: !OccInfoEnv , ud_z_many :: !ZappedSet -- apply 'markMany' to these , ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these - , ud_z_no_tail :: !ZappedSet } -- apply 'markNonTail' to these - -- INVARIANT: All three zapped sets are subsets of the OccInfoEnv + , ud_z_tail :: !ZappedSet -- zap tail-call info for these + } + -- INVARIANT: All three zapped sets are subsets of ud_env instance Outputable UsageDetails where - ppr ud = ppr (ud_env (flattenUsageDetails ud)) - --- | Captures the result of applying 'occAnalLamTail' to a function `\xyz.body`. --- The TailUsageDetails records + ppr ud@(UD { ud_env = env, ud_z_tail = z_tail }) + = text "UD" <+> (braces $ fsep $ punctuate comma $ + [ ppr uq <+> text ":->" <+> ppr (lookupOccInfoByUnique ud uq) + | (uq, _) <- nonDetStrictFoldVarEnv_Directly do_one [] env ]) + $$ nest 2 (text "ud_z_tail" <+> ppr z_tail) + where + do_one :: Unique -> LocalOcc -> [(Unique,LocalOcc)] -> [(Unique,LocalOcc)] + do_one uniq occ occs = (uniq, occ) : occs + +--------------------- +-- | TailUsageDetails captures the result of applying 'occAnalLamTail' +-- to a function `\xyz.body`. The TailUsageDetails pairs together -- * the number of lambdas (including type lambdas: a JoinArity) --- * UsageDetails for the `body`, unadjusted by `adjustTailUsage`. --- If the binding turns out to be a join point with the indicated join --- arity, this unadjusted usage details is just what we need; otherwise we --- need to discard tail calls. That's what `adjustTailUsage` does. +-- * UsageDetails for the `body` of the lambda, unadjusted by `adjustTailUsage`. +-- If the binding turns out to be a join point with the indicated join +-- arity, this unadjusted usage details is just what we need; otherwise we +-- need to discard tail calls. That's what `adjustTailUsage` does. data TailUsageDetails = TUD !JoinArity !UsageDetails instance Outputable TailUsageDetails where ppr (TUD ja uds) = lambda <> ppr ja <> ppr uds +--------------------- +data WithUsageDetails a = WUD !UsageDetails !a +data WithTailUsageDetails a = WTUD !TailUsageDetails !a ------------------- -- UsageDetails API andUDs, orUDs :: UsageDetails -> UsageDetails -> UsageDetails -andUDs = combineUsageDetailsWith addOccInfo -orUDs = combineUsageDetailsWith orOccInfo +andUDs = combineUsageDetailsWith andLocalOcc +orUDs = combineUsageDetailsWith orLocalOcc -mkOneOcc :: Id -> InterestingCxt -> JoinArity -> UsageDetails -mkOneOcc id int_cxt arity - | isLocalId id - = emptyDetails { ud_env = unitVarEnv id occ_info } - | otherwise +mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails +mkOneOcc !env id int_cxt arity + | not (isLocalId id) = emptyDetails - where - occ_info = OneOcc { occ_in_lam = NotInsideLam - , occ_n_br = oneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled arity } -addManyOccId :: UsageDetails -> Id -> UsageDetails --- Add the non-committal (id :-> noOccInfo) to the usage details -addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id noOccInfo } + | Just join_uds <- lookupVarEnv (occ_join_points env) id + = -- See Note [Occurrence analysis for join points] + assertPpr (not (isEmptyVarEnv join_uds)) (ppr id) $ + -- We only put non-empty join-points into occ_join_points + mkSimpleDetails (extendVarEnv join_uds id occ) + + | otherwise + = mkSimpleDetails (unitVarEnv id occ) + + where + occ = OneOccL { lo_n_br = 1, lo_int_cxt = int_cxt + , lo_tail = AlwaysTailCalled arity } -- Add several occurrences, assumed not to be tail calls -addManyOcc :: Var -> UsageDetails -> UsageDetails -addManyOcc v u | isId v = addManyOccId u v - | otherwise = u +add_many_occ :: Var -> OccInfoEnv -> OccInfoEnv +add_many_occ v env | isId v = extendVarEnv env v (ManyOccL NoTailCallInfo) + | otherwise = env -- Give a non-committal binder info (i.e noOccInfo) because -- a) Many copies of the specialised thing can appear -- b) We don't want to substitute a BIG expression inside a RULE @@ -3172,37 +3553,54 @@ addManyOcc v u | isId v = addManyOccId u v -- (Same goes for INLINE.) addManyOccs :: UsageDetails -> VarSet -> UsageDetails -addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set - -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes +addManyOccs uds var_set + | isEmptyVarSet var_set = uds + | otherwise = uds { ud_env = add_to (ud_env uds) } + where + add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set + -- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails -- Add any CoVars free in the type of a lambda-binder -- See Note [Gather occurrences of coercion variables] addLamCoVarOccs uds bndrs - = uds `addManyOccs` coVarsOfTypes (map varType bndrs) - -delDetails :: UsageDetails -> Id -> UsageDetails -delDetails ud bndr - = ud `alterUsageDetails` (`delVarEnv` bndr) - -delDetailsList :: UsageDetails -> [Id] -> UsageDetails -delDetailsList ud bndrs - = ud `alterUsageDetails` (`delVarEnvList` bndrs) + = foldr add uds bndrs + where + add bndr uds = uds `addManyOccs` coVarsOfType (varType bndr) emptyDetails :: UsageDetails -emptyDetails = UD { ud_env = emptyVarEnv - , ud_z_many = emptyVarEnv - , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } +emptyDetails = mkSimpleDetails emptyVarEnv isEmptyDetails :: UsageDetails -> Bool -isEmptyDetails = isEmptyVarEnv . ud_env +isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env + +mkSimpleDetails :: OccInfoEnv -> UsageDetails +mkSimpleDetails env = UD { ud_env = env + , ud_z_many = emptyVarEnv + , ud_z_in_lam = emptyVarEnv + , ud_z_tail = emptyVarEnv } + +modifyUDEnv :: (OccInfoEnv -> OccInfoEnv) -> UsageDetails -> UsageDetails +modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env } + +delBndrsFromUDs :: VarSet -> UsageDetails -> UsageDetails +-- Delete these binders from the UsageDetails +delBndrsFromUDs bndr_set (UD { ud_env = env, ud_z_many = z_many + , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail }) + = UD { ud_env = env `minusUFM` bndr_fm + , ud_z_many = z_many `minusUFM` bndr_fm + , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm + , ud_z_tail = z_tail `minusUFM` bndr_fm } + where + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails -markAllMany ud = ud { ud_z_many = ud_env ud } -markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } -markAllNonTail ud = ud { ud_z_no_tail = ud_env ud } +markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env } +markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env } +markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env } +markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3212,21 +3610,18 @@ markAllInsideLamIf False ud = ud markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud - -markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo - -lookupDetails :: UsageDetails -> Id -> OccInfo -lookupDetails ud id - = case lookupVarEnv (ud_env ud) id of - Just occ -> doZapping ud id occ - Nothing -> IAmDead - -usedIn :: Id -> UsageDetails -> Bool -v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud +lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo +lookupTailCallInfo uds id + | UD { ud_z_tail = z_tail, ud_env = env } <- uds + , not (id `elemVarEnv` z_tail) + , Just occ <- lookupVarEnv env id + = localTailCallInfo occ + | otherwise + = NoTailCallInfo udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds -udFreeVars bndrs ud = restrictFreeVars bndrs (ud_env ud) +udFreeVars bndrs (UD { ud_env = env }) = restrictFreeVars bndrs env restrictFreeVars :: VarSet -> OccInfoEnv -> VarSet restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs @@ -3234,66 +3629,96 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs ------------------- -- Auxiliary functions for UsageDetails implementation -combineUsageDetailsWith :: (OccInfo -> OccInfo -> OccInfo) +combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails -combineUsageDetailsWith plus_occ_info ud1 ud2 - | isEmptyDetails ud1 = ud2 - | isEmptyDetails ud2 = ud1 +{-# INLINE combineUsageDetailsWith #-} +combineUsageDetailsWith plus_occ_info + uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) + uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) + | isEmptyVarEnv env1 = uds2 + | isEmptyVarEnv env2 = uds1 | otherwise - = UD { ud_env = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2) - , ud_z_many = plusVarEnv (ud_z_many ud1) (ud_z_many ud2) - , ud_z_in_lam = plusVarEnv (ud_z_in_lam ud1) (ud_z_in_lam ud2) - , ud_z_no_tail = plusVarEnv (ud_z_no_tail ud1) (ud_z_no_tail ud2) } - -doZapping :: UsageDetails -> Var -> OccInfo -> OccInfo -doZapping ud var occ - = doZappingByUnique ud (varUnique var) occ - -doZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo -doZappingByUnique (UD { ud_z_many = many - , ud_z_in_lam = in_lam - , ud_z_no_tail = no_tail }) - uniq occ - = occ2 + = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = plusVarEnv z_many1 z_many2 + , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 + , ud_z_tail = plusVarEnv z_tail1 z_tail2 } + +lookupLetOccInfo :: UsageDetails -> Id -> OccInfo +-- Don't use locally-generated occ_info for exported (visible-elsewhere) +-- things. Instead just give noOccInfo. +-- NB: setBinderOcc will (rightly) erase any LoopBreaker info; +-- we are about to re-generate it and it shouldn't be "sticky" +lookupLetOccInfo ud id + | isExportedId id = noOccInfo + | otherwise = lookupOccInfoByUnique ud (idUnique id) + +lookupOccInfo :: UsageDetails -> Id -> OccInfo +lookupOccInfo ud id = lookupOccInfoByUnique ud (idUnique id) + +lookupOccInfoByUnique :: UsageDetails -> Unique -> OccInfo +lookupOccInfoByUnique (UD { ud_env = env + , ud_z_many = z_many + , ud_z_in_lam = z_in_lam + , ud_z_tail = z_tail }) + uniq + = case lookupVarEnv_Directly env uniq of + Nothing -> IAmDead + Just (OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt + , lo_tail = tail_info }) + | uniq `elemVarEnvByKey`z_many + -> ManyOccs { occ_tail = mk_tail_info tail_info } + | otherwise + -> OneOcc { occ_in_lam = in_lam + , occ_n_br = n_br + , occ_int_cxt = int_cxt + , occ_tail = mk_tail_info tail_info } + where + in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam + | otherwise = NotInsideLam + + Just (ManyOccL tail_info) -> ManyOccs { occ_tail = mk_tail_info tail_info } where - occ1 | uniq `elemVarEnvByKey` many = markMany occ - | uniq `elemVarEnvByKey` in_lam = markInsideLam occ - | otherwise = occ - occ2 | uniq `elemVarEnvByKey` no_tail = markNonTail occ1 - | otherwise = occ1 - -alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails -alterUsageDetails !ud f - = UD { ud_env = f (ud_env ud) - , ud_z_many = f (ud_z_many ud) - , ud_z_in_lam = f (ud_z_in_lam ud) - , ud_z_no_tail = f (ud_z_no_tail ud) } - -flattenUsageDetails :: UsageDetails -> UsageDetails -flattenUsageDetails ud@(UD { ud_env = env }) - = UD { ud_env = mapUFM_Directly (doZappingByUnique ud) env - , ud_z_many = emptyVarEnv - , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } + mk_tail_info ti + | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo + | otherwise = ti + + ------------------- -- See Note [Adjusting right-hand sides] + +adjustNonRecRhs :: Maybe JoinArity + -> WithTailUsageDetails CoreExpr + -> WithUsageDetails CoreExpr +-- ^ This function concentrates shared logic between occAnalNonRecBind and the +-- AcyclicSCC case of occAnalRec. +-- * It applies 'markNonRecJoinOneShots' to the RHS +-- * and returns the adjusted rhs UsageDetails combined with the body usage +adjustNonRecRhs mb_join_arity rhs_wuds@(WTUD _ rhs) + = WUD rhs_uds' rhs' + where + --------- Marking (non-rec) join binders one-shot --------- + !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs + | otherwise = rhs + + --------- Adjusting right-hand side usage --------- + rhs_uds' = adjustTailUsage mb_join_arity rhs_wuds + adjustTailUsage :: Maybe JoinArity - -> CoreExpr -- Rhs, AFTER occAnalLamTail - -> TailUsageDetails -- From body of lambda - -> UsageDetails -adjustTailUsage mb_join_arity rhs (TUD rhs_ja usage) + -> WithTailUsageDetails CoreExpr -- Rhs usage, AFTER occAnalLamTail + -> UsageDetails +adjustTailUsage mb_join_arity (WTUD (TUD rhs_ja uds) rhs) = -- c.f. occAnal (Lam {}) markAllInsideLamIf (not one_shot) $ markAllNonTailIf (not exact_join) $ - usage + uds where one_shot = isOneShotFun rhs exact_join = mb_join_arity == Just rhs_ja adjustTailArity :: Maybe JoinArity -> TailUsageDetails -> UsageDetails -adjustTailArity mb_rhs_ja (TUD ud_ja usage) = - markAllNonTailIf (mb_rhs_ja /= Just ud_ja) usage +adjustTailArity mb_rhs_ja (TUD ja usage) + = markAllNonTailIf (mb_rhs_ja /= Just ja) usage markNonRecJoinOneShots :: JoinArity -> CoreExpr -> CoreExpr -- For a /non-recursive/ join point we can mark all @@ -3324,52 +3749,38 @@ markNonRecUnfoldingOneShots mb_join_arity unf type IdWithOccInfo = Id -tagLamBinders :: UsageDetails -- Of scope - -> [Id] -- Binders - -> (UsageDetails, -- Details with binders removed - [IdWithOccInfo]) -- Tagged binders +tagLamBinders :: UsageDetails -- Of scope + -> [Id] -- Binders + -> [IdWithOccInfo] -- Tagged binders tagLamBinders usage binders - = usage' `seq` (usage', bndrs') - where - (usage', bndrs') = mapAccumR tagLamBinder usage binders + = map (tagLamBinder usage) binders tagLamBinder :: UsageDetails -- Of scope -> Id -- Binder - -> (UsageDetails, -- Details with binder removed - IdWithOccInfo) -- Tagged binders + -> IdWithOccInfo -- Tagged binders -- Used for lambda and case binders --- It copes with the fact that lambda bindings can have a --- stable unfolding, used for join points +-- No-op on TyVars +-- A lambda binder never has an unfolding, so no need to look for that tagLamBinder usage bndr - = (usage2, bndr') + = setBinderOcc (markNonTail occ) bndr + -- markNonTail: don't try to make an argument into a join point where - occ = lookupDetails usage bndr - bndr' = setBinderOcc (markNonTail occ) bndr - -- Don't try to make an argument into a join point - usage1 = usage `delDetails` bndr - usage2 | isId bndr = addManyOccs usage1 (idUnfoldingVars bndr) - -- This is effectively the RHS of a - -- non-join-point binding, so it's okay to use - -- addManyOccsSet, which assumes no tail calls - | otherwise = usage1 + occ = lookupOccInfo usage bndr tagNonRecBinder :: TopLevelFlag -- At top level? - -> UsageDetails -- Of scope + -> OccInfo -- Of scope -> CoreBndr -- Binder - -> WithUsageDetails -- Details with binder removed - IdWithOccInfo -- Tagged binder - -tagNonRecBinder lvl usage binder - = let - occ = lookupDetails usage binder - will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) - occ' | will_be_join = -- must already be marked AlwaysTailCalled - assert (isAlwaysTailCalled occ) occ - | otherwise = markNonTail occ - binder' = setBinderOcc occ' binder - usage' = usage `delDetails` binder - in - WithUsageDetails usage' binder' + -> IdWithOccInfo -- Tagged binder +-- No-op on TyVars +-- Precondition: OccInfo is not IAmDead +tagNonRecBinder lvl occ bndr + = setBinderOcc occ' bndr + where + will_be_join = okForJoinPoint lvl bndr (tailCallInfo occ) + occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless + -- it was a join point before but is now dead + warnPprTrace (not (isAlwaysTailCalled occ)) "tagNonRecBinder" (ppr bndr <+> ppr occ) occ + | otherwise = markNonTail occ tagRecBinders :: TopLevelFlag -- At top level? -> UsageDetails -- Of body of let ONLY @@ -3381,18 +3792,17 @@ tagRecBinders :: TopLevelFlag -- At top level? -- details *before* tagging binders (because the tags depend on the RHSes). tagRecBinders lvl body_uds details_s = let - bndrs = map nd_bndr details_s + bndrs = map nd_bndr details_s -- 1. See Note [Join arity prediction based on joinRhsArity] -- Determine possible join-point-hood of whole group, by testing for -- manifest join arity M. -- This (re-)asserts that makeNode had made tuds for that same arity M! - unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s - test_manifest_arity ND{nd_rhs=WithTailUsageDetails tuds rhs} + unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s + test_manifest_arity ND{nd_rhs = WTUD tuds rhs} = adjustTailArity (Just (joinRhsArity rhs)) tuds - bndr_ne = expectNonEmpty "List of binders is never empty" bndrs - will_be_joins = decideJoinPointHood lvl unadj_uds bndr_ne + will_be_joins = decideRecJoinPointHood lvl unadj_uds bndrs mb_join_arity :: Id -> Maybe JoinArity -- mb_join_arity: See Note [Join arity prediction based on joinRhsArity] @@ -3401,42 +3811,33 @@ tagRecBinders lvl body_uds details_s -- Can't use willBeJoinId_maybe here because we haven't tagged -- the binder yet (the tag depends on these adjustments!) | will_be_joins - , let occ = lookupDetails unadj_uds bndr - , AlwaysTailCalled arity <- tailCallInfo occ + , AlwaysTailCalled arity <- lookupTailCallInfo unadj_uds bndr = Just arity | otherwise = assert (not will_be_joins) -- Should be AlwaysTailCalled if - Nothing -- we are making join points! + Nothing -- we are making join points! -- 2. Adjust usage details of each RHS, taking into account the -- join-point-hood decision - rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs rhs_tuds -- matching occAnalLamTail in makeNode - | ND { nd_bndr = bndr, nd_rhs = WithTailUsageDetails rhs_tuds rhs } - <- details_s ] + rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs_wuds + -- Matching occAnalLamTail in makeNode + | ND { nd_bndr = bndr, nd_rhs = rhs_wuds } <- details_s ] -- 3. Compute final usage details from adjusted RHS details - adj_uds = foldr andUDs body_uds rhs_udss' + adj_uds = foldr andUDs body_uds rhs_udss' -- 4. Tag each binder with its adjusted details - bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr + bndrs' = [ setBinderOcc (lookupLetOccInfo adj_uds bndr) bndr | bndr <- bndrs ] - -- 5. Drop the binders from the adjusted details and return - usage' = adj_uds `delDetailsList` bndrs in - WithUsageDetails usage' bndrs' + WUD adj_uds bndrs' setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr setBinderOcc occ_info bndr - | isTyVar bndr = bndr - | isExportedId bndr = if isManyOccs (idOccInfo bndr) - then bndr - else setIdOccInfo bndr noOccInfo - -- Don't use local usage info for visible-elsewhere things - -- BUT *do* erase any IAmALoopBreaker annotation, because we're - -- about to re-generate it and it shouldn't be "sticky" - - | otherwise = setIdOccInfo bndr occ_info + | isTyVar bndr = bndr + | occ_info == idOccInfo bndr = bndr + | otherwise = setIdOccInfo bndr occ_info -- | Decide whether some bindings should be made into join points or not, based -- on its occurrences. This is @@ -3450,41 +3851,47 @@ setBinderOcc occ_info bndr -- 'f' tail-calls 'g'. -- -- See Note [Invariants on join points] in "GHC.Core". -decideJoinPointHood :: TopLevelFlag -> UsageDetails - -> NonEmpty CoreBndr - -> Bool -decideJoinPointHood TopLevel _ _ - = False -decideJoinPointHood NotTopLevel usage bndrs - | isJoinId (NE.head bndrs) - = warnPprTrace (not all_ok) - "OccurAnal failed to rediscover join point(s)" (ppr bndrs) - all_ok - | otherwise - = all_ok +decideRecJoinPointHood :: TopLevelFlag -> UsageDetails + -> [CoreBndr] -> Bool +decideRecJoinPointHood lvl usage bndrs + = all ok bndrs -- Invariant 3: Either all are join points or none are where + ok bndr = okForJoinPoint lvl bndr (lookupTailCallInfo usage bndr) + +okForJoinPoint :: TopLevelFlag -> Id -> TailCallInfo -> Bool -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. - all_ok = -- Invariant 3: Either all are join points or none are - all ok bndrs - - ok bndr - | -- Invariant 1: Only tail calls, all same join arity - AlwaysTailCalled arity <- tailCallInfo (lookupDetails usage bndr) +okForJoinPoint lvl bndr tail_call_info + | isJoinId bndr -- A current join point should still be one! + = warnPprTrace lost_join "Lost join point" lost_join_doc $ + True + | valid_join + = True + | otherwise + = False + where + valid_join | NotTopLevel <- lvl + , AlwaysTailCalled arity <- tail_call_info - , -- Invariant 1 as applied to LHSes of rules - all (ok_rule arity) (idCoreRules bndr) + , -- Invariant 1 as applied to LHSes of rules + all (ok_rule arity) (idCoreRules bndr) - -- Invariant 2a: stable unfoldings - -- See Note [Join points and INLINE pragmas] - , ok_unfolding arity (realIdUnfolding bndr) + -- Invariant 2a: stable unfoldings + -- See Note [Join points and INLINE pragmas] + , ok_unfolding arity (realIdUnfolding bndr) - -- Invariant 4: Satisfies polymorphism rule - , isValidJoinPointType arity (idType bndr) - = True + -- Invariant 4: Satisfies polymorphism rule + , isValidJoinPointType arity (idType bndr) + = True + | otherwise + = False - | otherwise - = False + lost_join | Just ja <- isJoinId_maybe bndr + = not valid_join || + (case tail_call_info of -- Valid join but arity differs + AlwaysTailCalled ja' -> ja /= ja' + _ -> False) + | otherwise = False ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans ok_rule join_arity (Rule { ru_args = args }) @@ -3500,6 +3907,16 @@ decideJoinPointHood NotTopLevel usage bndrs ok_unfolding _ _ = True + lost_join_doc + = vcat [ text "bndr:" <+> ppr bndr + , text "tc:" <+> ppr tail_call_info + , text "rules:" <+> ppr (idCoreRules bndr) + , case tail_call_info of + AlwaysTailCalled arity -> + vcat [ text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr)) + , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr)) ] + _ -> empty ] + willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity willBeJoinId_maybe bndr | isId bndr @@ -3546,44 +3963,25 @@ See Invariant 2a of Note [Invariants on join points] in GHC.Core ************************************************************************ -} -markMany, markInsideLam, markNonTail :: OccInfo -> OccInfo - -markMany IAmDead = IAmDead -markMany occ = ManyOccs { occ_tail = occ_tail occ } - -markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = IsInsideLam } -markInsideLam occ = occ - +markNonTail :: OccInfo -> OccInfo markNonTail IAmDead = IAmDead markNonTail occ = occ { occ_tail = NoTailCallInfo } -addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo - -addOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } - -- Both branches are at least One - -- (Argument is never IAmDead) +andLocalOcc :: LocalOcc -> LocalOcc -> LocalOcc +andLocalOcc occ1 occ2 = ManyOccL (tci1 `andTailCallInfo` tci2) + where + !tci1 = localTailCallInfo occ1 + !tci2 = localTailCallInfo occ2 --- (orOccInfo orig new) is used +orLocalOcc :: LocalOcc -> LocalOcc -> LocalOcc +-- (orLocalOcc occ1 occ2) is used -- when combining occurrence info from branches of a case - -orOccInfo (OneOcc { occ_in_lam = in_lam1 - , occ_n_br = nbr1 - , occ_int_cxt = int_cxt1 - , occ_tail = tail1 }) - (OneOcc { occ_in_lam = in_lam2 - , occ_n_br = nbr2 - , occ_int_cxt = int_cxt2 - , occ_tail = tail2 }) - = OneOcc { occ_n_br = nbr1 + nbr2 - , occ_in_lam = in_lam1 `mappend` in_lam2 - , occ_int_cxt = int_cxt1 `mappend` int_cxt2 - , occ_tail = tail1 `andTailCallInfo` tail2 } - -orOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } +orLocalOcc (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = tci1 }) + (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = tci2 }) + = OneOccL { lo_n_br = nbr1 + nbr2 + , lo_int_cxt = int_cxt1 `mappend` int_cxt2 + , lo_tail = tci1 `andTailCallInfo` tci2 } +orLocalOcc occ1 occ2 = andLocalOcc occ1 occ2 andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -443,23 +443,39 @@ emptyRuleEnv = RuleEnv { re_local_rules = emptyNameEnv getRules :: RuleEnv -> Id -> [CoreRule] -- Given a RuleEnv and an Id, find the visible rules for that Id -- See Note [Where rules are found] -getRules (RuleEnv { re_local_rules = local_rules - , re_home_rules = home_rules - , re_eps_rules = eps_rules +-- +-- This function is quite heavily used, so it's worth trying to make it efficient +getRules (RuleEnv { re_local_rules = local_rule_base + , re_home_rules = home_rule_base + , re_eps_rules = eps_rule_base , re_visible_orphs = orphs }) fn | Just {} <- isDataConId_maybe fn -- Short cut for data constructor workers = [] -- and wrappers, which never have any rules - | otherwise - = idCoreRules fn ++ - get local_rules ++ - find_visible home_rules ++ - find_visible eps_rules + | Just export_flag <- isLocalId_maybe fn + = -- LocalIds can't have rules in the local_rule_base (used for imported fns) + -- nor external packages; but there can (just) be rules in another module + -- in the home package, if it is exported + case export_flag of + NotExported -> idCoreRules fn + Exported -> case get home_rule_base of + [] -> idCoreRules fn + home_rules -> drop_orphs home_rules ++ idCoreRules fn + | otherwise + = -- This case expression is a fast path, to avoid calling the + -- recursive (++) in the common case where there are no rules at all + case (get local_rule_base, get home_rule_base, get eps_rule_base) of + ([], [], []) -> idCoreRules fn + (local_rules, home_rules, eps_rules) -> local_rules ++ + drop_orphs home_rules ++ + drop_orphs eps_rules ++ + idCoreRules fn where fn_name = idName fn - find_visible rb = filter (ruleIsVisible orphs) (get rb) + drop_orphs [] = [] -- Fast path; avoid invoking recursive filter + drop_orphs xs = filter (ruleIsVisible orphs) xs get rb = lookupNameEnv rb fn_name `orElse` [] ruleIsVisible :: ModuleSet -> CoreRule -> Bool ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -263,7 +263,6 @@ simple_opt_expr env expr go lam@(Lam {}) = go_lam env [] lam go (Case e b ty as) - -- See Note [Getting the map/coerce RULE to work] | isDeadBinder b , Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e' -- We don't need to be concerned about floats when looking for coerce. ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -180,24 +180,6 @@ instance Outputable CallCtxt where ppr RuleArgCtxt = text "RuleArgCtxt" {- -Note [Occurrence analysis of unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We do occurrence-analysis of unfoldings once and for all, when the -unfolding is built, rather than each time we inline them. - -But given this decision it's vital that we do -*always* do it. Consider this unfolding - \x -> letrec { f = ...g...; g* = f } in body -where g* is (for some strange reason) the loop breaker. If we don't -occ-anal it when reading it in, we won't mark g as a loop breaker, and -we may inline g entirely in body, dropping its binding, and leaving -the occurrence in f out of scope. This happened in #8892, where -the unfolding in question was a DFun unfolding. - -But more generally, the simplifier is designed on the -basis that it is looking at occurrence-analysed expressions, so better -ensure that they actually are. - Note [Calculate unfolding guidance on the non-occ-anal'd expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Notice that we give the non-occur-analysed expression to ===================================== compiler/GHC/Core/Unfold/Make.hs ===================================== @@ -86,7 +86,7 @@ mkDFunUnfolding bndrs con ops = DFunUnfolding { df_bndrs = bndrs , df_con = con , df_args = map occurAnalyseExpr ops } - -- See Note [Occurrence analysis of unfoldings] + -- See Note [OccInfo in unfoldings and rules] in GHC.Core mkDataConUnfolding :: CoreExpr -> Unfolding -- Used for non-newtype data constructors with non-trivial wrappers @@ -338,7 +338,7 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr mkCoreUnfolding src top_lvl expr precomputed_cache guidance = CoreUnfolding { uf_tmpl = cache `seq` occurAnalyseExpr expr - -- occAnalyseExpr: see Note [Occurrence analysis of unfoldings] + -- occAnalyseExpr: see Note [OccInfo in unfoldings and rules] in GHC.Core -- See #20905 for what a discussion of this 'seq'. -- We are careful to make sure we only -- have one copy of an unfolding around at once. @@ -459,7 +459,7 @@ With that in mind we want to maintain the invariant that each unfolding only ref a single CoreExpr. One place where we have to be careful is in mkCoreUnfolding. * The template of the unfolding is the result of performing occurrence analysis - (Note [Occurrence analysis of unfoldings]) + (Note [OccInfo in unfoldings and rules] in GHC.Core) * Predicates are applied to the unanalysed expression Therefore if we are not thoughtful about forcing you can end up in a situation where the ===================================== compiler/GHC/Parser.y ===================================== @@ -1026,7 +1026,7 @@ exportlist1 :: { OrdList (LIE GhcPs) } -- No longer allow things like [] and (,,,) to be exported -- They are built in syntax, always available export :: { OrdList (LIE GhcPs) } - : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) (reLoc $2) $> } + : maybeexportwarning qcname_ext export_subspec {% do { let { span = (maybe comb2 comb3 $1) $2 $> } ; impExp <- mkModuleImpExp $1 (fst $ unLoc $3) $2 (snd $ unLoc $3) ; return $ unitOL $ reLocA $ sL span $ impExp } } | maybeexportwarning 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $> @@ -1034,7 +1034,7 @@ export :: { OrdList (LIE GhcPs) } ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3)) ; return $ unitOL $ reLocA $ locImpExp } } | maybeexportwarning 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $> - in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 (reLocN $>) (IEPattern (glAA $2) $3)) } + in unitOL $ reLocA $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) } maybeexportwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) } : '{-# DEPRECATED' strings '#-}' @@ -1079,7 +1079,7 @@ qcname_ext_w_wildcard :: { Located ([AddEpAnn], LocatedA ImpExpQcSpec) } qcname_ext :: { LocatedA ImpExpQcSpec } : qcname { sL1a $1 (ImpExpQcName $1) } | 'type' oqtycon {% do { n <- mkTypeImpExp $2 - ; return $ sLLa $1 (reLocN $>) (ImpExpQcType (glAA $1) n) }} + ; return $ sLLa $1 $> (ImpExpQcType (glAA $1) n) }} qcname :: { LocatedN RdrName } -- Variable or type constructor : qvar { $1 } -- Things which look like functions @@ -1134,7 +1134,7 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $ + ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 @@ -1211,7 +1211,7 @@ importlist1 :: { OrdList (LIE GhcPs) } import :: { OrdList (LIE GhcPs) } : qcname_ext export_subspec {% fmap (unitOL . reLocA . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) } | 'module' modid {% fmap (unitOL . reLocA) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glR $1) [mj AnnModule $1] cs) $2)) } - | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2)) } + | 'pattern' qcon { unitOL $ reLocA $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) } ----------------------------------------------------------------------------- -- Fixity Declarations @@ -1314,7 +1314,7 @@ ty_decl :: { LTyClDecl GhcPs } where_type_family -- Note the use of type for the head; this allows -- infix type constructors to be declared - {% mkFamDecl (comb5 $1 (reLoc $3) $4 $5 $6) (snd $ unLoc $6) TopLevel $3 + {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3 (snd $ unLoc $4) (snd $ unLoc $5) (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4) ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) } @@ -1576,13 +1576,13 @@ opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) } opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) } : { noLoc ([] , noLocA (NoSig noExtField) )} - | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 (reLoc $>) (KindSig noExtField $2))} + | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))} | '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2 - ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 (reLoc $>) (TyVarSig noExtField tvb))} } + ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} } opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs , Maybe (LInjectivityAnn GhcPs)))} @@ -1592,7 +1592,7 @@ opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs | '=' tv_bndr_no_braces '|' injectivity_cond {% do { tvb <- fromSpecTyVarBndr $2 ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3] - , (sLLa $1 (reLoc $2) (TyVarSig noExtField tvb), Just $4))} } + , (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} } -- tycl_hdr parses the header of a class or data type decl, -- which takes the form @@ -2128,7 +2128,7 @@ opt_tyconsig :: { ([AddEpAnn], Maybe (LocatedN RdrName)) } sigktype :: { LHsSigType GhcPs } : sigtype { $1 } | ctype '::' kind {% acsA (\cs -> sLL $1 $> $ mkHsImplicitSigType $ - sLLa (reLoc $1) (reLoc $>) $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } + sLLa $1 $> $ HsKindSig (EpAnn (glAR $1) [mu AnnDcolon $2] cs) $1 $3) } -- Like ctype, but for types that obey the forall-or-nothing rule. -- See Note [forall-or-nothing rule] in GHC.Hs.Type. To avoid duplicating the @@ -2172,7 +2172,7 @@ ktype :: { LHsType GhcPs } -- A ctype is a for-all type ctype :: { LHsType GhcPs } - : forall_telescope ctype { reLocA $ sLL $1 (reLoc $>) $ + : forall_telescope ctype { sLLa $1 $> $ HsForAllTy { hst_tele = unLoc $1 , hst_xforall = noExtField , hst_body = $2 } } @@ -2305,13 +2305,13 @@ atype :: { LHsType GhcPs } -- so you have to quote those.) | '[' ktype ',' comma_types1 ']' {% do { h <- addTrailingCommaA $2 (gl $3) ; acsA (\cs -> sLL $1 $> $ HsExplicitListTy (EpAnn (glR $1) [mos $1,mcs $5] cs) NotPromoted (h:$4)) }} - | INTEGER { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) + | INTEGER { sLLa $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1) (il_value (getINTEGER $1)) } - | CHAR { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) + | CHAR { sLLa $1 $> $ HsTyLit noExtField $ HsCharTy (getCHARs $1) (getCHAR $1) } - | STRING { reLocA $ sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) + | STRING { sLLa $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1) (getSTRING $1) } - | '_' { reLocA $ sL1 $1 $ mkAnonWildCardTy } + | '_' { sL1a $1 $ mkAnonWildCardTy } -- Type variables are never exported, so `M.tyvar` will be rejected by the renamer. -- We let it pass the parser because the renamer can generate a better error message. | QVARID {% let qname = mkQual tvName (getQVARID $1) @@ -2470,8 +2470,8 @@ constrs1 :: { Located [LConDecl GhcPs] } constr :: { LConDecl GhcPs } : forall context '=>' constr_stuff {% acsA (\cs -> let (con,details) = unLoc $4 in - (L (comb4 $1 (reLoc $2) $3 $4) (mkConDeclH98 - (EpAnn (spanAsAnchor (comb4 $1 (reLoc $2) $3 $4)) + (L (comb4 $1 $2 $3 $4) (mkConDeclH98 + (EpAnn (spanAsAnchor (comb4 $1 $2 $3 $4)) (mu AnnDarrow $3:(fst $ unLoc $1)) cs) con (snd $ unLoc $1) @@ -2763,7 +2763,7 @@ exp_prag(e) :: { ECP } : prag_e e -- See Note [Pragmas and operator fixity] {% runPV (unECP $2) >>= \ $2 -> fmap ecpFromExp $ - return $ (reLocA $ sLL $1 $> $ HsPragE noExtField (unLoc $1) $2) } + return $ (sLLa $1 $> $ HsPragE noExtField (unLoc $1) $2) } exp10 :: { ECP } -- See Note [%shift: exp10 -> '-' fexp] @@ -2877,8 +2877,8 @@ aexp :: { ECP } { ECP $ unECP $4 >>= \ $4 -> mkHsLamPV (comb2 $1 $>) (\cs -> mkMatchGroup FromSource - (reLocA $ sLL $1 $> - [reLocA $ sLL $1 $> + (sLLa $1 $> + [sLLa $1 $> $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2 @@ -2934,7 +2934,7 @@ aexp :: { ECP } {% (checkPattern <=< runPV) (unECP $2) >>= \ p -> runPV (unECP $4) >>= \ $4 at cmd -> fmap ecpFromExp $ - acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 (reLoc $>) $ HsCmdTop noExtField cmd)) } + acsA (\cs -> sLL $1 $> $ HsProc (EpAnn (glR $1) [mj AnnProc $1,mu AnnRarrow $3] cs) p (sLLa $1 $> $ HsCmdTop noExtField cmd)) } | aexp1 { $1 } @@ -2951,7 +2951,7 @@ aexp1 :: { ECP } | aexp1 TIGHT_INFIX_PROJ field {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> - let fl = sLLa $2 (reLoc $>) (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in + let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in mkRdrGetField (noAnnSrcSpan $ comb2 $1 $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } @@ -3037,8 +3037,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) } projection -- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer : projection TIGHT_INFIX_PROJ field - {% acs (\cs -> sLL $1 $> ((sLLa $2 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } - | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 (reLoc $>) $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } + {% acs (\cs -> sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) } + | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) } splice_exp :: { LHsExpr GhcPs } : splice_untyped { fmap (HsUntypedSplice noAnn) (reLocA $1) } @@ -3062,7 +3062,7 @@ cmdargs :: { [LHsCmdTop GhcPs] } acmd :: { LHsCmdTop GhcPs } : aexp {% runPV (unECP $1) >>= \ (cmd :: LHsCmd GhcPs) -> runPV (checkCmdBlockArguments cmd) >>= \ _ -> - return (sL1a (reLoc cmd) $ HsCmdTop noExtField cmd) } + return (sL1a cmd $ HsCmdTop noExtField cmd) } cvtopbody :: { ([AddEpAnn],[LHsDecl GhcPs]) } : '{' cvtopdecls0 '}' { ([mj AnnOpenC $1 @@ -3098,7 +3098,7 @@ texp :: { ECP } runPV (rejectPragmaPV $1) >> runPV $2 >>= \ $2 -> return $ ecpFromExp $ - reLocA $ sLL $1 $> $ SectionL noAnn $1 (n2l $2) } + sLLa $1 $> $ SectionL noAnn $1 (n2l $2) } | qopm infixexp { ECP $ superInfixOp $ unECP $2 >>= \ $2 -> @@ -3350,7 +3350,7 @@ ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } gdpats :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (LocatedA b)]) } : gdpats gdpat { $1 >>= \gdpats -> $2 >>= \gdpat -> - return $ sLL gdpats (reLoc gdpat) (gdpat : unLoc gdpats) } + return $ sLL gdpats gdpat (gdpat : unLoc gdpats) } | gdpat { $1 >>= \gdpat -> return $ sL1 gdpat [gdpat] } -- layout for MultiWayIf doesn't begin with an open brace, because it's hard to @@ -3517,7 +3517,7 @@ fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] } fieldToUpdate -- See Note [Whitespace-sensitive operator parsing] in Lexer.x : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs -> - return (sLL $1 $> ((sLLa $2 (reLoc $>) (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } + return (sLL $1 $> ((sLLa $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) } | field {% getCommentsFor (getLocA $1) >>= \cs -> return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glNR $1) (AnnFieldLabel Nothing) cs) $1)]) } @@ -3562,11 +3562,11 @@ name_boolformula :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and { $1 } | name_boolformula_and '|' name_boolformula {% do { h <- addTrailingVbarL $1 (gl $2) - ; return (reLocA $ sLL $1 $> (Or [h,$3])) } } + ; return (sLLa $1 $> (Or [h,$3])) } } name_boolformula_and :: { LBooleanFormula (LocatedN RdrName) } : name_boolformula_and_list - { reLocA $ sLL (head $1) (last $1) (And ($1)) } + { sLLa (head $1) (last $1) (And ($1)) } name_boolformula_and_list :: { [LBooleanFormula (LocatedN RdrName)] } : name_boolformula_atom { [$1] } @@ -4099,15 +4099,15 @@ comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan comb3 a b c = a `seq` b `seq` c `seq` combineSrcSpans (getHasLoc a) (combineHasLocs b c) -comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan +comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan comb4 a b c d = a `seq` b `seq` c `seq` d `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) (getLoc d)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) (getHasLoc d)) -comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan +comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq` - (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ - combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e)) + (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $ + combineSrcSpans (getHasLoc c) $ combineSrcSpans (getHasLoc d) (getHasLoc e)) -- strict constructor version: {-# INLINE sL #-} @@ -4138,7 +4138,7 @@ sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c sLL x y = sL (comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLa #-} -sLLa :: Located a -> Located b -> c -> LocatedAn t c +sLLa :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedAn t c sLLa x y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL sL (comb2 $1 $>) {-# INLINE sLLAsl #-} ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1008,14 +1008,23 @@ of the type of the method signature. * * ************************************************************************ -This data type is used exclusively by the simplifier, but it appears in a +Note [OccInfo] +~~~~~~~~~~~~~ +The OccInfo data type is used exclusively by the simplifier, but it appears in a SubstResult, which is currently defined in GHC.Types.Var.Env, which is pretty near the base of the module hierarchy. So it seemed simpler to put the defn of -OccInfo here, safely at the bottom +OccInfo here, safely at the bottom. + +Note that `OneOcc` doesn't meant that it occurs /syntactially/ only once; it +means that it is /used/ only once. It might occur syntactically many times. +For example, in (case x of A -> y; B -> y; C -> True), +* `y` is used only once +* but it occurs syntactically twice + -} -- | identifier Occurrence Information -data OccInfo +data OccInfo -- See Note [OccInfo] = ManyOccs { occ_tail :: !TailCallInfo } -- ^ There are many occurrences, or unknown occurrences @@ -1113,8 +1122,9 @@ instance Monoid InsideLam where mappend = (Semi.<>) ----------------- -data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo] - | NoTailCallInfo +data TailCallInfo + = AlwaysTailCalled {-# UNPACK #-} !JoinArity -- See Note [TailCallInfo] + | NoTailCallInfo deriving (Eq) tailCallInfo :: OccInfo -> TailCallInfo ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Types.Var ( -- ** Predicates isId, isTyVar, isTcTyVar, - isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar, + isLocalVar, isLocalId, isLocalId_maybe, isCoVar, isNonCoVarId, isTyCoVar, isGlobalId, isExportedId, mustHaveLocalBinding, @@ -95,6 +95,9 @@ module GHC.Types.Var ( tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, mapVarBndr, mapVarBndrs, + -- ** ExportFlag + ExportFlag(..), + -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -1246,6 +1249,10 @@ isLocalId :: Var -> Bool isLocalId (Id { idScope = LocalId _ }) = True isLocalId _ = False +isLocalId_maybe :: Var -> Maybe ExportFlag +isLocalId_maybe (Id { idScope = LocalId ef }) = Just ef +isLocalId_maybe _ = Nothing + -- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's -- These are the variables that we need to pay attention to when finding free -- variables, or doing dependency analysis. ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -687,7 +687,7 @@ instance heads which unify with @nm tys@, they need not actually be satisfiable. @B@ themselves implement 'Eq' - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available - instance of 'Eq' + instance of 'Show' There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given). ===================================== m4/prep_target_file.m4 ===================================== @@ -58,7 +58,8 @@ AC_DEFUN([PREP_BOOLEAN],[ $1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + $1Bool=False ;; esac AC_SUBST([$1Bool]) @@ -78,7 +79,8 @@ AC_DEFUN([PREP_NOT_BOOLEAN],[ Not$1Bool=False ;; *) - AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1]) + AC_MSG_WARN([m4/prep_target_file.m4: Expecting YES/NO but got $$1 in $1. Defaulting to False.]) + Not$1Bool=False ;; esac AC_SUBST([Not$1Bool]) ===================================== testsuite/tests/simplCore/should_compile/T22404.hs ===================================== @@ -0,0 +1,28 @@ +module T22404 where + +{-# NOINLINE foo #-} +foo :: [a] -> (a,a) +foo [x,y] = (x,y) +foo (x:xs) = foo xs + +data T = A | B | C | D + +-- The point of this test is that 'v' ought +-- not to be a thunk in the optimised program +-- It is used only once in each branch. But we +-- need a clever occurrence analyser to spot it; +-- see Note [Occurrence analysis for join points] +-- in GHC.Core.Opt.OccurAnoa + +f x xs = let v = foo xs in + + let {-# NOINLINE j #-} + j True = case v of (a,b) -> a + j False = case v of (a,b) -> b + in + + case x of + A -> j True + B -> j False + C -> case v of (a,b) -> b + D -> x ===================================== testsuite/tests/simplCore/should_compile/T22404.stderr ===================================== ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -492,3 +492,6 @@ test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], m test('T23074', normal, compile, ['-O -ddump-rules']) test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0']) + +# The -ddump-simpl of T22404 should have no let-bindings +test('T22404', [only_ways(['optasm']), check_errmsg(r'let') ], compile, ['-ddump-simpl -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,133 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 137, types: 92, coercions: 4, joins: 0/0} - -lvl = "error"# - -lvl1 = unpackCString# lvl - -$trModule4 = "main"# - -lvl2 = unpackCString# $trModule4 - -$trModule2 = "T21128a"# - -lvl3 = unpackCString# $trModule2 - -lvl4 = "./T21128a.hs"# - -lvl5 = unpackCString# lvl4 - -lvl6 = I# 4# - -lvl7 = I# 20# - -lvl8 = I# 25# - -lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 - -lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack - -$windexError - = \ @a @b ww eta eta1 eta2 -> - error - (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) - (++ (ww eta) (++ (ww eta1) (ww eta2))) - -indexError - = \ @a @b $dShow eta eta1 eta2 -> - case $dShow of { C:Show ww ww1 ww2 -> - $windexError ww1 eta eta1 eta2 - } - -$trModule3 = TrNameS $trModule4 - -$trModule1 = TrNameS $trModule2 - -$trModule = Module $trModule3 $trModule1 - -$wlvl - = \ ww ww1 ww2 -> - $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) - -index - = \ l u i -> - case l of { I# x -> - case i of { I# y -> - case <=# x y of { - __DEFAULT -> case u of { I# ww -> $wlvl y ww x }; - 1# -> - case u of { I# y1 -> - case <# y y1 of { - __DEFAULT -> $wlvl y y1 x; - 1# -> I# (-# y x) - } - } - } - } - } - - - - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 108, types: 47, coercions: 0, joins: 3/4} - -$trModule4 = "main"# - -$trModule3 = TrNameS $trModule4 - -$trModule2 = "T21128"# - -$trModule1 = TrNameS $trModule2 - -$trModule = Module $trModule3 $trModule1 - -i = I# 1# - -l = I# 0# - -lvl = \ y -> $windexError $fShowInt_$cshow l y l - -lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i - -$wtheresCrud - = \ ww ww1 -> - let { y = I# ww1 } in - join { - lvl2 - = case <=# ww 1# of { - __DEFAULT -> case lvl1 ww y of wild { }; - 1# -> - case <# 1# ww1 of { - __DEFAULT -> case lvl1 ww y of wild { }; - 1# -> -# 1# ww - } - } } in - join { - lvl3 - = case <# 0# ww1 of { - __DEFAULT -> case lvl y of wild { }; - 1# -> 0# - } } in - joinrec { - $wgo ww2 - = case ww2 of wild { - __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump lvl3; - 1# -> jump lvl2 - }; } in - jump $wgo ww - -theresCrud - = \ x y -> - case x of { I# ww -> - case y of { I# ww1 -> - case $wtheresCrud ww ww1 of ww2 { __DEFAULT -> I# ww2 } - } - } - - - ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -84,8 +84,11 @@ test('T20510', [ grep_errmsg(r'jump \$wgo') ], compile, ['-dsuppress-uniques -dd test('T20817', [ grep_errmsg(r'Str') ], compile, ['-dsuppress-uniques -ddump-stranal']) # T21150: Check that t{,1,2} haven't been inlined. test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques -ddump-exitify']) + # T21128: Check that y is not reboxed in $wtheresCrud +# If so, there should be no `let` for y test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) + test('T21265', normal, compile, ['']) test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ae42f562de3dbc5d80e1323523bfd83f317ad6f...9a23a293f7ff0c3c9641ae0241bdefe0fc7960c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ae42f562de3dbc5d80e1323523bfd83f317ad6f...9a23a293f7ff0c3c9641ae0241bdefe0fc7960c6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 18:38:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 26 Jul 2023 14:38:24 -0400 Subject: [Git][ghc/ghc][wip/tsan/prep] 19 commits: ghc-toolchain: Initial commit Message-ID: <64c168204693d_2fb451b9ac84339b8@gitlab.mail> Ben Gamari pushed to branch wip/tsan/prep at Glasgow Haskell Compiler / GHC Commits: 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 5166e3cc by Ben Gamari at 2023-07-26T14:38:18-04:00 compiler: Style fixes - - - - - 1175632b by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 471eb500 by Ben Gamari at 2023-07-26T14:38:18-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - ae5888d0 by Ben Gamari at 2023-07-26T14:38:18-04:00 testsuite: Add AtomicModifyIORef test - - - - - dae5a29e by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - cdc1a61d by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 2d8f2ac1 by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce more principled fence operations - - - - - 5b0aab1e by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce SET_INFO_RELAXED - - - - - 65bd7826 by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Style fixes - - - - - 26 changed files: - .gitlab-ci.yml - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a38fa0bf4b47628014ff747eacbb1e982b4fa6ab...65bd78267375d8c2b4bc0b4ac9fd7563c4050539 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a38fa0bf4b47628014ff747eacbb1e982b4fa6ab...65bd78267375d8c2b4bc0b4ac9fd7563c4050539 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 18:42:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 14:42:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: This MR is an implementation of the proposal #516. Message-ID: <64c16932254e4_2fb451b9ac8435976@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 631b386a by Bartłomiej Cieślar at 2023-07-26T14:42:51-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - c6355608 by Arnaud Spiwack at 2023-07-26T14:42:54-04:00 Fix user-facing label in MR template - - - - - 30 changed files: - .gitlab/merge_request_templates/Default.md - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/TyThing.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-warnings.rst - testsuite/tests/plugins/all.T - + testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel1.hs - + testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel1.stderr - + testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel2.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/702e3410358013be82c82c47237740c4a7d0b533...c6355608317226a0e46c8c70eb707a7e4169bded -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/702e3410358013be82c82c47237740c4a7d0b533...c6355608317226a0e46c8c70eb707a7e4169bded You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 18:56:19 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 26 Jul 2023 14:56:19 -0400 Subject: [Git][ghc/ghc][wip/expand-do] fixing location infos for stmts and their expansions Message-ID: <64c16c535dc3a_2fb451b9a3c44863f@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 59168671 by Apoorv Ingle at 2023-07-26T13:56:05-05:00 fixing location infos for stmts and their expansions - - - - - 3 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -301,6 +301,7 @@ dsExpr (HsLamCase _ lc_variant matches) dsExpr e@(HsApp _ fun arg) = do { fun' <- dsLExpr fun ; arg' <- dsLExpr arg + ; tracePm "HsToCore dsExpr HsApp" (vcat [ppr fun, ppr arg]) ; warnUnusedBindValue fun arg (exprType arg') ; return $ mkCoreAppDs (text "HsApp" <+> ppr e) fun' arg' } ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -369,7 +369,7 @@ tcApp rn_expr exp_res_ty -- setSrcSpanA loc $ -- addStmtCtxt (text "tcApp VACall stmt") stmt thing_inside | insideExpansion fun_ctxt - , VAExpansionStmt stmt loc <- fun_ctxt + , VAExpansionStmt (L _ stmt) loc <- fun_ctxt = do traceTc "tcApp" (vcat [text "VAExpansionStmt", ppr stmt, ppr loc, ppr rn_fun, ppr fun_ctxt]) --setSrcSpan loc $ addStmtCtxt (text "tcApp VAExpansionStmt") stmt @@ -827,43 +827,29 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside setSrcSpanA arg_loc $ addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside - VAExpansionStmt stmt@(BodyStmt{}) loc + VAExpansionStmt stmt@(L loc BodyStmt{}) _ -> do traceTc "addArgCtxt 2e body" empty - setSrcSpan loc $ - addStmtCtxt ((text "addArgCtxt 2e")) stmt $ + setSrcSpanA loc $ + addStmtCtxt ((text "addArgCtxt 2e")) (unLoc stmt) $ thing_inside - VAExpansionStmt stmt@(LastStmt {}) loc + VAExpansionStmt stmt@(L _ LastStmt {}) loc -> do traceTc "addArgCtxt 2e last" empty setSrcSpan loc $ - addStmtCtxt ((text "addArgCtxt last 2e")) stmt $ + addStmtCtxt ((text "addArgCtxt last 2e")) (unLoc stmt) $ thing_inside - VAExpansionStmt stmt@(BindStmt {}) loc + VAExpansionStmt stmt@(L _ BindStmt {}) loc -> do traceTc "addArgCtxt 2e bind" empty setSrcSpan loc $ - -- (if in_generated_code && in_src_ctxt - -- then - addStmtCtxt ((text "addArgCtxt bind 2e")) stmt $ - -- else id) $ + addStmtCtxt ((text "addArgCtxt bind 2e")) (unLoc stmt) $ thing_inside - VAExpansionStmt (LetStmt {}) _ + VAExpansionStmt (L _ LetStmt {}) _ -> do traceTc "addArgCtxt 2e let" empty thing_inside _ -> do traceTc "addArgCtxt 3" empty setSrcSpanA arg_loc $ addExprCtxt (text "addArgCtxt 3") arg $ -- Auto-suppressed if arg_loc is generated thing_inside } - -- where - -- is_then_fun :: HsExpr GhcRn -> Bool - -- is_then_fun (HsVar _ (L _ f)) = f == thenMName - -- is_then_fun _ = False - - -- is_bind_fun :: HsExpr GhcRn -> Bool - -- is_bind_fun (HsVar _ (L _ f)) = f == bindMName - -- is_bind_fun _ = False - - -- mk_body_stmt :: HsExpr GhcRn -> ExprLStmt GhcRn - -- mk_body_stmt e = L arg_loc (BodyStmt noExtField (L arg_loc e) NoSyntaxExprRn NoSyntaxExprRn) {- ********************************************************************* ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -209,7 +209,7 @@ data AppCtxt SrcSpan -- The SrcSpan of the expression -- noSrcSpan if outermost; see Note [AppCtxt] | VAExpansionStmt - (ExprStmt GhcRn) -- Inside an expansion of this do stmt + (ExprLStmt GhcRn) -- Inside an expansion of this do stmt SrcSpan -- location of this statement | VACall @@ -329,9 +329,13 @@ splitHsApps e = go e (top_ctxt 0 e) [] = go fun (VAExpansion orig (appCtxtLoc ctxt)) (EWrap (EExpand orig) : args) - go (XExpr (ExpandedStmt (HsExpanded stmt fun))) _ args - = go fun (VAExpansionStmt (unLoc stmt) generatedSrcSpan) - (EWrap (EExpandStmt stmt) : args) + go (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) fun))) _ args + | BodyStmt{} <- s + = go fun (VAExpansionStmt stmt generatedSrcSpan) + (EWrap (EExpandStmt stmt) : args) + | otherwise + = go fun (VAExpansionStmt stmt (locA loc)) + (EWrap (EExpandStmt stmt) : args) -- See Note [Desugar OpApp in the typechecker] go e@(OpApp _ arg1 (L l op) arg2) _ args @@ -840,8 +844,8 @@ tcInferAppHead_maybe fun args _ -> return Nothing addHeadCtxt :: AppCtxt -> TcM a -> TcM a -addHeadCtxt (VAExpansionStmt stmt loc) thing_inside = - do setSrcSpan loc $ +addHeadCtxt (VAExpansionStmt (L loc stmt) _) thing_inside = + do setSrcSpanA loc $ addStmtCtxt (text "addHeadCtxt") stmt thing_inside addHeadCtxt fun_ctxt thing_inside View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5916867163003619fe52b5c6730fbfcf37721bff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5916867163003619fe52b5c6730fbfcf37721bff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 19:29:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 26 Jul 2023 15:29:20 -0400 Subject: [Git][ghc/ghc][wip/tsan/cmm-codegen] 23 commits: ghc-toolchain: Initial commit Message-ID: <64c174106de72_2fb451b9ab4480847@gitlab.mail> Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC Commits: 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 5166e3cc by Ben Gamari at 2023-07-26T14:38:18-04:00 compiler: Style fixes - - - - - 1175632b by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 471eb500 by Ben Gamari at 2023-07-26T14:38:18-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - ae5888d0 by Ben Gamari at 2023-07-26T14:38:18-04:00 testsuite: Add AtomicModifyIORef test - - - - - dae5a29e by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - cdc1a61d by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 2d8f2ac1 by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce more principled fence operations - - - - - 5b0aab1e by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce SET_INFO_RELAXED - - - - - 65bd7826 by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Style fixes - - - - - ecf789cb by Ben Gamari at 2023-07-26T14:38:43-04:00 codeGen/tsan: Rework handling of spilling - - - - - 8280e720 by Ben Gamari at 2023-07-26T14:38:43-04:00 hadrian: More debug information - - - - - 86d7e5dc by Ben Gamari at 2023-07-26T14:38:43-04:00 Improve TSAN documentation - - - - - dbc86a80 by Ben Gamari at 2023-07-26T14:38:43-04:00 hadrian: More selective TSAN instrumentation - - - - - 27 changed files: - .gitlab-ci.yml - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs - configure.ac - distrib/configure.ac.in - hadrian/.gitignore - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/bootstrap/generate_bootstrap_plans - hadrian/bootstrap/plan-9_2_1.json - hadrian/bootstrap/plan-9_2_2.json - hadrian/bootstrap/plan-9_2_3.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7543770667bc95d953665ecffbdeab9ac1f12940...dbc86a80ddcfe59277a764d94482bcdd62ad715a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7543770667bc95d953665ecffbdeab9ac1f12940...dbc86a80ddcfe59277a764d94482bcdd62ad715a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 19:57:54 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 26 Jul 2023 15:57:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/locateda-epa-improve-2023-07-15-b Message-ID: <64c17ac2e6456_2fb451b9adc493066@gitlab.mail> Alan Zimmerman pushed new branch wip/az/locateda-epa-improve-2023-07-15-b at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/locateda-epa-improve-2023-07-15-b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 20:13:08 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 26 Jul 2023 16:13:08 -0400 Subject: [Git][ghc/ghc][wip/T22404] Make the occurrence analyser smarter about join points Message-ID: <64c17e54e43c3_2fb451b9a505026f7@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 6057a770 by Simon Peyton Jones at 2023-07-26T21:12:33+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 1% CoOpt_Read(normal) ghc/alloc 766,003,076 748,985,544 -2.2% GOOD T10858(normal) ghc/alloc 120,782,748 118,735,744 -1.7% T11545(normal) ghc/alloc 79,829,332 78,722,128 -1.4% T12150(optasm) ghc/alloc 73,881,192 72,854,208 -1.4% T13056(optasm) ghc/alloc 294,495,436 290,226,600 -1.4% T13253(normal) ghc/alloc 364,663,144 361,043,432 -1.0% T13253-spj(normal) ghc/alloc 118,248,796 59,996,856 -49.3% GOOD T15164(normal) ghc/alloc 1,102,607,920 1,087,375,984 -1.4% T15304(normal) ghc/alloc 1,196,061,524 1,155,296,336 -3.4% T15630(normal) ghc/alloc 148,707,300 147,104,768 -1.1% T17516(normal) ghc/alloc 1,657,993,132 1,626,735,192 -1.9% T17836(normal) ghc/alloc 395,306,932 391,219,640 -1.0% T18140(normal) ghc/alloc 71,948,496 73,206,920 +1.7% T18282(normal) ghc/alloc 129,090,864 131,483,440 +1.9% T18698b(normal) ghc/alloc 230,313,396 233,017,416 +1.2% BAD T4801(normal) ghc/alloc 247,568,452 250,836,624 +1.3% T9233(normal) ghc/alloc 709,634,020 685,363,720 -3.4% GOOD T9630(normal) ghc/alloc 965,838,132 942,010,984 -2.5% GOOD T9675(optasm) ghc/alloc 444,583,940 429,417,416 -3.4% GOOD T9961(normal) ghc/alloc 303,041,544 307,384,192 +1.4% BAD WWRec(normal) ghc/alloc 503,706,372 495,554,224 -1.6% geo. mean -1.0% minimum -49.3% maximum +1.9% The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 Metric Increase: T18698b T9961 - - - - - 13 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Var.hs - + testsuite/tests/simplCore/should_compile/T22404.hs - + testsuite/tests/simplCore/should_compile/T22404.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1948,6 +1948,7 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- manifest arity for join points = -- pprTrace "finaliseArgBoxities" ( -- vcat [text "function:" <+> ppr fn + -- , text "max" <+> ppr max_wkr_args -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ (arg_dmds', set_lam_dmds arg_dmds' rhs) ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1,7 +1,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} +{-# OPTIONS_GHC -cpp -Wno-incomplete-record-updates #-} + +{-# OPTIONS_GHC -fmax-worker-args=12 #-} +-- The -fmax-worker-args=12 is there because the main functions +-- are strict in the OccEnv, and it turned out that with the default settting +-- some functions would unbox the OccEnv ad some would not, depending on how +-- many /other/ arguments the function has. Inconsistent unboxing is very +-- bad for performance, so I increased the limit to allow it to unbox +-- consistently. {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -58,9 +66,7 @@ import GHC.Utils.Misc import GHC.Builtin.Names( runRWKey ) import GHC.Unit.Module( Module ) -import Data.List (mapAccumL, mapAccumR) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE +import Data.List (mapAccumL) {- ************************************************************************ @@ -76,7 +82,7 @@ Here's the externally-callable interface: occurAnalyseExpr :: CoreExpr -> CoreExpr occurAnalyseExpr expr = expr' where - (WithUsageDetails _ expr') = occAnal initOccEnv expr + WUD _ expr' = occAnal initOccEnv expr occurAnalysePgm :: Module -- Used only in debug output -> (Id -> Bool) -- Active unfoldings @@ -94,8 +100,8 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds init_env = initOccEnv { occ_rule_act = active_rule , occ_unf_act = active_unf } - (WithUsageDetails final_usage occ_anald_binds) = go init_env binds - (WithUsageDetails _ occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel + WUD final_usage occ_anald_binds = go binds init_env + WUD _ occ_anald_glommed_binds = occAnalRecBind init_env TopLevel imp_rule_edges (flattenBinds binds) initial_uds @@ -127,14 +133,10 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds -- Not BuiltinRules; see Note [Plugin rules] , let rhs_fvs = exprFreeIds rhs `delVarSetList` bndrs ] - go :: OccEnv -> [CoreBind] -> WithUsageDetails [CoreBind] - go !_ [] - = WithUsageDetails initial_uds [] - go env (bind:binds) - = WithUsageDetails final_usage (bind' ++ binds') - where - (WithUsageDetails bs_usage binds') = go env binds - (WithUsageDetails final_usage bind') = occAnalBind env TopLevel imp_rule_edges bind bs_usage + go :: [CoreBind] -> OccEnv -> WithUsageDetails [CoreBind] + go [] _ = WUD initial_uds [] + go (bind:binds) env = occAnalBind env TopLevel + imp_rule_edges bind (go binds) (++) {- ********************************************************************* * * @@ -599,7 +601,144 @@ This showed up when compiling Control.Concurrent.Chan.getChanContents. Hence the transitive rule_fv_env stuff described in Note [Rules and loop breakers]. ------------------------------------------------------------- +Note [Occurrence analysis for join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider these two somewhat artificial programs (#22404) + + Program (P1) Program (P2) + ------------------------------ ------------------------------------- + let v = in let v = in + join j = case v of (a,b) -> a + in case x of in case x of + A -> case v of (a,b) -> a A -> j + B -> case v of (a,b) -> a B -> j + C -> case v of (a,b) -> b C -> case v of (a,b) -> b + D -> [] D -> [] + +In (P1), `v` gets allocated, as a thunk, every time this code is executed. But +notice that `v` occurs at most once in any case branch; the occurrence analyser +spots this and returns a OneOcc{ occ_n_br = 3 } for `v`. Then the code in +GHC.Core.Opt.Simplify.Utils.postInlineUnconditionally inlines `v` at its three +use sites, and discards the let-binding. That way, we avoid allocating `v` in +the A,B,C branches (though we still compute it of course), and branch D +doesn't involve at all. This sometimes makes a Really Big +Difference. + +In (P2) we have shared the common RHS of A, B, in a join point `j`. We would +like to inline `v` in just the same way as in (P1). But the usual strategy +for let bindings is conservative and uses `andUDs` to combine usage from j's +RHS to its body; as if `j` was called on every code path (once, albeit). In +the case of (P2), we'll get ManyOccs for `v`. Important optimisation lost! + +Solving this problem makes the Simplifier less fragile. For example, +the Simplifier might inline `j`, and convert (P2) into (P1)... or it might +not, depending in a perhaps-fragile way on the size of the join point. +I was motivated to implement this feature of the occurrence analyser +when trying to make optimisation join points simpler and more robust +(see e.g. #23627). + +The occurrence analyser therefore has clever code that behaves just as +if you inlined `j` at all its call sites. Here is a tricky variant +to keep in mind: + + Program (P3) + ------------------------------- + join j = case v of (a,b) -> a + in case f v of + A -> j + B -> j + C -> [] + +If you mentally inline `j` you'll see that `v` is used twice on the path +through A, so it should have ManyOcc. Bear this case in mind! + +* We treat /non-recursive/ join points specially. Recursive join points are + treated like any other letrec, as before. Moreover, we only give this special + treatment to /pre-existing/ non-recursive join points, not the ones that we + discover for the first time in this sweep of the occurrence analyser. + +* In occ_env, the new (occ_join_points :: IdEnv OccInfoEnv) maps + each in-scope non-recursive join point, such as `j` above, to + a "zeroed form" of its RHS's usage details. The "zeroed form" + * deletes ManyOccs + * maps a OneOcc to OneOcc{ occ_n_br = 0 } + In our example, occ_join_points will be extended with + [j :-> [v :-> OneOcc{occ_n_br=0}]] + See addJoinPoint. + +* At an occurence of a join point, we do everything as normal, but add in the + UsageDetails from the occ_join_points. See mkOneOcc. + +* Crucially, at the NonRec binding of the join point, in `occAnalBind`, we use + `orUDs`, not `andUDs` to combine the usage from the RHS with the usage from + the body. + +Here are the consequences + +* Because of the perhaps-surprising OneOcc{occ_n_br=0} idea of the zeroed + form, the occ_n_br field of a OneOcc binder still counts the number of + /actual lexical occurrences/ of the variable. In Program P2, for example, + `v` will end up with OneOcc{occ_n_br=2}, not occ_n_br=3. + There are two lexical occurrences of `v`! + (NB: `orUDs` adds occ_n_br together, so occ_n_br=1 is impossible, too.) + +* In the tricky (P3) we'll get an `andUDs` of + * OneOcc{occ_n_br=0} from the occurrences of `j`) + * OneOcc{occ_n_br=1} from the (f v) + These are `andUDs` together in `addOccInfo`, and hence + `v` gets ManyOccs, just as it should. Clever! + +There are a couple of tricky wrinkles + +(W1) Consider this example which shadows `j`: + join j = rhs in + in case x of { K j -> ..j..; ... } + Clearly when we come to the pattern `K j` we must drop the `j` + entry in occ_join_points. + + This is done by `drop_shadowed_joins` in `addInScope`. + +(W2) Consider this example which shadows `v`: + join j = ...v... + in case x of { K v -> ..j..; ... } + + We can't make j's occurrences in the K alternative give rise to an + occurrence of `v` (via occ_join_points), because it'll just be deleted by + the `K v` pattern. Yikes. This is rare because shadowing is rare, but + it definitely can happen. Solution: when bringing `v` into scope at + the `K v` pattern, chuck out of occ_join_points any elements whose + UsageDetails mentions `v`. Instead, just `andUDs` all that usage in + right here. + + This requires work in two places. + * In `preprocess_env`, we detect if the newly-bound variables intersect + the free vars of occ_join_points. (These free vars are conveniently + simply the domain of the OccInfoEnv for that join point.) If so, + we zap the entire occ_join_points. + * In `postprcess_uds`, we add the chucked-out join points to the + returned UsageDetails, with `andUDs`. + +(W3) Consider this example, which shadows `j`, but this time in an argument + join j = rhs + in f (case x of { K j -> ...; ... }) + We can zap the entire occ_join_points when looking at the argument, + because `j` can't posibly occur -- it's a join point! And the smaller + occ_join_points is, the better. Smaller to look up in mkOneOcc, and + more important, less looking-up when checking (W2). + + This is done in setNonTailCtxt. It's important /not/ to do this for + join-point RHS's because of course `j` can occur there! + + NB: this is just about efficiency: it is always safe /not/ to zap the + occ_join_points. + +(W4) What if the join point binding has a stable unfolding, or RULES? + They are just alternative right-hand sides, and at each call site we + will use only one of them. So again, we can use `orUDs` to combine + usage info from all these alternatives RHSs. + +Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3). + Note [Finding join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~ It's the occurrence analyser's job to find bindings that we can turn into join @@ -817,78 +956,134 @@ of both functions, serving as a specification: Non-recursive case: 'adjustNonRecRhs' -} -data WithUsageDetails a = WithUsageDetails !UsageDetails !a - -data WithTailUsageDetails a = WithTailUsageDetails !TailUsageDetails !a - ------------------------------------------------------------------ -- occAnalBind ------------------------------------------------------------------ -occAnalBind :: OccEnv -- The incoming OccEnv - -> TopLevelFlag - -> ImpRuleEdges - -> CoreBind - -> UsageDetails -- Usage details of scope - -> WithUsageDetails [CoreBind] -- Of the whole let(rec) - -occAnalBind !env lvl top_env (NonRec binder rhs) body_usage - = occAnalNonRecBind env lvl top_env binder rhs body_usage -occAnalBind env lvl top_env (Rec pairs) body_usage - = occAnalRecBind env lvl top_env pairs body_usage - ------------------ -occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr - -> UsageDetails -> WithUsageDetails [CoreBind] -occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage +occAnalBind + :: OccEnv + -> TopLevelFlag + -> ImpRuleEdges + -> CoreBind + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> ([CoreBind] -> r -> r) -- How to combine the scope with new binds + -> WithUsageDetails r -- Of the whole let(rec) + +occAnalBind env lvl ire (Rec pairs) thing_inside combine + = addInScopeList env (map fst pairs) $ \env -> + let WUD body_uds body' = thing_inside env + WUD bind_uds binds' = occAnalRecBind env lvl ire pairs body_uds + in WUD bind_uds (combine binds' body') + +occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine | isTyVar bndr -- A type let; we don't gather usage info - = WithUsageDetails body_usage [NonRec bndr rhs] + = let !(WUD body_uds res) = addInScopeOne env bndr thing_inside + in WUD body_uds (combine [NonRec bndr rhs] res) + + -- /Existing/ non-recursive join points + -- See Note [Occurrence analysis for join points] + | mb_join@(Just {}) <- isJoinId_maybe bndr + = -- Analyse the RHS and /then/ the body + let -- Analyse the rhs first, generating rhs_uds + !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs + rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of + -- Note [Occurrence analysis for join points] + + -- Now analyse the body, adding the join point + -- into the environment with addJoinPoint + !(WUD body_uds (occ, body)) = occAnalNonRecBody env bndr' $ \env -> + thing_inside (addJoinPoint env bndr' rhs_uds) + in + if isDeadOcc occ -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` + (combine [NonRec (tagNonRecBinder lvl occ bndr') rhs'] + body) + + -- The normal case, including newly-discovered join points + -- Analyse the body and /then/ the RHS + | WUD body_uds (occ,body) <- occAnalNonRecBody env bndr thing_inside + = if isDeadOcc occ -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else let + -- Get the join info from the *new* decision; NB: bndr is not already a JoinId + -- See Note [Join points and unfoldings/rules] + -- => join arity O of Note [Join arity prediction based on joinRhsArity] + tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join = case tailCallInfo occ of + AlwaysTailCalled arity -> Just arity + _ -> Nothing + + !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs + in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs` + (combine [NonRec final_bndr rhs'] body) - | not (bndr `usedIn` body_usage) - = WithUsageDetails body_usage [] -- See Note [Dead code] +----------------- +occAnalNonRecBody :: OccEnv -> Id + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> (WithUsageDetails (OccInfo, r)) +occAnalNonRecBody env bndr thing_inside + = addInScopeOne env bndr $ \env -> + let !(WUD inner_uds res) = thing_inside env + !occ = lookupLetOccInfo inner_uds bndr + in WUD inner_uds (occ, res) - | otherwise -- It's mentioned in the body - = WithUsageDetails (body_usage' `andUDs` rhs_usage) [NonRec final_bndr final_rhs] +----------------- +occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity + -> Id -> CoreExpr + -> ([UsageDetails], Id, CoreExpr) +occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs + | null rules, null imp_rule_infos + = -- Fast path for common case of no rules. This is only worth + -- 0.1% perf on average, but it's also only a line or two of code + ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs ) + | otherwise + = (adj_rhs_uds : adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs ) where - WithUsageDetails body_usage' tagged_bndr = tagNonRecBinder lvl body_usage bndr - - -- Get the join info from the *new* decision - -- See Note [Join points and unfoldings/rules] - -- => join arity O of Note [Join arity prediction based on joinRhsArity] - mb_join_arity = willBeJoinId_maybe tagged_bndr - is_join_point = isJust mb_join_arity + is_join_point = isJust mb_join --------- Right hand side --------- - env1 | is_join_point = env -- See Note [Join point RHSs] - | certainly_inline = env -- See Note [Cascading inlines] - | otherwise = rhsCtxt env + -- For join points, set occ_encl to OccVanilla, via setTailCtxt. If we have + -- join j = Just (f x) in ... + -- we do not want to float the (f x) to + -- let y = f x in join j = Just y in ... + -- That's that OccRhs would do; but there's no point because + -- j will never be scrutinised. + env1 | is_join_point = setTailCtxt env + | otherwise = setNonTailCtxt rhs_ctxt env -- Zap occ_join_points + rhs_ctxt = mkNonRecRhsCtxt bndr unf -- See Note [Sources of one-shot information] - rhs_env = env1 { occ_one_shots = argOneShots dmd } + rhs_env = addOneShotsFromDmd bndr env1 -- See Note [Join arity prediction based on joinRhsArity] -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS - WithUsageDetails adj_rhs_uds final_rhs - = adjustNonRecRhs mb_join_arity $ occAnalLamTail rhs_env rhs - rhs_usage = adj_rhs_uds `andUDs` adj_unf_uds `andUDs` adj_rule_uds - final_bndr = tagged_bndr `setIdSpecialisation` mkRuleInfo rules' - `setIdUnfolding` unf2 + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ + occAnalLamTail rhs_env rhs + final_bndr_with_rules + | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdSpecialisation` mkRuleInfo rules' + `setIdUnfolding` unf2 + final_bndr_no_rules + | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdUnfolding` unf2 --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] - unf | isId bndr = idUnfolding bndr - | otherwise = NoUnfolding - WithTailUsageDetails unf_uds unf1 = occAnalUnfolding rhs_env unf - unf2 = markNonRecUnfoldingOneShots mb_join_arity unf1 - adj_unf_uds = adjustTailArity mb_join_arity unf_uds + unf = idUnfolding bndr + WTUD unf_tuds unf1 = occAnalUnfolding rhs_env unf + unf2 = markNonRecUnfoldingOneShots mb_join unf1 + adj_unf_uds = adjustTailArity mb_join unf_tuds --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] -- and Note [Join points and unfoldings/rules] - rules_w_uds = occAnalRules rhs_env bndr + rules = idCoreRules bndr + rules_w_uds = map (occAnalRule rhs_env) rules rules' = map fstOf3 rules_w_uds - imp_rule_uds = impRulesScopeUsage (lookupImpRules imp_rule_edges bndr) + imp_rule_infos = lookupImpRules imp_rule_edges bndr + imp_rule_uds = [impRulesScopeUsage imp_rule_infos] -- imp_rule_uds: consider -- h = ... -- g = ... @@ -897,21 +1092,27 @@ occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage -- that g is (since the RULE might turn g into h), so -- we make g mention h. - adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds - add_rule_uds (_, l, r) uds - = l `andUDs` adjustTailArity mb_join_arity r `andUDs` uds + adj_rule_uds :: [UsageDetails] + adj_rule_uds = imp_rule_uds ++ + [ l `andUDs` adjustTailArity mb_join r + | (_,l,r) <- rules_w_uds ] - ---------- - occ = idOccInfo tagged_bndr +mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl +-- Precondition: Id is not a join point +mkNonRecRhsCtxt bndr unf + | certainly_inline = OccVanilla -- See Note [Cascading inlines] + | otherwise = OccRhs + where certainly_inline -- See Note [Cascading inlines] - = case occ of + = -- mkNonRecRhsCtxt is only used for non-join points, so occAnalBind + -- has set the OccInfo for this binder before calling occAnalNonRecRhs + case idOccInfo bndr of OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 } -> active && not_stable _ -> False - dmd = idDemandInfo bndr active = isAlwaysActive (idInlineActivation bndr) - not_stable = not (isStableUnfolding (idUnfolding bndr)) + not_stable = not (isStableUnfolding unf) ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] @@ -921,38 +1122,17 @@ occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] -- * compute strongly-connected components -- * feed those components to occAnalRec -- See Note [Recursive bindings: the grand plan] -occAnalRecBind !env lvl imp_rule_edges pairs body_usage - = foldr (occAnalRec rhs_env lvl) (WithUsageDetails body_usage []) sccs +occAnalRecBind !rhs_env lvl imp_rule_edges pairs body_usage + = foldr (occAnalRec rhs_env lvl) (WUD body_usage []) sccs where sccs :: [SCC NodeDetails] - sccs = {-# SCC "occAnalBind.scc" #-} - stronglyConnCompFromEdgedVerticesUniq nodes + sccs = stronglyConnCompFromEdgedVerticesUniq nodes nodes :: [LetrecNode] - nodes = {-# SCC "occAnalBind.assoc" #-} - map (makeNode rhs_env imp_rule_edges bndr_set) pairs + nodes = map (makeNode rhs_env imp_rule_edges bndr_set) pairs bndrs = map fst pairs bndr_set = mkVarSet bndrs - rhs_env = env `addInScope` bndrs - -adjustNonRecRhs :: Maybe JoinArity -> WithTailUsageDetails CoreExpr -> WithUsageDetails CoreExpr --- ^ This function concentrates shared logic between occAnalNonRecBind and the --- AcyclicSCC case of occAnalRec. --- * It applies 'markNonRecJoinOneShots' to the RHS --- * and returns the adjusted rhs UsageDetails combined with the body usage -adjustNonRecRhs mb_join_arity (WithTailUsageDetails rhs_tuds rhs) - = WithUsageDetails rhs_uds' rhs' - where - --------- Marking (non-rec) join binders one-shot --------- - !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs - | otherwise = rhs - --------- Adjusting right-hand side usage --------- - rhs_uds' = adjustTailUsage mb_join_arity rhs' rhs_tuds - -bindersOfSCC :: SCC NodeDetails -> [Var] -bindersOfSCC (AcyclicSCC nd) = [nd_bndr nd] -bindersOfSCC (CyclicSCC ds) = map nd_bndr ds ----------------------------- occAnalRec :: OccEnv -> TopLevelFlag @@ -960,39 +1140,47 @@ occAnalRec :: OccEnv -> TopLevelFlag -> WithUsageDetails [CoreBind] -> WithUsageDetails [CoreBind] --- Check for Note [Dead code] --- NB: Only look at body_uds, ignoring uses in the SCC -occAnalRec !_ _ scc (WithUsageDetails body_uds binds) - | not (any (`usedIn` body_uds) (bindersOfSCC scc)) - = WithUsageDetails body_uds binds - -- The NonRec case is just like a Let (NonRec ...) above occAnalRec !_ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds })) - (WithUsageDetails body_uds binds) - = WithUsageDetails (body_uds' `andUDs` rhs_uds') (NonRec bndr' rhs' : binds) + (WUD body_uds binds) + | isDeadOcc occ -- Check for dead code: see Note [Dead code] + = WUD body_uds binds + | otherwise + = let tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join_arity = willBeJoinId_maybe tagged_bndr + !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join_arity wtuds + !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) + !bndr' = tagged_bndr `setIdUnfolding` unf' + in WUD (body_uds `andUDs` rhs_uds') + (NonRec bndr' rhs' : binds) where - WithUsageDetails body_uds' tagged_bndr = tagNonRecBinder lvl body_uds bndr - mb_join_arity = willBeJoinId_maybe tagged_bndr - WithUsageDetails rhs_uds' rhs' = adjustNonRecRhs mb_join_arity wtuds - !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) - !bndr' = tagged_bndr `setIdUnfolding` unf' + occ = lookupLetOccInfo body_uds bndr -- The Rec case is the interesting one -- See Note [Recursive bindings: the grand plan] -- See Note [Loop breaking] -occAnalRec env lvl (CyclicSCC details_s) (WithUsageDetails body_uds binds) - = -- pprTrace "occAnalRec" (ppr loop_breaker_nodes) - WithUsageDetails final_uds (Rec pairs : binds) +occAnalRec env lvl (CyclicSCC details_s) (WUD body_uds binds) + | not (any needed details_s) + = -- Check for dead code: see Note [Dead code] + -- NB: Only look at body_uds, ignoring uses in the SCC + WUD body_uds binds + + | otherwise + = WUD final_uds (Rec pairs : binds) where all_simple = all nd_simple details_s + needed :: NodeDetails -> Bool + needed (ND { nd_bndr = bndr }) = isExportedId bndr || bndr `elemVarEnv` body_env + body_env = ud_env body_uds + ------------------------------ -- Make the nodes for the loop-breaker analysis -- See Note [Choosing loop breakers] for loop_breaker_nodes final_uds :: UsageDetails loop_breaker_nodes :: [LoopBreakerNode] - (WithUsageDetails final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s + WUD final_uds loop_breaker_nodes = mkLoopBreakerNodes env lvl body_uds details_s ------------------------------ weak_fvs :: VarSet @@ -1481,7 +1669,8 @@ instance Outputable NodeDetails where , text "simple =" <+> ppr (nd_simple nd) , text "active_rule_fvs =" <+> ppr (nd_active_rule_fvs nd) ]) - where WithTailUsageDetails uds _ = nd_rhs nd + where + WTUD uds _ = nd_rhs nd -- | Digraph with simplified and completely occurrence analysed -- 'SimpleNodeDetails', retaining just the info we need for breaking loops. @@ -1517,7 +1706,8 @@ makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> LetrecNode -- See Note [Recursive bindings: the grand plan] makeNode !env imp_rule_edges bndr_set (bndr, rhs) - = DigraphNode { node_payload = details + = -- pprTrace "makeNode" (ppr bndr <+> ppr (sizeVarSet bndr_set)) $ + DigraphNode { node_payload = details , node_key = varUnique bndr , node_dependencies = nonDetKeysUniqSet scope_fvs } -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR @@ -1525,20 +1715,20 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. where details = ND { nd_bndr = bndr' - , nd_rhs = WithTailUsageDetails scope_uds rhs' + , nd_rhs = WTUD (TUD rhs_ja unadj_scope_uds) rhs' , nd_inl = inl_fvs , nd_simple = null rules_w_uds && null imp_rule_info , nd_weak_fvs = weak_fvs , nd_active_rule_fvs = active_rule_fvs } - bndr' = bndr `setIdUnfolding` unf' - `setIdSpecialisation` mkRuleInfo rules' + bndr' | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' -- NB: Both adj_unf_uds and adj_rule_uds have been adjusted to match the -- JoinArity rhs_ja of unadj_rhs_uds. unadj_inl_uds = unadj_rhs_uds `andUDs` adj_unf_uds unadj_scope_uds = unadj_inl_uds `andUDs` adj_rule_uds - scope_uds = TUD rhs_ja unadj_scope_uds -- Note [Rules are extra RHSs] -- Note [Rule dependency info] scope_fvs = udFreeVars bndr_set unadj_scope_uds @@ -1547,7 +1737,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) inl_fvs = udFreeVars bndr_set unadj_inl_uds -- inl_fvs: vars that would become free if the function was inlined. - -- We conservatively approximate that by thefree vars from the RHS + -- We conservatively approximate that by the free vars from the RHS -- and the unfolding together. -- See Note [inl_fvs] @@ -1566,15 +1756,18 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- Instead, do the occAnalLamTail call here and postpone adjustTailUsage -- until occAnalRec. In effect, we pretend that the RHS becomes a -- non-recursive join point and fix up later with adjustTailUsage. - rhs_env = rhsCtxt env - WithTailUsageDetails (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs - -- corresponding call to adjustTailUsage in occAnalRec and tagRecBinders + rhs_env | isJoinId bndr = setTailCtxt env + | otherwise = setNonTailCtxt OccRhs env + -- If bndr isn't an /existing/ join point, it's safe to zap the + -- occ_join_points, because they can't occur in RHS. + WTUD (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs + -- The corresponding call to adjustTailUsage is in occAnalRec and tagRecBinders --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness -- here because that is what we are setting! - WithTailUsageDetails unf_tuds unf' = occAnalUnfolding rhs_env unf + WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf adj_unf_uds = adjustTailArity (Just rhs_ja) unf_tuds -- `rhs_ja` is `joinRhsArity rhs` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] @@ -1590,8 +1783,9 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- `rhs_ja` is `joinRhsArity rhs'` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_tuds) - | (r,l,rhs_tuds) <- occAnalRules rhs_env bndr ] + rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_wuds) + | rule <- idCoreRules bndr + , let (r,l,rhs_wuds) = occAnalRule rhs_env rule ] rules' = map fstOf3 rules_w_uds adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds @@ -1624,11 +1818,12 @@ mkLoopBreakerNodes :: OccEnv -> TopLevelFlag -- d) adjust each RHS's usage details according to -- the binder's (new) shotness and join-point-hood mkLoopBreakerNodes !env lvl body_uds details_s - = WithUsageDetails final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') + = WUD final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') where - WithUsageDetails final_uds bndrs' = tagRecBinders lvl body_uds details_s + WUD final_uds bndrs' = tagRecBinders lvl body_uds details_s - mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs }) new_bndr + mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs + , nd_rhs = WTUD _ rhs }) new_bndr = DigraphNode { node_payload = simple_nd , node_key = varUnique old_bndr , node_dependencies = nonDetKeysUniqSet lb_deps } @@ -1637,7 +1832,6 @@ mkLoopBreakerNodes !env lvl body_uds details_s -- in nondeterministic order as explained in -- Note [Deterministic SCC] in GHC.Data.Graph.Directed. where - WithTailUsageDetails _ rhs = nd_rhs nd simple_nd = SND { snd_bndr = new_bndr, snd_rhs = rhs, snd_score = score } score = nodeScore env new_bndr lb_deps nd lb_deps = extendFvs_ rule_fv_env inl_fvs @@ -1677,7 +1871,7 @@ nodeScore :: OccEnv -> NodeDetails -> NodeScore nodeScore !env new_bndr lb_deps - (ND { nd_bndr = old_bndr, nd_rhs = WithTailUsageDetails _ bind_rhs }) + (ND { nd_bndr = old_bndr, nd_rhs = WTUD _ bind_rhs }) | not (isId old_bndr) -- A type or coercion variable is never a loop breaker = (100, 0, False) @@ -1974,36 +2168,47 @@ occAnalLamTail :: OccEnv -> CoreExpr -> WithTailUsageDetails CoreExpr -- In effect, the analysis result is for a non-recursive join point with -- manifest arity and adjustTailUsage does the fixup. -- See Note [Adjusting right-hand sides] -occAnalLamTail env (Lam bndr expr) - | isTyVar bndr - , let env1 = addOneInScope env bndr - , WithTailUsageDetails (TUD ja usage) expr' <- occAnalLamTail env1 expr - = WithTailUsageDetails (TUD (ja+1) usage) (Lam bndr expr') - -- Important: Keep the 'env' unchanged so that with a RHS like - -- \(@ x) -> K @x (f @x) - -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain - -- from inlining f. See the beginning of Note [Cascading inlines]. - - | otherwise -- So 'bndr' is an Id - = let (env_one_shots', bndr1) - = case occ_one_shots env of - [] -> ([], bndr) - (os : oss) -> (oss, updOneShotInfo bndr os) - -- Use updOneShotInfo, not setOneShotInfo, as pre-existing - -- one-shot info might be better than what we can infer, e.g. - -- due to explicit use of the magic 'oneShot' function. - -- See Note [The oneShot function] - - env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - env2 = addOneInScope env1 bndr - WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env2 expr - (usage', bndr2) = tagLamBinder usage bndr1 - in WithTailUsageDetails (TUD (ja+1) usage') (Lam bndr2 expr') +occAnalLamTail env expr + = let !(WUD usage expr') = occ_anal_lam_tail env expr + in WTUD (TUD (joinRhsArity expr) usage) expr' + +occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr +-- Does not markInsidLam etc for the outmost batch of lambdas +occ_anal_lam_tail env expr@(Lam {}) + = go env emptyVarSet [] expr + where + go :: OccEnv -> VarSet -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env bndr_set rev_bndrs (Lam bndr body) + | isTyVar bndr + = go env (bndr_set `extendVarSet` bndr) (bndr:rev_bndrs) body + -- Important: Do not modify occ_encl, so that with a RHS like + -- \(@ x) -> K @x (f @x) + -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain + -- from inlining f. See the beginning of Note [Cascading inlines]. + + | otherwise + = let (env_one_shots', bndr') + = case occ_one_shots env of + [] -> ([], bndr) + (os : oss) -> (oss, updOneShotInfo bndr os) + -- Use updOneShotInfo, not setOneShotInfo, as pre-existing + -- one-shot info might be better than what we can infer, e.g. + -- due to explicit use of the magic 'oneShot' function. + -- See Note [The oneShot function] + env' = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } + in go env' (bndr_set `extendVarSet` bndr') (bndr':rev_bndrs) body + + go env bndr_set rev_bndrs body + = addInScope env bndr_set $ \env -> + let !(WUD usage body') = occ_anal_lam_tail env body + wrap_lam body bndr = Lam (tagLamBinder usage bndr) body + in WUD (usage `addLamCoVarOccs` rev_bndrs) + (foldl' wrap_lam body' rev_bndrs) -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] -occAnalLamTail env (Cast expr co) - = let WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env expr +occ_anal_lam_tail env (Cast expr co) + = let WUD usage expr' = occ_anal_lam_tail env expr -- usage1: see Note [Gather occurrences of coercion variables] usage1 = addManyOccs usage (coVarsOfCo co) @@ -2019,10 +2224,10 @@ occAnalLamTail env (Cast expr co) -- GHC.Core.Lint: Note Note [Join points and casts] usage3 = markAllNonTail usage2 - in WithTailUsageDetails (TUD ja usage3) (Cast expr' co) + in WUD usage3 (Cast expr' co) -occAnalLamTail env expr = case occAnal env expr of - WithUsageDetails usage expr' -> WithTailUsageDetails (TUD 0 usage) expr' +occ_anal_lam_tail env expr -- Not Lam, not Cast + = occAnal env expr {- Note [Occ-anal and cast worker/wrapper] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2063,13 +2268,12 @@ occAnalUnfolding !env unf unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) | isStableSource src -> let - WithTailUsageDetails (TUD rhs_ja usage) rhs' = occAnalLamTail env rhs - - unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] - | otherwise = unf { uf_tmpl = rhs' } - in WithTailUsageDetails (TUD rhs_ja (markAllMany usage)) unf' + WTUD (TUD rhs_ja uds) rhs' = occAnalLamTail env rhs + unf' = unf { uf_tmpl = rhs' } + in WTUD (TUD rhs_ja (markAllMany uds)) unf' -- markAllMany: see Note [Occurrences in stable unfoldings] - | otherwise -> WithTailUsageDetails (TUD 0 emptyDetails) unf + + | otherwise -> WTUD (TUD 0 emptyDetails) unf -- For non-Stable unfoldings we leave them undisturbed, but -- don't count their usage because the simplifier will discard them. -- We leave them undisturbed because nodeScore uses their size info @@ -2078,43 +2282,36 @@ occAnalUnfolding !env unf -- scope remain in scope; there is no cloning etc. unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) - -> WithTailUsageDetails (TUD 0 final_usage) (unf { df_args = args' }) - where - env' = env `addInScope` bndrs - (WithUsageDetails usage args') = occAnalList env' args - final_usage = usage `addLamCoVarOccs` bndrs `delDetailsList` bndrs - -- delDetailsList; no need to use tagLamBinders because we + -> let WUD uds args' = addInScopeList env bndrs $ \ env -> + occAnalList env args + in WTUD (TUD 0 uds) (unf { df_args = args' }) + -- No need to use tagLamBinders because we -- never inline DFuns so the occ-info on binders doesn't matter - unf -> WithTailUsageDetails (TUD 0 emptyDetails) unf + unf -> WTUD (TUD 0 emptyDetails) unf -occAnalRules :: OccEnv - -> Id -- Get rules from here - -> [(CoreRule, -- Each (non-built-in) rule - UsageDetails, -- Usage details for LHS - TailUsageDetails)] -- Usage details for RHS -occAnalRules !env bndr - = map occ_anal_rule (idCoreRules bndr) +occAnalRule :: OccEnv + -> CoreRule + -> (CoreRule, -- Each (non-built-in) rule + UsageDetails, -- Usage details for LHS + TailUsageDetails) -- Usage details for RHS +occAnalRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) + = (rule', lhs_uds', TUD rhs_ja rhs_uds') where - occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) - = (rule', lhs_uds', TUD rhs_ja rhs_uds') - where - env' = env `addInScope` bndrs - rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] - | otherwise = rule { ru_args = args', ru_rhs = rhs' } + rule' = rule { ru_args = args', ru_rhs = rhs' } - (WithUsageDetails lhs_uds args') = occAnalList env' args - lhs_uds' = markAllManyNonTail (lhs_uds `delDetailsList` bndrs) - `addLamCoVarOccs` bndrs + WUD lhs_uds args' = addInScopeList env bndrs $ \env -> + occAnalList env args - (WithUsageDetails rhs_uds rhs') = occAnal env' rhs - -- Note [Rules are extra RHSs] - -- Note [Rule dependency info] - rhs_uds' = markAllMany $ - rhs_uds `delDetailsList` bndrs - rhs_ja = length args -- See Note [Join points and unfoldings/rules] + lhs_uds' = markAllManyNonTail lhs_uds + WUD rhs_uds rhs' = addInScopeList env bndrs $ \env -> + occAnal env rhs + -- Note [Rules are extra RHSs] + -- Note [Rule dependency info] + rhs_uds' = markAllMany rhs_uds + rhs_ja = length args -- See Note [Join points and unfoldings/rules] - occ_anal_rule other_rule = (other_rule, emptyDetails, TUD 0 emptyDetails) +occAnalRule _ other_rule = (other_rule, emptyDetails, TUD 0 emptyDetails) {- Note [Join point RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2178,7 +2375,7 @@ have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ -By default we use an rhsCtxt for the RHS of a binding. This tells the +By default we use an OccRhs for the RHS of a binding. This tells the occ anal n that it's looking at an RHS, which has an effect in occAnalApp. In particular, for constructor applications, it makes the arguments appear to have NoOccInfo, so that we don't inline into @@ -2199,7 +2396,7 @@ Result: multiple simplifier iterations. Sigh. So, when analysing the RHS of x3 we notice that x3 will itself definitely inline the next time round, and so we analyse x3's rhs in -an ordinary context, not rhsCtxt. Hence the "certainly_inline" stuff. +an OccVanilla context, not OccRhs. Hence the "certainly_inline" stuff. Annoyingly, we have to approximate GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally. If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and @@ -2229,17 +2426,17 @@ for the various clauses. -} occAnalList :: OccEnv -> [CoreExpr] -> WithUsageDetails [CoreExpr] -occAnalList !_ [] = WithUsageDetails emptyDetails [] +occAnalList !_ [] = WUD emptyDetails [] occAnalList env (e:es) = let - (WithUsageDetails uds1 e') = occAnal env e - (WithUsageDetails uds2 es') = occAnalList env es - in WithUsageDetails (uds1 `andUDs` uds2) (e' : es') + (WUD uds1 e') = occAnal env e + (WUD uds2 es') = occAnalList env es + in WUD (uds1 `andUDs` uds2) (e' : es') occAnal :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Gives info only about the "interesting" Ids -occAnal !_ expr@(Lit _) = WithUsageDetails emptyDetails expr +occAnal !_ expr@(Lit _) = WUD emptyDetails expr occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- At one stage, I gathered the idRuleVars for the variable here too, @@ -2250,9 +2447,9 @@ occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- weren't used at all. occAnal _ expr@(Type ty) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfType ty)) expr + = WUD (addManyOccs emptyDetails (coVarsOfType ty)) expr occAnal _ expr@(Coercion co) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfCo co)) expr + = WUD (addManyOccs emptyDetails (coVarsOfCo co)) expr -- See Note [Gather occurrences of coercion variables] {- Note [Gather occurrences of coercion variables] @@ -2288,7 +2485,7 @@ We gather CoVar occurrences from: * The (Type ty) and (Coercion co) cases of occAnal * The type 'ty' of a lambda-binder (\(x:ty). blah) - See addLamCoVarOccs + See addCoVarOccs But it is not necessary to gather CoVars from the types of other binders. @@ -2301,22 +2498,22 @@ But it is not necessary to gather CoVars from the types of other binders. occAnal env (Tick tickish body) | SourceNote{} <- tickish - = WithUsageDetails usage (Tick tickish body') + = WUD usage (Tick tickish body') -- SourceNotes are best-effort; so we just proceed as usual. -- If we drop a tick due to the issues described below it's -- not the end of the world. | tickish `tickishScopesLike` SoftScope - = WithUsageDetails (markAllNonTail usage) (Tick tickish body') + = WUD (markAllNonTail usage) (Tick tickish body') | Breakpoint _ _ ids _ <- tickish - = WithUsageDetails (usage_lam `andUDs` foldr addManyOcc emptyDetails ids) (Tick tickish body') + = WUD (addManyOccs usage_lam (mkVarSet ids)) (Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise - = WithUsageDetails usage_lam (Tick tickish body') + = WUD usage_lam (Tick tickish body') where - (WithUsageDetails usage body') = occAnal env body + (WUD usage body') = occAnal env body -- for a non-soft tick scope, we can inline lambdas only usage_lam = markAllNonTail (markAllInsideLam usage) -- TODO There may be ways to make ticks and join points play @@ -2328,59 +2525,77 @@ occAnal env (Tick tickish body) -- See #14242. occAnal env (Cast expr co) - = let (WithUsageDetails usage expr') = occAnal env expr + = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] usage2 = markAllNonTail usage1 -- usage3: calls inside expr aren't tail calls any more - in WithUsageDetails usage2 (Cast expr' co) + in WUD usage2 (Cast expr' co) occAnal env app@(App _ _) = occAnalApp env (collectArgsTicks tickishFloatable app) occAnal env expr@(Lam {}) - = adjustNonRecRhs Nothing $ occAnalLamTail env expr -- mb_join_arity == Nothing <=> markAllManyNonTail + = adjustNonRecRhs Nothing $ -- Nothing <=> markAllManyNonTail + occAnalLamTail env expr occAnal env (Case scrut bndr ty alts) = let - (WithUsageDetails scrut_usage scrut') = occAnal (scrutCtxt env alts) scrut - alt_env = addBndrSwap scrut' bndr $ env { occ_encl = OccVanilla } `addOneInScope` bndr - (alts_usage_s, alts') = mapAndUnzip (do_alt alt_env) alts - alts_usage = foldr orUDs emptyDetails alts_usage_s - (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr - total_usage = markAllNonTail scrut_usage `andUDs` alts_usage1 + WUD scrut_usage scrut' = occAnal (setScrutCtxt env alts) scrut + + WUD alts_usage (tagged_bndr, alts') + = addInScopeOne env bndr $ \env -> + let alt_env = addBndrSwap scrut' bndr $ + setTailCtxt env -- Kill off OccRhs + WUD alts_usage alts' = do_alts alt_env alts + tagged_bndr = tagLamBinder alts_usage bndr + in WUD alts_usage (tagged_bndr, alts') + + total_usage = markAllNonTail scrut_usage `andUDs` alts_usage -- Alts can have tail calls, but the scrutinee can't - in WithUsageDetails total_usage (Case scrut' tagged_bndr ty alts') + + in WUD total_usage (Case scrut' tagged_bndr ty alts') where + do_alts :: OccEnv -> [CoreAlt] -> WithUsageDetails [CoreAlt] + do_alts _ [] = WUD emptyDetails [] + do_alts env (alt:alts) = WUD (uds1 `orUDs` uds2) (alt':alts') + where + WUD uds1 alt' = do_alt env alt + WUD uds2 alts' = do_alts env alts + do_alt !env (Alt con bndrs rhs) - = let - (WithUsageDetails rhs_usage1 rhs1) = occAnal (env `addInScope` bndrs) rhs - (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs - in -- See Note [Binders in case alternatives] - (alt_usg, Alt con tagged_bndrs rhs1) + = addInScopeList env bndrs $ \ env -> + let WUD rhs_usage rhs' = occAnal env rhs + tagged_bndrs = tagLamBinders rhs_usage bndrs + in -- See Note [Binders in case alternatives] + WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) - = let - body_env = env { occ_encl = OccVanilla } `addInScope` bindersOf bind - (WithUsageDetails body_usage body') = occAnal body_env body - (WithUsageDetails final_usage binds') = occAnalBind env NotTopLevel - noImpRuleEdges bind body_usage - in WithUsageDetails final_usage (mkLets binds' body') + = occAnalBind env NotTopLevel noImpRuleEdges bind + (\env -> occAnal env body) mkLets -occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -> WithUsageDetails CoreExpr +occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] + -> [OneShots] -- Very commonly empty, notably prior to dmd anal + -> WithUsageDetails CoreExpr -- The `fun` argument is just an accumulating parameter, -- the base for building the application we return occAnalArgs !env fun args !one_shots = go emptyDetails fun args one_shots where - go uds fun [] _ = WithUsageDetails uds fun + env_args = setNonTailCtxt OccVanilla env + + go uds fun [] _ = WUD uds fun go uds fun (arg:args) one_shots = go (uds `andUDs` arg_uds) (fun `App` arg') args one_shots' where - !(WithUsageDetails arg_uds arg') = occAnal arg_env arg + !(WUD arg_uds arg') = occAnal arg_env arg !(arg_env, one_shots') - | isTypeArg arg = (env, one_shots) - | otherwise = valArgCtxt env one_shots + | isTypeArg arg + = (env_args, one_shots) + | otherwise + = case one_shots of + [] -> (env_args, []) -- Fast path; one_shots is often empty + (os : one_shots') -> (addOneShots os env_args, one_shots') {- Applications are dealt with specially because we want @@ -2414,19 +2629,19 @@ occAnalApp !env (Var fun, args, ticks) -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , WithUsageDetails usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg - = WithUsageDetails usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + , WUD usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg + = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun_id, args, ticks) - = WithUsageDetails all_uds (mkTicks ticks app') + = WUD all_uds (mkTicks ticks app') where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which -- will ultimately be forced. !(fun', fun_id') = lookupBndrSwap env fun_id - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args one_shots + !(WUD args_uds app') = occAnalArgs env fun' args one_shots - fun_uds = mkOneOcc fun_id' int_cxt n_args + fun_uds = mkOneOcc env fun_id' int_cxt n_args -- NB: fun_uds is computed for fun_id', not fun_id -- See (BS1) in Note [The binder-swap substitution] @@ -2434,6 +2649,7 @@ occAnalApp env (Var fun_id, args, ticks) !final_args_uds = markAllNonTail $ markAllInsideLamIf (isRhsEnv env && is_exp) $ + -- isRhsEnv: see Note [OccEncl] args_uds -- We mark the free vars of the argument of a constructor or PAP -- as "inside-lambda", if it is the RHS of a let(rec). @@ -2462,13 +2678,13 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = WithUsageDetails (markAllNonTail (fun_uds `andUDs` args_uds)) + = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) (mkTicks ticks app') where - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args [] - !(WithUsageDetails fun_uds fun') = occAnal (addAppCtxt env args) fun + !(WUD args_uds app') = occAnalArgs env fun' args [] + !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun -- The addAppCtxt is a bit cunning. One iteration of the simplifier - -- often leaves behind beta redexs like + -- often leaves behind beta redexes like -- (\x y -> e) a1 a2 -- Here we would like to mark x,y as one-shot, and treat the whole -- thing much like a let. We do this by pushing some OneShotLam items @@ -2595,33 +2811,45 @@ data OccEnv -- then please replace x by (y |> mco) -- Invariant of course: idType x = exprType (y |> mco) , occ_bs_env :: !(IdEnv (OutId, MCoercion)) - -- Domain is Global and Local Ids - -- Range is just Local Ids + -- Domain is Global and Local Ids + -- Range is just Local Ids , occ_bs_rng :: !VarSet - -- Vars (TyVars and Ids) free in the range of occ_bs_env + -- Vars (TyVars and Ids) free in the range of occ_bs_env + + -- Usage details of the RHS of in-scope non-recursive join points + -- Invariant: no Id maps to an empty OccInfoEnv + -- See Note [Occurrence analysis for join points] + , occ_join_points :: !JoinPointInfo } +type JoinPointInfo = IdEnv OccInfoEnv ----------------------------- --- OccEncl is used to control whether to inline into constructor arguments --- For example: --- x = (p,q) -- Don't inline p or q --- y = /\a -> (p a, q a) -- Still don't inline p or q --- z = f (p,q) -- Do inline p,q; it may make a rule fire --- So OccEncl tells enough about the context to know what to do when --- we encounter a constructor application or PAP. --- --- OccScrut is used to set the "interesting context" field of OncOcc +{- Note [OccEncl] +~~~~~~~~~~~~~~~~~ +OccEncl is used to control whether to inline into constructor arguments. -data OccEncl - = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda - -- Don't inline into constructor args here +* OccRhs: consider + let p = in + let x = Just p + in ...case p of ... - | OccScrut -- Scrutintee of a case - -- Can inline into constructor args + Here `p` occurs syntactically once, but we want to mark it as InsideLam + to stop `p` inlining. We want to leave the x-binding as a constructor + applied to variables, so that the Simplifier can simplify that inner `case`. + + The OccRhs just tells occAnalApp to mark occurrences in constructor args + +* OccScrut: consider (case x of ...). Here we want to give `x` OneOcc + with "interesting context" field int_cxt = True. The OccScrut tells + occAnalApp (which deals with lone variables too) when to set this field + to True. +-} - | OccVanilla -- Argument of function, body of lambda, etc - -- Do inline into constructor args here +data OccEncl -- See Note [OccEncl] + = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda + | OccScrut -- Scrutintee of a case + | OccVanilla -- Everything else instance Outputable OccEncl where ppr OccRhs = text "occRhs" @@ -2641,17 +2869,20 @@ initOccEnv , occ_unf_act = \_ -> True , occ_rule_act = \_ -> True + , occ_join_points = emptyVarEnv , occ_bs_env = emptyVarEnv , occ_bs_rng = emptyVarSet } noBinderSwaps :: OccEnv -> Bool noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env -scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv -scrutCtxt !env alts - | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } - | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } +setScrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv +setScrutCtxt !env alts + = setNonTailCtxt encl env where + encl | interesting_alts = OccScrut + | otherwise = OccVanilla + interesting_alts = case alts of [] -> False [alt] -> not (isDefaultAlt alt) @@ -2660,34 +2891,143 @@ scrutCtxt !env alts -- non-default alternative. That in turn influences -- pre/postInlineUnconditionally. Grep for "occ_int_cxt"! -rhsCtxt :: OccEnv -> OccEnv -rhsCtxt !env = env { occ_encl = OccRhs, occ_one_shots = [] } - -valArgCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) -valArgCtxt !env [] - = (env { occ_encl = OccVanilla, occ_one_shots = [] }, []) -valArgCtxt env (one_shots:one_shots_s) - = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s) +setNonTailCtxt :: OccEncl -> OccEnv -> OccEnv +setNonTailCtxt ctxt !env + = env { occ_encl = ctxt + , occ_one_shots = [] + , occ_join_points = zapped_jp_env } + where + -- zapped_jp_env is basically just emptyVarEnv (hence zapped). See (W3) of + -- Note [Occurrence analysis for join points] Zapping improves efficiency, + -- slightly, if you accidentally introduce a bug, in which you zap [jx :-> uds] and + -- then find an occurrence of jx anyway, you might lose those uds, and + -- that might mean we don't record all occurrencs, and that means we + -- duplicate a redex.... a very nasty bug (which I encountered!). Hence + -- this DEBUG code which doesn't remove jx from the envt; it just gives it + -- emptyDetails, which in turn causes a panic in mkOneOcc. That will catch + -- this bug before it does any damage. +#ifdef DEBUG + zapped_jp_env = mapVarEnv (\ _ -> emptyVarEnv) (occ_join_points env) +#else + zapped_jp_env = emptyVarEnv +#endif + +setTailCtxt :: OccEnv -> OccEnv +setTailCtxt !env + = env { occ_encl = OccVanilla } + -- Preserve occ_one_shots, occ_join points + -- Do not use OccRhs for the RHS of a join point (which is a tail ctxt): + -- see Note [Join point RHSs] + +addOneShots :: OneShots -> OccEnv -> OccEnv +addOneShots os !env + | null os = env -- Fast path for common case + | otherwise = env { occ_one_shots = os } + +addOneShotsFromDmd :: Id -> OccEnv -> OccEnv +addOneShotsFromDmd bndr = addOneShots (argOneShots (idDemandInfo bndr)) isRhsEnv :: OccEnv -> Bool isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of OccRhs -> True _ -> False -addOneInScope :: OccEnv -> CoreBndr -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addOneInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndr - | bndr `elemVarSet` rng_vars = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnv` bndr } - -addInScope :: OccEnv -> [Var] -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndrs - | any (`elemVarSet` rng_vars) bndrs = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnvList` bndrs } +addInScopeList :: OccEnv -> [Var] + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeList #-} +addInScopeList env bndrs = addInScope env (mkVarSet bndrs) + +addInScopeOne :: OccEnv -> Id + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeOne #-} +addInScopeOne env bndr = addInScope env (unitVarSet bndr) + +addInScope :: OccEnv -> VarSet + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScope #-} +-- This function is called a lot, so we want to inline the fast path +-- The bndr_set must include TyVars as well as Ids, because of (BS3) +-- in Note [Binder swap] +addInScope env bndr_set thing_inside + = WUD uds' res + where + !(env', bad_joins) = preprocess_env env bndr_set + !(WUD uds res) = thing_inside env' + uds' = postprocess_uds bndr_set bad_joins uds + +preprocess_env :: OccEnv -> VarSet -> (OccEnv, JoinPointInfo) +preprocess_env env@(OccEnv { occ_join_points = join_points + , occ_bs_rng = bs_rng_vars }) + bndr_set + | bad_joins = (drop_shadowed_swaps (drop_shadowed_joins env), join_points) + | otherwise = (drop_shadowed_swaps env, emptyVarEnv) + where + drop_shadowed_swaps :: OccEnv -> OccEnv + -- See Note [The binder-swap substitution] (BS3) + drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env }) + | bs_rng_vars `intersectsVarSet` bndr_set + = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } + | otherwise + = env { occ_bs_env = swap_env `minusUFM` bndr_fm } + + drop_shadowed_joins :: OccEnv -> OccEnv + -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) + drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } + + -- bad_joins is true if it would be wrong to push occ_join_points inwards + -- (a) `bndrs` includes any of the occ_join_points + -- (b) `bndrs` includes any variables free in the RHSs of occ_join_points + bad_joins :: Bool + bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points + + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set + + is_bad :: Unique -> OccInfoEnv -> Bool -> Bool + is_bad uniq join_uds rest + = uniq `elemUniqSet_Directly` bndr_set || + not (bndr_fm `disjointUFM` join_uds) || + rest + +postprocess_uds :: VarSet -> JoinPointInfo -> UsageDetails -> UsageDetails +postprocess_uds bndr_set bad_joins uds + = add_bad_joins (delBndrsFromUDs bndr_set uds) + where + add_bad_joins :: UsageDetails -> UsageDetails + -- Add usage info for occ_join_points that we cannot push inwards + -- because of shadowing + -- See Note [Occurrence analysis for join points] wrinkle (W2) + add_bad_joins uds + | isEmptyVarEnv bad_joins = uds + | otherwise = modifyUDEnv extend_with_bad_joins uds + + extend_with_bad_joins :: OccInfoEnv -> OccInfoEnv + extend_with_bad_joins env + = nonDetStrictFoldUFM_Directly add_bad_join env bad_joins + + add_bad_join :: Unique -> OccInfoEnv -> OccInfoEnv -> OccInfoEnv + -- Behave like `andUDs` when adding in the bad_joins + add_bad_join uniq join_env env + | uniq `elemVarEnvByKey` env = plusVarEnv_C andLocalOcc env join_env + | otherwise = env + +addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv +addJoinPoint env bndr rhs_uds + | isEmptyVarEnv zeroed_form + = env + | otherwise + = env { occ_join_points = extendVarEnv (occ_join_points env) bndr zeroed_form } + where + zeroed_form = mkZeroedForm rhs_uds +mkZeroedForm :: UsageDetails -> OccInfoEnv +-- See Note [Occurrence analysis for join points] for "zeroed form" +mkZeroedForm (UD { ud_env = rhs_occs }) + = mapMaybeUFM do_one rhs_occs + where + do_one :: LocalOcc -> Maybe LocalOcc + do_one (ManyOccL {}) = Nothing + do_one occ@(OneOccL {}) = Just (occ { lo_n_br = 0 }) -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet @@ -3106,11 +3446,40 @@ with the 'OccInfoEnv'. Each of these extra environments is a "zapped set" recording which variables have been zapped in some way. Zapping all occurrence info then simply means setting the corresponding zapped set to the whole 'OccInfoEnv', a fast O(1) operation. + +Note [LocalOcc] +~~~~~~~~~~~~~~~ +LocalOcc is used purely internally, in the occurrence analyser. It differs from +GHC.Types.Basic.OccInfo because it has only OneOcc and ManyOcc; it does not need +IAmDead or IAmALoopBreaker. + +Note that `OneOccL` doesn't meant that it occurs /syntactially/ only once; it +means that it is /used/ only once. It might occur syntactically many times. +For example, in (case x of A -> y; B -> y; C -> True), +* `y` is used only once +* but it occurs syntactically twice + -} -type OccInfoEnv = IdEnv OccInfo -- A finite map from ids to their usage - -- INVARIANT: never IAmDead - -- (Deadness is signalled by not being in the map at all) +type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's + -- free variables to their usage + +data LocalOcc -- See Note [LocalOcc] + = OneOccL { lo_n_br :: {-# UNPACK #-} !BranchCount -- Number of syntactic occurrences + , lo_tail :: !TailCallInfo + -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3) + -- gives NoTailCallInfo + , lo_int_cxt :: !InterestingCxt } + | ManyOccL !TailCallInfo + +instance Outputable LocalOcc where + ppr (OneOccL { lo_n_br = n, lo_tail = tci }) + = text "OneOccL" <> braces (ppr n <> comma <> ppr tci) + ppr (ManyOccL tci) = text "ManyOccL" <> braces (ppr tci) + +localTailCallInfo :: LocalOcc -> TailCallInfo +localTailCallInfo (OneOccL { lo_tail = tci }) = tci +localTailCallInfo (ManyOccL tci) = tci type ZappedSet = OccInfoEnv -- Values are ignored @@ -3118,53 +3487,67 @@ data UsageDetails = UD { ud_env :: !OccInfoEnv , ud_z_many :: !ZappedSet -- apply 'markMany' to these , ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these - , ud_z_no_tail :: !ZappedSet } -- apply 'markNonTail' to these - -- INVARIANT: All three zapped sets are subsets of the OccInfoEnv + , ud_z_tail :: !ZappedSet -- zap tail-call info for these + } + -- INVARIANT: All three zapped sets are subsets of ud_env instance Outputable UsageDetails where - ppr ud = ppr (ud_env (flattenUsageDetails ud)) - --- | Captures the result of applying 'occAnalLamTail' to a function `\xyz.body`. --- The TailUsageDetails records + ppr ud@(UD { ud_env = env, ud_z_tail = z_tail }) + = text "UD" <+> (braces $ fsep $ punctuate comma $ + [ ppr uq <+> text ":->" <+> ppr (lookupOccInfoByUnique ud uq) + | (uq, _) <- nonDetStrictFoldVarEnv_Directly do_one [] env ]) + $$ nest 2 (text "ud_z_tail" <+> ppr z_tail) + where + do_one :: Unique -> LocalOcc -> [(Unique,LocalOcc)] -> [(Unique,LocalOcc)] + do_one uniq occ occs = (uniq, occ) : occs + +--------------------- +-- | TailUsageDetails captures the result of applying 'occAnalLamTail' +-- to a function `\xyz.body`. The TailUsageDetails pairs together -- * the number of lambdas (including type lambdas: a JoinArity) --- * UsageDetails for the `body`, unadjusted by `adjustTailUsage`. --- If the binding turns out to be a join point with the indicated join --- arity, this unadjusted usage details is just what we need; otherwise we --- need to discard tail calls. That's what `adjustTailUsage` does. +-- * UsageDetails for the `body` of the lambda, unadjusted by `adjustTailUsage`. +-- If the binding turns out to be a join point with the indicated join +-- arity, this unadjusted usage details is just what we need; otherwise we +-- need to discard tail calls. That's what `adjustTailUsage` does. data TailUsageDetails = TUD !JoinArity !UsageDetails instance Outputable TailUsageDetails where ppr (TUD ja uds) = lambda <> ppr ja <> ppr uds +--------------------- +data WithUsageDetails a = WUD !UsageDetails !a +data WithTailUsageDetails a = WTUD !TailUsageDetails !a ------------------- -- UsageDetails API andUDs, orUDs :: UsageDetails -> UsageDetails -> UsageDetails -andUDs = combineUsageDetailsWith addOccInfo -orUDs = combineUsageDetailsWith orOccInfo +andUDs = combineUsageDetailsWith andLocalOcc +orUDs = combineUsageDetailsWith orLocalOcc -mkOneOcc :: Id -> InterestingCxt -> JoinArity -> UsageDetails -mkOneOcc id int_cxt arity - | isLocalId id - = emptyDetails { ud_env = unitVarEnv id occ_info } - | otherwise +mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails +mkOneOcc !env id int_cxt arity + | not (isLocalId id) = emptyDetails - where - occ_info = OneOcc { occ_in_lam = NotInsideLam - , occ_n_br = oneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled arity } -addManyOccId :: UsageDetails -> Id -> UsageDetails --- Add the non-committal (id :-> noOccInfo) to the usage details -addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id noOccInfo } + | Just join_uds <- lookupVarEnv (occ_join_points env) id + = -- See Note [Occurrence analysis for join points] + assertPpr (not (isEmptyVarEnv join_uds)) (ppr id) $ + -- We only put non-empty join-points into occ_join_points + mkSimpleDetails (extendVarEnv join_uds id occ) + + | otherwise + = mkSimpleDetails (unitVarEnv id occ) + + where + occ = OneOccL { lo_n_br = 1, lo_int_cxt = int_cxt + , lo_tail = AlwaysTailCalled arity } -- Add several occurrences, assumed not to be tail calls -addManyOcc :: Var -> UsageDetails -> UsageDetails -addManyOcc v u | isId v = addManyOccId u v - | otherwise = u +add_many_occ :: Var -> OccInfoEnv -> OccInfoEnv +add_many_occ v env | isId v = extendVarEnv env v (ManyOccL NoTailCallInfo) + | otherwise = env -- Give a non-committal binder info (i.e noOccInfo) because -- a) Many copies of the specialised thing can appear -- b) We don't want to substitute a BIG expression inside a RULE @@ -3172,37 +3555,54 @@ addManyOcc v u | isId v = addManyOccId u v -- (Same goes for INLINE.) addManyOccs :: UsageDetails -> VarSet -> UsageDetails -addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set - -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes +addManyOccs uds var_set + | isEmptyVarSet var_set = uds + | otherwise = uds { ud_env = add_to (ud_env uds) } + where + add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set + -- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails -- Add any CoVars free in the type of a lambda-binder -- See Note [Gather occurrences of coercion variables] addLamCoVarOccs uds bndrs - = uds `addManyOccs` coVarsOfTypes (map varType bndrs) - -delDetails :: UsageDetails -> Id -> UsageDetails -delDetails ud bndr - = ud `alterUsageDetails` (`delVarEnv` bndr) - -delDetailsList :: UsageDetails -> [Id] -> UsageDetails -delDetailsList ud bndrs - = ud `alterUsageDetails` (`delVarEnvList` bndrs) + = foldr add uds bndrs + where + add bndr uds = uds `addManyOccs` coVarsOfType (varType bndr) emptyDetails :: UsageDetails -emptyDetails = UD { ud_env = emptyVarEnv - , ud_z_many = emptyVarEnv - , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } +emptyDetails = mkSimpleDetails emptyVarEnv isEmptyDetails :: UsageDetails -> Bool -isEmptyDetails = isEmptyVarEnv . ud_env +isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env + +mkSimpleDetails :: OccInfoEnv -> UsageDetails +mkSimpleDetails env = UD { ud_env = env + , ud_z_many = emptyVarEnv + , ud_z_in_lam = emptyVarEnv + , ud_z_tail = emptyVarEnv } + +modifyUDEnv :: (OccInfoEnv -> OccInfoEnv) -> UsageDetails -> UsageDetails +modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env } + +delBndrsFromUDs :: VarSet -> UsageDetails -> UsageDetails +-- Delete these binders from the UsageDetails +delBndrsFromUDs bndr_set (UD { ud_env = env, ud_z_many = z_many + , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail }) + = UD { ud_env = env `minusUFM` bndr_fm + , ud_z_many = z_many `minusUFM` bndr_fm + , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm + , ud_z_tail = z_tail `minusUFM` bndr_fm } + where + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails -markAllMany ud = ud { ud_z_many = ud_env ud } -markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } -markAllNonTail ud = ud { ud_z_no_tail = ud_env ud } +markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env } +markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env } +markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env } +markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3212,21 +3612,18 @@ markAllInsideLamIf False ud = ud markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud - -markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo - -lookupDetails :: UsageDetails -> Id -> OccInfo -lookupDetails ud id - = case lookupVarEnv (ud_env ud) id of - Just occ -> doZapping ud id occ - Nothing -> IAmDead - -usedIn :: Id -> UsageDetails -> Bool -v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud +lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo +lookupTailCallInfo uds id + | UD { ud_z_tail = z_tail, ud_env = env } <- uds + , not (id `elemVarEnv` z_tail) + , Just occ <- lookupVarEnv env id + = localTailCallInfo occ + | otherwise + = NoTailCallInfo udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds -udFreeVars bndrs ud = restrictFreeVars bndrs (ud_env ud) +udFreeVars bndrs (UD { ud_env = env }) = restrictFreeVars bndrs env restrictFreeVars :: VarSet -> OccInfoEnv -> VarSet restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs @@ -3234,66 +3631,96 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs ------------------- -- Auxiliary functions for UsageDetails implementation -combineUsageDetailsWith :: (OccInfo -> OccInfo -> OccInfo) +combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails -combineUsageDetailsWith plus_occ_info ud1 ud2 - | isEmptyDetails ud1 = ud2 - | isEmptyDetails ud2 = ud1 +{-# INLINE combineUsageDetailsWith #-} +combineUsageDetailsWith plus_occ_info + uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) + uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) + | isEmptyVarEnv env1 = uds2 + | isEmptyVarEnv env2 = uds1 | otherwise - = UD { ud_env = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2) - , ud_z_many = plusVarEnv (ud_z_many ud1) (ud_z_many ud2) - , ud_z_in_lam = plusVarEnv (ud_z_in_lam ud1) (ud_z_in_lam ud2) - , ud_z_no_tail = plusVarEnv (ud_z_no_tail ud1) (ud_z_no_tail ud2) } - -doZapping :: UsageDetails -> Var -> OccInfo -> OccInfo -doZapping ud var occ - = doZappingByUnique ud (varUnique var) occ - -doZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo -doZappingByUnique (UD { ud_z_many = many - , ud_z_in_lam = in_lam - , ud_z_no_tail = no_tail }) - uniq occ - = occ2 + = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = plusVarEnv z_many1 z_many2 + , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 + , ud_z_tail = plusVarEnv z_tail1 z_tail2 } + +lookupLetOccInfo :: UsageDetails -> Id -> OccInfo +-- Don't use locally-generated occ_info for exported (visible-elsewhere) +-- things. Instead just give noOccInfo. +-- NB: setBinderOcc will (rightly) erase any LoopBreaker info; +-- we are about to re-generate it and it shouldn't be "sticky" +lookupLetOccInfo ud id + | isExportedId id = noOccInfo + | otherwise = lookupOccInfoByUnique ud (idUnique id) + +lookupOccInfo :: UsageDetails -> Id -> OccInfo +lookupOccInfo ud id = lookupOccInfoByUnique ud (idUnique id) + +lookupOccInfoByUnique :: UsageDetails -> Unique -> OccInfo +lookupOccInfoByUnique (UD { ud_env = env + , ud_z_many = z_many + , ud_z_in_lam = z_in_lam + , ud_z_tail = z_tail }) + uniq + = case lookupVarEnv_Directly env uniq of + Nothing -> IAmDead + Just (OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt + , lo_tail = tail_info }) + | uniq `elemVarEnvByKey`z_many + -> ManyOccs { occ_tail = mk_tail_info tail_info } + | otherwise + -> OneOcc { occ_in_lam = in_lam + , occ_n_br = n_br + , occ_int_cxt = int_cxt + , occ_tail = mk_tail_info tail_info } + where + in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam + | otherwise = NotInsideLam + + Just (ManyOccL tail_info) -> ManyOccs { occ_tail = mk_tail_info tail_info } where - occ1 | uniq `elemVarEnvByKey` many = markMany occ - | uniq `elemVarEnvByKey` in_lam = markInsideLam occ - | otherwise = occ - occ2 | uniq `elemVarEnvByKey` no_tail = markNonTail occ1 - | otherwise = occ1 - -alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails -alterUsageDetails !ud f - = UD { ud_env = f (ud_env ud) - , ud_z_many = f (ud_z_many ud) - , ud_z_in_lam = f (ud_z_in_lam ud) - , ud_z_no_tail = f (ud_z_no_tail ud) } - -flattenUsageDetails :: UsageDetails -> UsageDetails -flattenUsageDetails ud@(UD { ud_env = env }) - = UD { ud_env = mapUFM_Directly (doZappingByUnique ud) env - , ud_z_many = emptyVarEnv - , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } + mk_tail_info ti + | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo + | otherwise = ti + + ------------------- -- See Note [Adjusting right-hand sides] + +adjustNonRecRhs :: Maybe JoinArity + -> WithTailUsageDetails CoreExpr + -> WithUsageDetails CoreExpr +-- ^ This function concentrates shared logic between occAnalNonRecBind and the +-- AcyclicSCC case of occAnalRec. +-- * It applies 'markNonRecJoinOneShots' to the RHS +-- * and returns the adjusted rhs UsageDetails combined with the body usage +adjustNonRecRhs mb_join_arity rhs_wuds@(WTUD _ rhs) + = WUD rhs_uds' rhs' + where + --------- Marking (non-rec) join binders one-shot --------- + !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs + | otherwise = rhs + + --------- Adjusting right-hand side usage --------- + rhs_uds' = adjustTailUsage mb_join_arity rhs_wuds + adjustTailUsage :: Maybe JoinArity - -> CoreExpr -- Rhs, AFTER occAnalLamTail - -> TailUsageDetails -- From body of lambda - -> UsageDetails -adjustTailUsage mb_join_arity rhs (TUD rhs_ja usage) + -> WithTailUsageDetails CoreExpr -- Rhs usage, AFTER occAnalLamTail + -> UsageDetails +adjustTailUsage mb_join_arity (WTUD (TUD rhs_ja uds) rhs) = -- c.f. occAnal (Lam {}) markAllInsideLamIf (not one_shot) $ markAllNonTailIf (not exact_join) $ - usage + uds where one_shot = isOneShotFun rhs exact_join = mb_join_arity == Just rhs_ja adjustTailArity :: Maybe JoinArity -> TailUsageDetails -> UsageDetails -adjustTailArity mb_rhs_ja (TUD ud_ja usage) = - markAllNonTailIf (mb_rhs_ja /= Just ud_ja) usage +adjustTailArity mb_rhs_ja (TUD ja usage) + = markAllNonTailIf (mb_rhs_ja /= Just ja) usage markNonRecJoinOneShots :: JoinArity -> CoreExpr -> CoreExpr -- For a /non-recursive/ join point we can mark all @@ -3324,52 +3751,38 @@ markNonRecUnfoldingOneShots mb_join_arity unf type IdWithOccInfo = Id -tagLamBinders :: UsageDetails -- Of scope - -> [Id] -- Binders - -> (UsageDetails, -- Details with binders removed - [IdWithOccInfo]) -- Tagged binders +tagLamBinders :: UsageDetails -- Of scope + -> [Id] -- Binders + -> [IdWithOccInfo] -- Tagged binders tagLamBinders usage binders - = usage' `seq` (usage', bndrs') - where - (usage', bndrs') = mapAccumR tagLamBinder usage binders + = map (tagLamBinder usage) binders tagLamBinder :: UsageDetails -- Of scope -> Id -- Binder - -> (UsageDetails, -- Details with binder removed - IdWithOccInfo) -- Tagged binders + -> IdWithOccInfo -- Tagged binders -- Used for lambda and case binders --- It copes with the fact that lambda bindings can have a --- stable unfolding, used for join points +-- No-op on TyVars +-- A lambda binder never has an unfolding, so no need to look for that tagLamBinder usage bndr - = (usage2, bndr') + = setBinderOcc (markNonTail occ) bndr + -- markNonTail: don't try to make an argument into a join point where - occ = lookupDetails usage bndr - bndr' = setBinderOcc (markNonTail occ) bndr - -- Don't try to make an argument into a join point - usage1 = usage `delDetails` bndr - usage2 | isId bndr = addManyOccs usage1 (idUnfoldingVars bndr) - -- This is effectively the RHS of a - -- non-join-point binding, so it's okay to use - -- addManyOccsSet, which assumes no tail calls - | otherwise = usage1 + occ = lookupOccInfo usage bndr tagNonRecBinder :: TopLevelFlag -- At top level? - -> UsageDetails -- Of scope + -> OccInfo -- Of scope -> CoreBndr -- Binder - -> WithUsageDetails -- Details with binder removed - IdWithOccInfo -- Tagged binder - -tagNonRecBinder lvl usage binder - = let - occ = lookupDetails usage binder - will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) - occ' | will_be_join = -- must already be marked AlwaysTailCalled - assert (isAlwaysTailCalled occ) occ - | otherwise = markNonTail occ - binder' = setBinderOcc occ' binder - usage' = usage `delDetails` binder - in - WithUsageDetails usage' binder' + -> IdWithOccInfo -- Tagged binder +-- No-op on TyVars +-- Precondition: OccInfo is not IAmDead +tagNonRecBinder lvl occ bndr + = setBinderOcc occ' bndr + where + will_be_join = okForJoinPoint lvl bndr (tailCallInfo occ) + occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless + -- it was a join point before but is now dead + warnPprTrace (not (isAlwaysTailCalled occ)) "tagNonRecBinder" (ppr bndr <+> ppr occ) occ + | otherwise = markNonTail occ tagRecBinders :: TopLevelFlag -- At top level? -> UsageDetails -- Of body of let ONLY @@ -3381,18 +3794,17 @@ tagRecBinders :: TopLevelFlag -- At top level? -- details *before* tagging binders (because the tags depend on the RHSes). tagRecBinders lvl body_uds details_s = let - bndrs = map nd_bndr details_s + bndrs = map nd_bndr details_s -- 1. See Note [Join arity prediction based on joinRhsArity] -- Determine possible join-point-hood of whole group, by testing for -- manifest join arity M. -- This (re-)asserts that makeNode had made tuds for that same arity M! - unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s - test_manifest_arity ND{nd_rhs=WithTailUsageDetails tuds rhs} + unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s + test_manifest_arity ND{nd_rhs = WTUD tuds rhs} = adjustTailArity (Just (joinRhsArity rhs)) tuds - bndr_ne = expectNonEmpty "List of binders is never empty" bndrs - will_be_joins = decideJoinPointHood lvl unadj_uds bndr_ne + will_be_joins = decideRecJoinPointHood lvl unadj_uds bndrs mb_join_arity :: Id -> Maybe JoinArity -- mb_join_arity: See Note [Join arity prediction based on joinRhsArity] @@ -3401,42 +3813,33 @@ tagRecBinders lvl body_uds details_s -- Can't use willBeJoinId_maybe here because we haven't tagged -- the binder yet (the tag depends on these adjustments!) | will_be_joins - , let occ = lookupDetails unadj_uds bndr - , AlwaysTailCalled arity <- tailCallInfo occ + , AlwaysTailCalled arity <- lookupTailCallInfo unadj_uds bndr = Just arity | otherwise = assert (not will_be_joins) -- Should be AlwaysTailCalled if - Nothing -- we are making join points! + Nothing -- we are making join points! -- 2. Adjust usage details of each RHS, taking into account the -- join-point-hood decision - rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs rhs_tuds -- matching occAnalLamTail in makeNode - | ND { nd_bndr = bndr, nd_rhs = WithTailUsageDetails rhs_tuds rhs } - <- details_s ] + rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs_wuds + -- Matching occAnalLamTail in makeNode + | ND { nd_bndr = bndr, nd_rhs = rhs_wuds } <- details_s ] -- 3. Compute final usage details from adjusted RHS details - adj_uds = foldr andUDs body_uds rhs_udss' + adj_uds = foldr andUDs body_uds rhs_udss' -- 4. Tag each binder with its adjusted details - bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr + bndrs' = [ setBinderOcc (lookupLetOccInfo adj_uds bndr) bndr | bndr <- bndrs ] - -- 5. Drop the binders from the adjusted details and return - usage' = adj_uds `delDetailsList` bndrs in - WithUsageDetails usage' bndrs' + WUD adj_uds bndrs' setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr setBinderOcc occ_info bndr - | isTyVar bndr = bndr - | isExportedId bndr = if isManyOccs (idOccInfo bndr) - then bndr - else setIdOccInfo bndr noOccInfo - -- Don't use local usage info for visible-elsewhere things - -- BUT *do* erase any IAmALoopBreaker annotation, because we're - -- about to re-generate it and it shouldn't be "sticky" - - | otherwise = setIdOccInfo bndr occ_info + | isTyVar bndr = bndr + | occ_info == idOccInfo bndr = bndr + | otherwise = setIdOccInfo bndr occ_info -- | Decide whether some bindings should be made into join points or not, based -- on its occurrences. This is @@ -3450,41 +3853,47 @@ setBinderOcc occ_info bndr -- 'f' tail-calls 'g'. -- -- See Note [Invariants on join points] in "GHC.Core". -decideJoinPointHood :: TopLevelFlag -> UsageDetails - -> NonEmpty CoreBndr - -> Bool -decideJoinPointHood TopLevel _ _ - = False -decideJoinPointHood NotTopLevel usage bndrs - | isJoinId (NE.head bndrs) - = warnPprTrace (not all_ok) - "OccurAnal failed to rediscover join point(s)" (ppr bndrs) - all_ok - | otherwise - = all_ok +decideRecJoinPointHood :: TopLevelFlag -> UsageDetails + -> [CoreBndr] -> Bool +decideRecJoinPointHood lvl usage bndrs + = all ok bndrs -- Invariant 3: Either all are join points or none are where + ok bndr = okForJoinPoint lvl bndr (lookupTailCallInfo usage bndr) + +okForJoinPoint :: TopLevelFlag -> Id -> TailCallInfo -> Bool -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. - all_ok = -- Invariant 3: Either all are join points or none are - all ok bndrs - - ok bndr - | -- Invariant 1: Only tail calls, all same join arity - AlwaysTailCalled arity <- tailCallInfo (lookupDetails usage bndr) +okForJoinPoint lvl bndr tail_call_info + | isJoinId bndr -- A current join point should still be one! + = warnPprTrace lost_join "Lost join point" lost_join_doc $ + True + | valid_join + = True + | otherwise + = False + where + valid_join | NotTopLevel <- lvl + , AlwaysTailCalled arity <- tail_call_info - , -- Invariant 1 as applied to LHSes of rules - all (ok_rule arity) (idCoreRules bndr) + , -- Invariant 1 as applied to LHSes of rules + all (ok_rule arity) (idCoreRules bndr) - -- Invariant 2a: stable unfoldings - -- See Note [Join points and INLINE pragmas] - , ok_unfolding arity (realIdUnfolding bndr) + -- Invariant 2a: stable unfoldings + -- See Note [Join points and INLINE pragmas] + , ok_unfolding arity (realIdUnfolding bndr) - -- Invariant 4: Satisfies polymorphism rule - , isValidJoinPointType arity (idType bndr) - = True + -- Invariant 4: Satisfies polymorphism rule + , isValidJoinPointType arity (idType bndr) + = True + | otherwise + = False - | otherwise - = False + lost_join | Just ja <- isJoinId_maybe bndr + = not valid_join || + (case tail_call_info of -- Valid join but arity differs + AlwaysTailCalled ja' -> ja /= ja' + _ -> False) + | otherwise = False ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans ok_rule join_arity (Rule { ru_args = args }) @@ -3500,6 +3909,16 @@ decideJoinPointHood NotTopLevel usage bndrs ok_unfolding _ _ = True + lost_join_doc + = vcat [ text "bndr:" <+> ppr bndr + , text "tc:" <+> ppr tail_call_info + , text "rules:" <+> ppr (idCoreRules bndr) + , case tail_call_info of + AlwaysTailCalled arity -> + vcat [ text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr)) + , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr)) ] + _ -> empty ] + willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity willBeJoinId_maybe bndr | isId bndr @@ -3546,44 +3965,25 @@ See Invariant 2a of Note [Invariants on join points] in GHC.Core ************************************************************************ -} -markMany, markInsideLam, markNonTail :: OccInfo -> OccInfo - -markMany IAmDead = IAmDead -markMany occ = ManyOccs { occ_tail = occ_tail occ } - -markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = IsInsideLam } -markInsideLam occ = occ - +markNonTail :: OccInfo -> OccInfo markNonTail IAmDead = IAmDead markNonTail occ = occ { occ_tail = NoTailCallInfo } -addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo - -addOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } - -- Both branches are at least One - -- (Argument is never IAmDead) +andLocalOcc :: LocalOcc -> LocalOcc -> LocalOcc +andLocalOcc occ1 occ2 = ManyOccL (tci1 `andTailCallInfo` tci2) + where + !tci1 = localTailCallInfo occ1 + !tci2 = localTailCallInfo occ2 --- (orOccInfo orig new) is used +orLocalOcc :: LocalOcc -> LocalOcc -> LocalOcc +-- (orLocalOcc occ1 occ2) is used -- when combining occurrence info from branches of a case - -orOccInfo (OneOcc { occ_in_lam = in_lam1 - , occ_n_br = nbr1 - , occ_int_cxt = int_cxt1 - , occ_tail = tail1 }) - (OneOcc { occ_in_lam = in_lam2 - , occ_n_br = nbr2 - , occ_int_cxt = int_cxt2 - , occ_tail = tail2 }) - = OneOcc { occ_n_br = nbr1 + nbr2 - , occ_in_lam = in_lam1 `mappend` in_lam2 - , occ_int_cxt = int_cxt1 `mappend` int_cxt2 - , occ_tail = tail1 `andTailCallInfo` tail2 } - -orOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } +orLocalOcc (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = tci1 }) + (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = tci2 }) + = OneOccL { lo_n_br = nbr1 + nbr2 + , lo_int_cxt = int_cxt1 `mappend` int_cxt2 + , lo_tail = tci1 `andTailCallInfo` tci2 } +orLocalOcc occ1 occ2 = andLocalOcc occ1 occ2 andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -443,23 +443,39 @@ emptyRuleEnv = RuleEnv { re_local_rules = emptyNameEnv getRules :: RuleEnv -> Id -> [CoreRule] -- Given a RuleEnv and an Id, find the visible rules for that Id -- See Note [Where rules are found] -getRules (RuleEnv { re_local_rules = local_rules - , re_home_rules = home_rules - , re_eps_rules = eps_rules +-- +-- This function is quite heavily used, so it's worth trying to make it efficient +getRules (RuleEnv { re_local_rules = local_rule_base + , re_home_rules = home_rule_base + , re_eps_rules = eps_rule_base , re_visible_orphs = orphs }) fn | Just {} <- isDataConId_maybe fn -- Short cut for data constructor workers = [] -- and wrappers, which never have any rules - | otherwise - = idCoreRules fn ++ - get local_rules ++ - find_visible home_rules ++ - find_visible eps_rules + | Just export_flag <- isLocalId_maybe fn + = -- LocalIds can't have rules in the local_rule_base (used for imported fns) + -- nor external packages; but there can (just) be rules in another module + -- in the home package, if it is exported + case export_flag of + NotExported -> idCoreRules fn + Exported -> case get home_rule_base of + [] -> idCoreRules fn + home_rules -> drop_orphs home_rules ++ idCoreRules fn + | otherwise + = -- This case expression is a fast path, to avoid calling the + -- recursive (++) in the common case where there are no rules at all + case (get local_rule_base, get home_rule_base, get eps_rule_base) of + ([], [], []) -> idCoreRules fn + (local_rules, home_rules, eps_rules) -> local_rules ++ + drop_orphs home_rules ++ + drop_orphs eps_rules ++ + idCoreRules fn where fn_name = idName fn - find_visible rb = filter (ruleIsVisible orphs) (get rb) + drop_orphs [] = [] -- Fast path; avoid invoking recursive filter + drop_orphs xs = filter (ruleIsVisible orphs) xs get rb = lookupNameEnv rb fn_name `orElse` [] ruleIsVisible :: ModuleSet -> CoreRule -> Bool ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -263,7 +263,6 @@ simple_opt_expr env expr go lam@(Lam {}) = go_lam env [] lam go (Case e b ty as) - -- See Note [Getting the map/coerce RULE to work] | isDeadBinder b , Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e' -- We don't need to be concerned about floats when looking for coerce. ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -180,24 +180,6 @@ instance Outputable CallCtxt where ppr RuleArgCtxt = text "RuleArgCtxt" {- -Note [Occurrence analysis of unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We do occurrence-analysis of unfoldings once and for all, when the -unfolding is built, rather than each time we inline them. - -But given this decision it's vital that we do -*always* do it. Consider this unfolding - \x -> letrec { f = ...g...; g* = f } in body -where g* is (for some strange reason) the loop breaker. If we don't -occ-anal it when reading it in, we won't mark g as a loop breaker, and -we may inline g entirely in body, dropping its binding, and leaving -the occurrence in f out of scope. This happened in #8892, where -the unfolding in question was a DFun unfolding. - -But more generally, the simplifier is designed on the -basis that it is looking at occurrence-analysed expressions, so better -ensure that they actually are. - Note [Calculate unfolding guidance on the non-occ-anal'd expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Notice that we give the non-occur-analysed expression to ===================================== compiler/GHC/Core/Unfold/Make.hs ===================================== @@ -86,7 +86,7 @@ mkDFunUnfolding bndrs con ops = DFunUnfolding { df_bndrs = bndrs , df_con = con , df_args = map occurAnalyseExpr ops } - -- See Note [Occurrence analysis of unfoldings] + -- See Note [OccInfo in unfoldings and rules] in GHC.Core mkDataConUnfolding :: CoreExpr -> Unfolding -- Used for non-newtype data constructors with non-trivial wrappers @@ -338,7 +338,7 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr mkCoreUnfolding src top_lvl expr precomputed_cache guidance = CoreUnfolding { uf_tmpl = cache `seq` occurAnalyseExpr expr - -- occAnalyseExpr: see Note [Occurrence analysis of unfoldings] + -- occAnalyseExpr: see Note [OccInfo in unfoldings and rules] in GHC.Core -- See #20905 for what a discussion of this 'seq'. -- We are careful to make sure we only -- have one copy of an unfolding around at once. @@ -459,7 +459,7 @@ With that in mind we want to maintain the invariant that each unfolding only ref a single CoreExpr. One place where we have to be careful is in mkCoreUnfolding. * The template of the unfolding is the result of performing occurrence analysis - (Note [Occurrence analysis of unfoldings]) + (Note [OccInfo in unfoldings and rules] in GHC.Core) * Predicates are applied to the unanalysed expression Therefore if we are not thoughtful about forcing you can end up in a situation where the ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1008,14 +1008,23 @@ of the type of the method signature. * * ************************************************************************ -This data type is used exclusively by the simplifier, but it appears in a +Note [OccInfo] +~~~~~~~~~~~~~ +The OccInfo data type is used exclusively by the simplifier, but it appears in a SubstResult, which is currently defined in GHC.Types.Var.Env, which is pretty near the base of the module hierarchy. So it seemed simpler to put the defn of -OccInfo here, safely at the bottom +OccInfo here, safely at the bottom. + +Note that `OneOcc` doesn't meant that it occurs /syntactially/ only once; it +means that it is /used/ only once. It might occur syntactically many times. +For example, in (case x of A -> y; B -> y; C -> True), +* `y` is used only once +* but it occurs syntactically twice + -} -- | identifier Occurrence Information -data OccInfo +data OccInfo -- See Note [OccInfo] = ManyOccs { occ_tail :: !TailCallInfo } -- ^ There are many occurrences, or unknown occurrences @@ -1113,8 +1122,9 @@ instance Monoid InsideLam where mappend = (Semi.<>) ----------------- -data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo] - | NoTailCallInfo +data TailCallInfo + = AlwaysTailCalled {-# UNPACK #-} !JoinArity -- See Note [TailCallInfo] + | NoTailCallInfo deriving (Eq) tailCallInfo :: OccInfo -> TailCallInfo ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Types.Var ( -- ** Predicates isId, isTyVar, isTcTyVar, - isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar, + isLocalVar, isLocalId, isLocalId_maybe, isCoVar, isNonCoVarId, isTyCoVar, isGlobalId, isExportedId, mustHaveLocalBinding, @@ -95,6 +95,9 @@ module GHC.Types.Var ( tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, mapVarBndr, mapVarBndrs, + -- ** ExportFlag + ExportFlag(..), + -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -1246,6 +1249,10 @@ isLocalId :: Var -> Bool isLocalId (Id { idScope = LocalId _ }) = True isLocalId _ = False +isLocalId_maybe :: Var -> Maybe ExportFlag +isLocalId_maybe (Id { idScope = LocalId ef }) = Just ef +isLocalId_maybe _ = Nothing + -- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's -- These are the variables that we need to pay attention to when finding free -- variables, or doing dependency analysis. ===================================== testsuite/tests/simplCore/should_compile/T22404.hs ===================================== @@ -0,0 +1,28 @@ +module T22404 where + +{-# NOINLINE foo #-} +foo :: [a] -> (a,a) +foo [x,y] = (x,y) +foo (x:xs) = foo xs + +data T = A | B | C | D + +-- The point of this test is that 'v' ought +-- not to be a thunk in the optimised program +-- It is used only once in each branch. But we +-- need a clever occurrence analyser to spot it; +-- see Note [Occurrence analysis for join points] +-- in GHC.Core.Opt.OccurAnoa + +f x xs = let v = foo xs in + + let {-# NOINLINE j #-} + j True = case v of (a,b) -> a + j False = case v of (a,b) -> b + in + + case x of + A -> j True + B -> j False + C -> case v of (a,b) -> b + D -> x ===================================== testsuite/tests/simplCore/should_compile/T22404.stderr ===================================== ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -492,3 +492,6 @@ test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], m test('T23074', normal, compile, ['-O -ddump-rules']) test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0']) + +# The -ddump-simpl of T22404 should have no let-bindings +test('T22404', [only_ways(['optasm']), check_errmsg(r'let') ], compile, ['-ddump-simpl -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,133 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 137, types: 92, coercions: 4, joins: 0/0} - -lvl = "error"# - -lvl1 = unpackCString# lvl - -$trModule4 = "main"# - -lvl2 = unpackCString# $trModule4 - -$trModule2 = "T21128a"# - -lvl3 = unpackCString# $trModule2 - -lvl4 = "./T21128a.hs"# - -lvl5 = unpackCString# lvl4 - -lvl6 = I# 4# - -lvl7 = I# 20# - -lvl8 = I# 25# - -lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 - -lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack - -$windexError - = \ @a @b ww eta eta1 eta2 -> - error - (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) - (++ (ww eta) (++ (ww eta1) (ww eta2))) - -indexError - = \ @a @b $dShow eta eta1 eta2 -> - case $dShow of { C:Show ww ww1 ww2 -> - $windexError ww1 eta eta1 eta2 - } - -$trModule3 = TrNameS $trModule4 - -$trModule1 = TrNameS $trModule2 - -$trModule = Module $trModule3 $trModule1 - -$wlvl - = \ ww ww1 ww2 -> - $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) - -index - = \ l u i -> - case l of { I# x -> - case i of { I# y -> - case <=# x y of { - __DEFAULT -> case u of { I# ww -> $wlvl y ww x }; - 1# -> - case u of { I# y1 -> - case <# y y1 of { - __DEFAULT -> $wlvl y y1 x; - 1# -> I# (-# y x) - } - } - } - } - } - - - - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 108, types: 47, coercions: 0, joins: 3/4} - -$trModule4 = "main"# - -$trModule3 = TrNameS $trModule4 - -$trModule2 = "T21128"# - -$trModule1 = TrNameS $trModule2 - -$trModule = Module $trModule3 $trModule1 - -i = I# 1# - -l = I# 0# - -lvl = \ y -> $windexError $fShowInt_$cshow l y l - -lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i - -$wtheresCrud - = \ ww ww1 -> - let { y = I# ww1 } in - join { - lvl2 - = case <=# ww 1# of { - __DEFAULT -> case lvl1 ww y of wild { }; - 1# -> - case <# 1# ww1 of { - __DEFAULT -> case lvl1 ww y of wild { }; - 1# -> -# 1# ww - } - } } in - join { - lvl3 - = case <# 0# ww1 of { - __DEFAULT -> case lvl y of wild { }; - 1# -> 0# - } } in - joinrec { - $wgo ww2 - = case ww2 of wild { - __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump lvl3; - 1# -> jump lvl2 - }; } in - jump $wgo ww - -theresCrud - = \ x y -> - case x of { I# ww -> - case y of { I# ww1 -> - case $wtheresCrud ww ww1 of ww2 { __DEFAULT -> I# ww2 } - } - } - - - ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -84,8 +84,11 @@ test('T20510', [ grep_errmsg(r'jump \$wgo') ], compile, ['-dsuppress-uniques -dd test('T20817', [ grep_errmsg(r'Str') ], compile, ['-dsuppress-uniques -ddump-stranal']) # T21150: Check that t{,1,2} haven't been inlined. test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques -ddump-exitify']) + # T21128: Check that y is not reboxed in $wtheresCrud +# If so, there should be no `let` for y test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) + test('T21265', normal, compile, ['']) test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6057a7707f5544f92a5850cdaa063bfa1c7a6b41 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6057a7707f5544f92a5850cdaa063bfa1c7a6b41 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 20:21:45 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 26 Jul 2023 16:21:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/testsuite-cleanup2 Message-ID: <64c18059e3777_2fb451b9a2850646b@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/testsuite-cleanup2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/testsuite-cleanup2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 20:57:36 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 26 Jul 2023 16:57:36 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 2 commits: new test outputs for T18324 and T22086 Message-ID: <64c188c09ce76_2fb451b9adc5215a8@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4523b344 by Apoorv Ingle at 2023-07-26T14:12:49-05:00 new test outputs for T18324 and T22086 - - - - - 2c24c037 by Apoorv Ingle at 2023-07-26T15:55:46-05:00 get locations right for bind statement expressions - - - - - 5 changed files: - compiler/GHC/Tc/Gen/App.hs - testsuite/tests/typecheck/should_fail/DoExpansion2.hs - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr - testsuite/tests/typecheck/should_run/T18324.stdout - + testsuite/tests/typecheck/should_run/T22086.stdout Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -379,7 +379,8 @@ tcApp rn_expr exp_res_ty addHeadCtxt fun_ctxt thing_inside | otherwise = do traceTc "tcApp" (vcat [text "no expansion", ppr rn_fun, ppr fun_ctxt]) - addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $ + setSrcSpan (appCtxtLoc fun_ctxt) $ + addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $ thing_inside -- Match up app_res_rho: the result type of rn_expr @@ -838,9 +839,9 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside addStmtCtxt ((text "addArgCtxt last 2e")) (unLoc stmt) $ thing_inside - VAExpansionStmt stmt@(L _ BindStmt {}) loc + VAExpansionStmt stmt@(L _ BindStmt {}) _ -> do traceTc "addArgCtxt 2e bind" empty - setSrcSpan loc $ + setSrcSpanA arg_loc $ addStmtCtxt ((text "addArgCtxt bind 2e")) (unLoc stmt) $ thing_inside VAExpansionStmt (L _ LetStmt {}) _ ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.hs ===================================== @@ -6,7 +6,7 @@ module DoExpansion2 where getVal :: Int -> IO String getVal _ = return "x" -ffff1, ffff2, ffff3, ffff4, ffff5, ffff6 :: IO Int +ffff1, ffff2, ffff3, ffff4, ffff5, ffff6, ffff7, ffff8 :: IO Int ffff1 = do x <- getChar @@ -29,3 +29,11 @@ ffff5 = do x <- getChar ffff6 = do _ <- (getVal 1) return () -- should error here + + +ffff7 = do Just x <- getVal 3 4 -- should error here + return x + + +ffff8 = do x <- getVal 3 + return x -- should error here ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.stderr ===================================== @@ -11,9 +11,10 @@ DoExpansion2.hs:16:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul Actual: String • In the first argument of ‘return’, namely ‘x’ In a stmt of a 'do' block: return x - In the expression: - do x <- (getVal 3) - return x + In an equation for ‘ffff2’: + ffff2 + = do x <- (getVal 3) + return x DoExpansion2.hs:20:20: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘Char’ @@ -39,15 +40,38 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ • In the pattern: Just x In a stmt of a 'do' block: Just x <- getChar - In the expression: - do x <- getChar - Just x <- getChar - return x + In an equation for ‘ffff5’: + ffff5 + = do x <- getChar + Just x <- getChar + return x DoExpansion2.hs:31:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘()’ • In the first argument of ‘return’, namely ‘()’ In a stmt of a 'do' block: return () + In an equation for ‘ffff6’: + ffff6 + = do _ <- (getVal 1) + return () + +DoExpansion2.hs:34:22: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type: t0 -> IO (Maybe Int) + with actual type: IO String + • The function ‘getVal’ is applied to two value arguments, + but its type ‘Int -> IO String’ has only one + In a stmt of a 'do' block: Just x <- getVal 3 4 In the expression: - do _ <- (getVal 1) - return () + do Just x <- getVal 3 4 + return x + +DoExpansion2.hs:39:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘[Char]’ with ‘Int’ + Expected: Int + Actual: String + • In the first argument of ‘return’, namely ‘x’ + In a stmt of a 'do' block: return x + In an equation for ‘ffff8’: + ffff8 + = do x <- getVal 3 + return x ===================================== testsuite/tests/typecheck/should_run/T18324.stdout ===================================== @@ -1 +1,2 @@ (True,3) +(True,3) ===================================== testsuite/tests/typecheck/should_run/T22086.stdout ===================================== @@ -0,0 +1,4 @@ +CallStack (from HasCallStack): + a do statement, called at T22086.hs:15:5 in main:Main +CallStack (from HasCallStack): + >>, called at T22086.hs:19:11 in main:Main View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5916867163003619fe52b5c6730fbfcf37721bff...2c24c03761c4fea50bc76ce9cfe392e4e837d172 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5916867163003619fe52b5c6730fbfcf37721bff...2c24c03761c4fea50bc76ce9cfe392e4e837d172 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 21:23:19 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 26 Jul 2023 17:23:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-importdecl-span Message-ID: <64c18ec7ce595_2fb451b9a28524796@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-importdecl-span at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-importdecl-span You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 21:23:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 17:23:37 -0400 Subject: [Git][ghc/ghc][master] This MR is an implementation of the proposal #516. Message-ID: <64c18ed939ba_2fb451b9ab4528547@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - 30 changed files: - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/TyThing.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-warnings.rst - testsuite/tests/plugins/all.T - + testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel1.hs - + testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel1.stderr - + testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel2.hs - + testsuite/tests/pmcheck/should_compile/DsIncompleteRecSel2.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/503fd6478086144a00e424d02cc21773a8e0ee24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/503fd6478086144a00e424d02cc21773a8e0ee24 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 21:24:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 17:24:23 -0400 Subject: [Git][ghc/ghc][master] Fix user-facing label in MR template Message-ID: <64c18f0749b1f_2fb451b9ac8532239@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 1 changed file: - .gitlab/merge_request_templates/Default.md Changes: ===================================== .gitlab/merge_request_templates/Default.md ===================================== @@ -9,7 +9,7 @@ Please take a few moments to address the following points: * [ ] if your MR may break existing programs (e.g. touches `base` or causes the compiler to reject programs), please describe the expected breakage and add - the ~"user facing" label. This will run ghc/head.hackage> to characterise + the ~"user-facing" label. This will run ghc/head.hackage> to characterise the effect of your change on Hackage. * [ ] ensure that your commits are either individually buildable or squashed * [ ] ensure that your commit messages describe *what they do* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af6fdf428be85ce21a25477bb1e705eb354791ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af6fdf428be85ce21a25477bb1e705eb354791ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 21:54:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 17:54:54 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: This MR is an implementation of the proposal #516. Message-ID: <64c1962e5ee_2fb451b9ab45375b0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 1fd3fdab by Matthew Pickering at 2023-07-26T17:54:43-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 733b1457 by Matthew Pickering at 2023-07-26T17:54:43-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - b57799a5 by Matthew Pickering at 2023-07-26T17:54:43-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - 03a8fec7 by Matthew Pickering at 2023-07-26T17:54:44-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - 6423de7c by Bodigrim at 2023-07-26T17:54:48-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/TyThing.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-warnings.rst - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6355608317226a0e46c8c70eb707a7e4169bded...6423de7cb17bf6919919a7889323a3ae2d8880dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6355608317226a0e46c8c70eb707a7e4169bded...6423de7cb17bf6919919a7889323a3ae2d8880dd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 22:01:56 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 26 Jul 2023 18:01:56 -0400 Subject: [Git][ghc/ghc][wip/expand-do] get locations right for bind statement expressions Message-ID: <64c197d44bdf3_2fb451b9ac85486f2@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: e66595be by Apoorv Ingle at 2023-07-26T17:01:46-05:00 get locations right for bind statement expressions - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs - testsuite/tests/typecheck/should_fail/DoExpansion2.hs - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -582,6 +582,11 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args | otherwise = noConcreteTyVars + -- isFailFun + -- | HsVar _ (L _ fun_id) <- tc_fun + -- , fun_id `hasKey` failMClassOpKey + -- , isGeneratedSrcSpan (appCtxtLoc fun_ctxt) + -- Count value args only when complaining about a function -- applied to too many value args -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify. @@ -839,10 +844,17 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside thing_inside VAExpansionStmt stmt@(L _ BindStmt {}) loc - -> do traceTc "addArgCtxt 2e bind" empty + | isGeneratedSrcSpan (locA arg_loc) + -> do traceTc "addArgCtxt 2e bind arg_gen" empty setSrcSpan loc $ addStmtCtxt ((text "addArgCtxt bind 2e")) (unLoc stmt) $ thing_inside + | otherwise + -> do traceTc "addArgCtxt 2e bind" empty + setSrcSpanA arg_loc $ + addStmtCtxt ((text "addArgCtxt bind 2e")) (unLoc stmt) $ + thing_inside + VAExpansionStmt (L _ LetStmt {}) _ -> do traceTc "addArgCtxt 2e let" empty thing_inside ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -257,7 +257,7 @@ appCtxtExpr _ = Nothing insideExpansion :: AppCtxt -> Bool insideExpansion (VAExpansion {}) = True insideExpansion (VAExpansionStmt {}) = True -insideExpansion (VACall {}) = False +insideExpansion (VACall {}) = False -- but what if the VACall has a generated context? instance Outputable AppCtxt where ppr (VAExpansion e l) = text "VAExpansion" <+> ppr e <+> ppr l @@ -331,7 +331,7 @@ splitHsApps e = go e (top_ctxt 0 e) [] go (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) fun))) _ args | BodyStmt{} <- s - = go fun (VAExpansionStmt stmt generatedSrcSpan) + = go fun (VAExpansionStmt stmt generatedSrcSpan) -- so that we set (>>) as generated (EWrap (EExpandStmt stmt) : args) | otherwise = go fun (VAExpansionStmt stmt (locA loc)) ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.hs ===================================== @@ -6,7 +6,7 @@ module DoExpansion2 where getVal :: Int -> IO String getVal _ = return "x" -ffff1, ffff2, ffff3, ffff4, ffff5, ffff6 :: IO Int +ffff1, ffff2, ffff3, ffff4, ffff5, ffff6, ffff7, ffff8 :: IO Int ffff1 = do x <- getChar @@ -29,3 +29,11 @@ ffff5 = do x <- getChar ffff6 = do _ <- (getVal 1) return () -- should error here + + +ffff7 = do Just x <- getVal 3 4 -- should error here + return x + + +ffff8 = do x <- getVal 3 + return x -- should error here ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.stderr ===================================== @@ -11,9 +11,10 @@ DoExpansion2.hs:16:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul Actual: String • In the first argument of ‘return’, namely ‘x’ In a stmt of a 'do' block: return x - In the expression: - do x <- (getVal 3) - return x + In an equation for ‘ffff2’: + ffff2 + = do x <- (getVal 3) + return x DoExpansion2.hs:20:20: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘Char’ @@ -39,15 +40,38 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ • In the pattern: Just x In a stmt of a 'do' block: Just x <- getChar - In the expression: - do x <- getChar - Just x <- getChar - return x + In an equation for ‘ffff5’: + ffff5 + = do x <- getChar + Just x <- getChar + return x DoExpansion2.hs:31:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘()’ • In the first argument of ‘return’, namely ‘()’ In a stmt of a 'do' block: return () + In an equation for ‘ffff6’: + ffff6 + = do _ <- (getVal 1) + return () + +DoExpansion2.hs:34:22: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type: t0 -> IO (Maybe Int) + with actual type: IO String + • The function ‘getVal’ is applied to two value arguments, + but its type ‘Int -> IO String’ has only one + In a stmt of a 'do' block: Just x <- getVal 3 4 In the expression: - do _ <- (getVal 1) - return () + do Just x <- getVal 3 4 + return x + +DoExpansion2.hs:39:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘[Char]’ with ‘Int’ + Expected: Int + Actual: String + • In the first argument of ‘return’, namely ‘x’ + In a stmt of a 'do' block: return x + In an equation for ‘ffff8’: + ffff8 + = do x <- getVal 3 + return x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e66595be20f836cd8083df1c604faf145b783211 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e66595be20f836cd8083df1c604faf145b783211 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 22:32:31 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 26 Jul 2023 18:32:31 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 22 commits: EPA: Fix simple tests Message-ID: <64c19effb9c33_2fb451b9a50555188@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: 0846f102 by Alan Zimmerman at 2023-07-24T19:42:14+01:00 EPA: Fix simple tests - - - - - a77a11b7 by Alan Zimmerman at 2023-07-24T20:31:37+01:00 Summary: Patch: use-anchor-end-as-prior-end Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-25 12:41:37 +0100 EPA: Use the current Anchor end as prior end Use the original anchor location end as the source of truth for calculating print deltas. This allows original spacing to apply in most cases, only changed AST items need initial delta positions. - - - - - 6d3e8d27 by Alan Zimmerman at 2023-07-24T20:57:18+01:00 EPA: Add DArrow to TrailingAnn - - - - - 2a5840bd by Alan Zimmerman at 2023-07-24T20:57:29+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 88ba65ae by Alan Zimmerman at 2023-07-24T21:40:45+01:00 Summary: HasTrailing instances - - - - - 868efe6b by Alan Zimmerman at 2023-07-24T21:45:18+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - 84aa60d1 by Alan Zimmerman at 2023-07-25T18:10:17+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - 94343024 by Alan Zimmerman at 2023-07-25T18:18:39+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - c0e34589 by Alan Zimmerman at 2023-07-25T19:27:31+01:00 EPA: deal with fallout from getMonoBind - - - - - edc8b81f by Alan Zimmerman at 2023-07-25T19:47:03+01:00 EPA fix captureLineSpacing - - - - - 55faf537 by Alan Zimmerman at 2023-07-25T20:33:34+01:00 EPA print any comments in the span before exiting it - - - - - c84a9a72 by Alan Zimmerman at 2023-07-25T21:55:32+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - 0be4b088 by Alan Zimmerman at 2023-07-25T22:38:50+01:00 EPA: tweaks to ExactPrint - - - - - cc51d282 by Alan Zimmerman at 2023-07-26T21:46:35+01:00 EPA: Add comments to AnchorOperation - - - - - 0370ca68 by Alan Zimmerman at 2023-07-26T23:29:23+01:00 EPA: remove AnnEofComment It is no longer used - - - - - 7e6bffb1 by Alan Zimmerman at 2023-07-26T23:29:27+01:00 EPA: generalise reLoc - - - - - 5736155b by Alan Zimmerman at 2023-07-26T23:30:05+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 8579239f by Alan Zimmerman at 2023-07-26T23:30:08+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - b21dd1bb by Alan Zimmerman at 2023-07-26T23:30:08+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 4c7ef8c8 by Alan Zimmerman at 2023-07-26T23:30:08+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - dbd274b6 by Alan Zimmerman at 2023-07-26T23:30:09+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 6320a706 by Alan Zimmerman at 2023-07-26T23:30:09+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 30 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Deriv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b44105a5210a18d1755abbdf37e6e51609604434...6320a706f4fbc12a02d0249aa13e0643c1efb4bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b44105a5210a18d1755abbdf37e6e51609604434...6320a706f4fbc12a02d0249aa13e0643c1efb4bf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 23:29:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 26 Jul 2023 19:29:16 -0400 Subject: [Git][ghc/ghc][wip/tsan/fix-races] 45 commits: ghc-toolchain: Initial commit Message-ID: <64c1ac4c43d9a_2fb451b9a3c56139b@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fix-races at Glasgow Haskell Compiler / GHC Commits: 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 5166e3cc by Ben Gamari at 2023-07-26T14:38:18-04:00 compiler: Style fixes - - - - - 1175632b by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 471eb500 by Ben Gamari at 2023-07-26T14:38:18-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - ae5888d0 by Ben Gamari at 2023-07-26T14:38:18-04:00 testsuite: Add AtomicModifyIORef test - - - - - dae5a29e by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - cdc1a61d by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 2d8f2ac1 by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce more principled fence operations - - - - - 5b0aab1e by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Introduce SET_INFO_RELAXED - - - - - 65bd7826 by Ben Gamari at 2023-07-26T14:38:18-04:00 rts: Style fixes - - - - - ecf789cb by Ben Gamari at 2023-07-26T14:38:43-04:00 codeGen/tsan: Rework handling of spilling - - - - - 8280e720 by Ben Gamari at 2023-07-26T14:38:43-04:00 hadrian: More debug information - - - - - 86d7e5dc by Ben Gamari at 2023-07-26T14:38:43-04:00 Improve TSAN documentation - - - - - dbc86a80 by Ben Gamari at 2023-07-26T14:38:43-04:00 hadrian: More selective TSAN instrumentation - - - - - 3218c34c by Ben Gamari at 2023-07-26T15:36:27-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS and only needs relaxed ordering. - - - - - dc923619 by Ben Gamari at 2023-07-26T18:54:19-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - fc0c301e by Ben Gamari at 2023-07-26T18:54:19-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 0f91f5b9 by Ben Gamari at 2023-07-26T18:54:19-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - 40a460c8 by Ben Gamari at 2023-07-26T18:54:20-04:00 rts: Fix data race in Interpreter's preemption check - - - - - a2dbb2bc by Ben Gamari at 2023-07-26T18:54:22-04:00 rts: Fix data race in threadStatus# - - - - - e6e60bff by Ben Gamari at 2023-07-26T18:54:22-04:00 rts: Fix data race in CHECK_GC - - - - - 5ffd69ec by Ben Gamari at 2023-07-26T18:54:22-04:00 base: use atomic write when updating timer manager - - - - - 2b6e78f1 by Ben Gamari at 2023-07-26T18:54:22-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - ea553e5b by Ben Gamari at 2023-07-26T18:54:22-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - c0b2dcca by Ben Gamari at 2023-07-26T19:28:56-04:00 rts: Fix synchronization on thread blocking state - - - - - 7c21614f by Ben Gamari at 2023-07-26T19:28:56-04:00 rts: Use relaxed ordering on dirty/clean info tables updates When changing the dirty/clean state of a mutable object we needn't have any particular ordering. - - - - - 2dd66b52 by Ben Gamari at 2023-07-26T19:28:56-04:00 Wordsmith TSAN Note - - - - - 779544fe by Ben Gamari at 2023-07-26T19:28:56-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 8e961f1d by Ben Gamari at 2023-07-26T19:28:56-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 4e67b2ec by Ben Gamari at 2023-07-26T19:28:56-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 8603f75e by Ben Gamari at 2023-07-26T19:28:56-04:00 rts/Interpreter: Fix data race - - - - - 35450d87 by Ben Gamari at 2023-07-26T19:28:57-04:00 rts/Messages: Fix data race - - - - - 15540e63 by Ben Gamari at 2023-07-26T19:28:57-04:00 rts/Prof: Fix data race - - - - - e1ae6715 by Ben Gamari at 2023-07-26T19:28:57-04:00 rts: Use fence rather than redundant load Previously we would use an atomic load to ensure acquire ordering. However, we now have `ACQUIRE_FENCE_ON`, which allows us to express this more directly. - - - - - 640453cb by Ben Gamari at 2023-07-26T19:28:57-04:00 rts: Fix data races in profiling timer - - - - - d001bd84 by Ben Gamari at 2023-07-26T19:28:57-04:00 rts/RaiseAsync: Drop redundant release fence - - - - - 30 changed files: - .gitlab-ci.yml - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690a4e4fac47008933e58836b6f3d28d772d7d68...d001bd8446b1e539016064db84c1adc7776d83e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/690a4e4fac47008933e58836b6f3d28d772d7d68...d001bd8446b1e539016064db84c1adc7776d83e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Jul 26 23:39:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 26 Jul 2023 19:39:33 -0400 Subject: [Git][ghc/ghc][wip/T23721] 9 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c1aeb5173c5_2fb451b9a64563557@gitlab.mail> Ben Gamari pushed to branch wip/T23721 at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - d5e79ff4 by Ben Gamari at 2023-07-26T19:38:35-04:00 testsuite: Mark MulMayOflo_full as broken rather than skipping To ensure that we don't accidentally fix it. See #23742. - - - - - 6acd7f2e by Ben Gamari at 2023-07-26T19:39:26-04:00 nativeGen/AArch64: Fix sign extension in MulMayOflo Previously the 32-bit implementations of MulMayOflo would use the a non-sensical sign-extension mode. Rewrite these to reflect what gcc 11 produces. Also similarly rework the 16- and 8-bit cases. This now passes the MulMayOflo tests in ghc/test-primops> in all four widths. Fixes #23721. - - - - - 30 changed files: - .gitlab/merge_request_templates/Default.md - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/TyThing.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d35507303af1d19a62fceb04ec87c2f54c1a3919...6acd7f2ef705d5f39def85ea955cb66ae314b611 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d35507303af1d19a62fceb04ec87c2f54c1a3919...6acd7f2ef705d5f39def85ea955cb66ae314b611 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 00:40:38 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 26 Jul 2023 20:40:38 -0400 Subject: [Git][ghc/ghc][wip/expand-do] fixing DoExpanion2 test Message-ID: <64c1bd06b1d4c_2fb451b9ab4574943@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: ac4d0665 by Apoorv Ingle at 2023-07-26T19:40:23-05:00 fixing DoExpanion2 test - - - - - 2 changed files: - compiler/GHC/Tc/Gen/App.hs - testsuite/tests/typecheck/should_fail/DoExpansion2.stderr Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -567,7 +567,13 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args fun_orig = case fun_ctxt of VAExpansionStmt{} -> DoOrigin VAExpansion e _ -> exprCtOrigin e - VACall e _ _ -> exprCtOrigin e + VACall e _ _ + | HsVar _ (L _ fun_id) <- tc_fun + , fun_id `hasKey` failMClassOpKey + , isGeneratedSrcSpan (appCtxtLoc fun_ctxt) + -> DoOrigin -- Ideally i want the pattern here that is failable but thats in another branch + | otherwise + -> exprCtOrigin e -- These are the type variables which must be instantiated to concrete -- types. See Note [Representation-polymorphic Ids with no binding] @@ -582,11 +588,6 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args | otherwise = noConcreteTyVars - -- isFailFun - -- | HsVar _ (L _ fun_id) <- tc_fun - -- , fun_id `hasKey` failMClassOpKey - -- , isGeneratedSrcSpan (appCtxtLoc fun_ctxt) - -- Count value args only when complaining about a function -- applied to too many value args -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify. ===================================== testsuite/tests/typecheck/should_fail/DoExpansion2.stderr ===================================== @@ -11,10 +11,9 @@ DoExpansion2.hs:16:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul Actual: String • In the first argument of ‘return’, namely ‘x’ In a stmt of a 'do' block: return x - In an equation for ‘ffff2’: - ffff2 - = do x <- (getVal 3) - return x + In the expression: + do x <- (getVal 3) + return x DoExpansion2.hs:20:20: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘Char’ @@ -40,20 +39,18 @@ DoExpansion2.hs:27:12: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul • Couldn't match expected type ‘Char’ with actual type ‘Maybe Int’ • In the pattern: Just x In a stmt of a 'do' block: Just x <- getChar - In an equation for ‘ffff5’: - ffff5 - = do x <- getChar - Just x <- getChar - return x + In the expression: + do x <- getChar + Just x <- getChar + return x DoExpansion2.hs:31:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘()’ • In the first argument of ‘return’, namely ‘()’ In a stmt of a 'do' block: return () - In an equation for ‘ffff6’: - ffff6 - = do _ <- (getVal 1) - return () + In the expression: + do _ <- (getVal 1) + return () DoExpansion2.hs:34:22: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type: t0 -> IO (Maybe Int) @@ -71,7 +68,6 @@ DoExpansion2.hs:39:19: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefaul Actual: String • In the first argument of ‘return’, namely ‘x’ In a stmt of a 'do' block: return x - In an equation for ‘ffff8’: - ffff8 - = do x <- getVal 3 - return x + In the expression: + do x <- getVal 3 + return x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac4d0665fee2cee3108fcf1ef814c5631b67da35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac4d0665fee2cee3108fcf1ef814c5631b67da35 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 02:05:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 26 Jul 2023 22:05:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ci: Test bootstrapping configurations with full-ci and on marge batches Message-ID: <64c1d0f65c72d_2fb451b9a8c59957e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fb0a3c0d by Matthew Pickering at 2023-07-26T22:05:34-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 85a6b8c6 by Matthew Pickering at 2023-07-26T22:05:34-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - a9f73f51 by Matthew Pickering at 2023-07-26T22:05:34-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c26cd289 by Matthew Pickering at 2023-07-26T22:05:34-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - 08a3b698 by Bodigrim at 2023-07-26T22:05:38-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 10 changed files: - .gitlab-ci.yml - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6423de7cb17bf6919919a7889323a3ae2d8880dd...08a3b698b05e01cd74d8547b56a7cd5f9ee8b432 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6423de7cb17bf6919919a7889323a3ae2d8880dd...08a3b698b05e01cd74d8547b56a7cd5f9ee8b432 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 07:16:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 27 Jul 2023 03:16:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ci: Test bootstrapping configurations with full-ci and on marge batches Message-ID: <64c219ddf17fc_2fb451b9a64640164@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0e105a4d by Matthew Pickering at 2023-07-27T03:16:38-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 458e5321 by Matthew Pickering at 2023-07-27T03:16:38-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 57a0b00c by Matthew Pickering at 2023-07-27T03:16:38-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - 0ec5c135 by Matthew Pickering at 2023-07-27T03:16:38-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - 01cdbf21 by Bodigrim at 2023-07-27T03:16:40-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 10 changed files: - .gitlab-ci.yml - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08a3b698b05e01cd74d8547b56a7cd5f9ee8b432...01cdbf214afb1cb356f6f5727583ddce032456bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/08a3b698b05e01cd74d8547b56a7cd5f9ee8b432...01cdbf214afb1cb356f6f5727583ddce032456bb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 08:22:00 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 27 Jul 2023 04:22:00 -0400 Subject: [Git][ghc/ghc][wip/T22404] Another try at making occ_anal_lam_tail more inefficient Message-ID: <64c229288fea9_2fb451b9a7866124f@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 73c78274 by Simon Peyton Jones at 2023-07-27T09:21:23+01:00 Another try at making occ_anal_lam_tail more inefficient Avoid the environment swizzling when there are no binder swaps - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2175,13 +2175,14 @@ occAnalLamTail env expr occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Does not markInsidLam etc for the outmost batch of lambdas occ_anal_lam_tail env expr@(Lam {}) - = go env emptyVarSet [] expr + = go env [] expr where - go :: OccEnv -> VarSet -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr - go env bndr_set rev_bndrs (Lam bndr body) + go :: OccEnv -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env rev_bndrs (Lam bndr body) | isTyVar bndr - = go env (bndr_set `extendVarSet` bndr) (bndr:rev_bndrs) body - -- Important: Do not modify occ_encl, so that with a RHS like + = go env (bndr:rev_bndrs) body + -- Important: Unlike a value binder, do not modify occ_encl + -- to OccVanilla, so that with a RHS like -- \(@ x) -> K @x (f @x) -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain -- from inlining f. See the beginning of Note [Cascading inlines]. @@ -2196,10 +2197,10 @@ occ_anal_lam_tail env expr@(Lam {}) -- due to explicit use of the magic 'oneShot' function. -- See Note [The oneShot function] env' = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - in go env' (bndr_set `extendVarSet` bndr') (bndr':rev_bndrs) body + in go env' (bndr':rev_bndrs) body - go env bndr_set rev_bndrs body - = addInScope env bndr_set $ \env -> + go env rev_bndrs body + = addInScope env rev_bndrs $ \env -> let !(WUD usage body') = occ_anal_lam_tail env body wrap_lam body bndr = Lam (tagLamBinder usage bndr) body in WUD (usage `addLamCoVarOccs` rev_bndrs) @@ -2935,25 +2936,32 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScopeList :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a {-# INLINE addInScopeList #-} -addInScopeList env bndrs = addInScope env (mkVarSet bndrs) +addInScopeList env bndrs = addInScope env bndrs addInScopeOne :: OccEnv -> Id -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a {-# INLINE addInScopeOne #-} -addInScopeOne env bndr = addInScope env (unitVarSet bndr) +addInScopeOne env bndr = addInScope env [bndr] -addInScope :: OccEnv -> VarSet +addInScope :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a {-# INLINE addInScope #-} -- This function is called a lot, so we want to inline the fast path -- The bndr_set must include TyVars as well as Ids, because of (BS3) -- in Note [Binder swap] -addInScope env bndr_set thing_inside +addInScope env bndrs thing_inside + | isEmptyVarEnv (occ_bs_env env) + , isEmptyVarEnv (occ_join_points env) + , WUD uds res <- thing_inside env + = WUD (delBndrsFromUDs bndrs uds) res + + | otherwise = WUD uds' res where + bndr_set = mkVarSet bndrs !(env', bad_joins) = preprocess_env env bndr_set !(WUD uds res) = thing_inside env' - uds' = postprocess_uds bndr_set bad_joins uds + uds' = postprocess_uds bndrs bad_joins uds preprocess_env :: OccEnv -> VarSet -> (OccEnv, JoinPointInfo) preprocess_env env@(OccEnv { occ_join_points = join_points @@ -2965,6 +2973,8 @@ preprocess_env env@(OccEnv { occ_join_points = join_points drop_shadowed_swaps :: OccEnv -> OccEnv -- See Note [The binder-swap substitution] (BS3) drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env }) + | isEmptyVarEnv swap_env + = env | bs_rng_vars `intersectsVarSet` bndr_set = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } | otherwise @@ -2989,9 +2999,9 @@ preprocess_env env@(OccEnv { occ_join_points = join_points not (bndr_fm `disjointUFM` join_uds) || rest -postprocess_uds :: VarSet -> JoinPointInfo -> UsageDetails -> UsageDetails -postprocess_uds bndr_set bad_joins uds - = add_bad_joins (delBndrsFromUDs bndr_set uds) +postprocess_uds :: [Var] -> JoinPointInfo -> UsageDetails -> UsageDetails +postprocess_uds bndrs bad_joins uds + = add_bad_joins (delBndrsFromUDs bndrs uds) where add_bad_joins :: UsageDetails -> UsageDetails -- Add usage info for occ_join_points that we cannot push inwards @@ -3585,17 +3595,14 @@ mkSimpleDetails env = UD { ud_env = env modifyUDEnv :: (OccInfoEnv -> OccInfoEnv) -> UsageDetails -> UsageDetails modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env } -delBndrsFromUDs :: VarSet -> UsageDetails -> UsageDetails +delBndrsFromUDs :: [Var] -> UsageDetails -> UsageDetails -- Delete these binders from the UsageDetails -delBndrsFromUDs bndr_set (UD { ud_env = env, ud_z_many = z_many - , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail }) - = UD { ud_env = env `minusUFM` bndr_fm - , ud_z_many = z_many `minusUFM` bndr_fm - , ud_z_in_lam = z_in_lam `minusUFM` bndr_fm - , ud_z_tail = z_tail `minusUFM` bndr_fm } - where - bndr_fm :: UniqFM Var Var - bndr_fm = getUniqSet bndr_set +delBndrsFromUDs bndrs (UD { ud_env = env, ud_z_many = z_many + , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail }) + = UD { ud_env = env `delVarEnvList` bndrs + , ud_z_many = z_many `delVarEnvList` bndrs + , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs + , ud_z_tail = z_tail `delVarEnvList` bndrs } markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73c782743d267d55f69012cd7ba5f4571e7d33f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/73c782743d267d55f69012cd7ba5f4571e7d33f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 08:23:28 2023 From: gitlab at gitlab.haskell.org (Zubin (@wz1000)) Date: Thu, 27 Jul 2023 04:23:28 -0400 Subject: [Git][ghc/ghc][wip/9.4.6-backports] Refactor the simplifier a bit to fix #22761 Message-ID: <64c229805fdf2_2fb451b9a3c661738@gitlab.mail> Zubin pushed to branch wip/9.4.6-backports at Glasgow Haskell Compiler / GHC Commits: 47a0ba63 by Simon Peyton Jones at 2023-07-27T13:51:49+05:30 Refactor the simplifier a bit to fix #22761 The core change in this commit, which fixes #22761, is that * In a Core rule, ru_rhs is always occ-analysed. This means adding a couple of calls to occurAnalyseExpr when building a Rule, in * GHC.Core.Rules.mkRule * GHC.Core.Opt.Simplify.Iteration.simplRules But diagosing the bug made me stare carefully at the code of the Simplifier, and I ended up doing some only-loosely-related refactoring. * I think that RULES could be lost because not every code path did addBndrRules * The code around lambdas was very convoluted It's mainly moving deck chairs around, but I like it more now. (cherry picked from commit e45eb82830d6de4d09abb548e190be980dd001b4) (cherry picked from commit e0f3aec8f4537fb75f2b38db0da6b7b52d8d29d6) - - - - - 5 changed files: - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Rules.hs - + testsuite/tests/simplCore/should_compile/T22761.hs - + testsuite/tests/simplCore/should_compile/T22761a.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -4299,7 +4299,9 @@ simplRules env mb_new_id rules bind_cxt ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' , ru_args = args' - , ru_rhs = rhs' }) } + , ru_rhs = occurAnalyseExpr rhs' }) } + -- Remember to occ-analyse, to drop dead code. + -- See Note [OccInfo in unfoldings and rules] in GHC.Core {- Note [Simplifying the RHS of a RULE] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -50,6 +50,7 @@ import GHC.Core.Type as Type import GHC.Core.Coercion as Coercion import GHC.Core.Tidy ( tidyRules ) import GHC.Core.Map.Expr ( eqCoreExpr ) +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Tc.Utils.TcType ( tcSplitTyConApp_maybe ) import GHC.Builtin.Types ( anyTypeOfKind ) @@ -190,13 +191,18 @@ mkRule :: Module -> Bool -> Bool -> RuleName -> Activation -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being -- compiled. See also 'GHC.Core.CoreRule' mkRule this_mod is_auto is_local name act fn bndrs args rhs - = Rule { ru_name = name, ru_fn = fn, ru_act = act, - ru_bndrs = bndrs, ru_args = args, - ru_rhs = rhs, - ru_rough = roughTopNames args, - ru_origin = this_mod, - ru_orphan = orph, - ru_auto = is_auto, ru_local = is_local } + = Rule { ru_name = name + , ru_act = act + , ru_fn = fn + , ru_bndrs = bndrs + , ru_args = args + , ru_rhs = occurAnalyseExpr rhs + -- See Note [OccInfo in unfoldings and rules] + , ru_rough = roughTopNames args + , ru_origin = this_mod + , ru_orphan = orph + , ru_auto = is_auto + , ru_local = is_local } where -- Compute orphanhood. See Note [Orphans] in GHC.Core.InstEnv -- A rule is an orphan only if none of the variables ===================================== testsuite/tests/simplCore/should_compile/T22761.hs ===================================== @@ -0,0 +1,40 @@ +module T22761 where + +import T22761a + +newtype Mod m = Mod m deriving Num + +gcdExt :: Integer -> (Integer, Integer) +gcdExt x = go 0 x + where + go !_ 0 = (1, 1) + go r _ = go r r + +pow :: (Num m) => Mod m -> Mod m +pow x = x*x*x +{-# NOINLINE [1] pow #-} +{-# RULES +"powMod/3/Int" forall x. pow x = x*x*x +#-} + + +-- GHC puts `boo1` after `wom1` (since they don't appear connected) +-- Then { wom1 = foo True } rewrites to { wom1 = boo False } +-- so we need to do glomming. And that triggers the bug +-- in the RULE for `pow`! +-- +-- wom2/boo2 are there to still elicit the bug if +-- GHC reverses its default ordering + +{-# RULES +"wombat1" foo True = boo1 False +#-} + +wom1 = foo True +boo1 x = x + +{-# RULES +"wombat2" foo True = boo2 False +#-} +boo2 x = x +wom2 = foo True ===================================== testsuite/tests/simplCore/should_compile/T22761a.hs ===================================== @@ -0,0 +1,4 @@ +module T22761a where + +{-# NOINLINE [0] foo #-} +foo x = x ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -398,3 +398,4 @@ test('T22112', [ grep_errmsg('never matches') ], compile, ['-O -dsuppress-unique test('T22491', normal, compile, ['-O2']) test('T21476', normal, compile, ['']) test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings -fno-omit-interface-pragmas -fno-ignore-interface-pragmas']) +test('T22761', normal, multimod_compile, ['T22761', '-O2 -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47a0ba6380df28564f256323b345ebfff8944341 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/47a0ba6380df28564f256323b345ebfff8944341 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 08:56:27 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 27 Jul 2023 04:56:27 -0400 Subject: [Git][ghc/ghc][wip/T22404] Wibble Message-ID: <64c2313b8664e_2fb451b9adc671237@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 0233775d by Simon Peyton Jones at 2023-07-27T09:56:17+01:00 Wibble - - - - - 1 changed file: - compiler/GHC/Core/Opt/OccurAnal.hs Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -2936,7 +2936,9 @@ isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of addInScopeList :: OccEnv -> [Var] -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a {-# INLINE addInScopeList #-} -addInScopeList env bndrs = addInScope env bndrs +addInScopeList env bndrs thing_inside + | null bndrs = thing_inside env + | otherwise = addInScope env bndrs thing_inside addInScopeOne :: OccEnv -> Id -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a @@ -2955,7 +2957,7 @@ addInScope env bndrs thing_inside , WUD uds res <- thing_inside env = WUD (delBndrsFromUDs bndrs uds) res - | otherwise +addInScope env bndrs thing_inside = WUD uds' res where bndr_set = mkVarSet bndrs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0233775d7b07fe8bcd7ffd8b92d492b96e9b0e90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0233775d7b07fe8bcd7ffd8b92d492b96e9b0e90 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 09:46:09 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Thu, 27 Jul 2023 05:46:09 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] 18 commits: ghc-toolchain: Initial commit Message-ID: <64c23ce17603_2fb451b9a3c68124c@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 45bc968c by David Knothe at 2023-07-27T11:42:30+02:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bbe7aa6d14f65eb5b53214f07ec6ec2af7bad62c...45bc968cf59df4ad84d8c4338cd8c1ad5e8da010 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bbe7aa6d14f65eb5b53214f07ec6ec2af7bad62c...45bc968cf59df4ad84d8c4338cd8c1ad5e8da010 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 09:47:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 27 Jul 2023 05:47:29 -0400 Subject: [Git][ghc/ghc][master] 4 commits: ci: Test bootstrapping configurations with full-ci and on marge batches Message-ID: <64c23d3199b36_2fb451b9a786859b9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - 10 changed files: - .gitlab-ci.yml - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af6fdf428be85ce21a25477bb1e705eb354791ef...c8c6eab1f8d867cfaf218f998a21b655b8bb0f4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af6fdf428be85ce21a25477bb1e705eb354791ef...c8c6eab1f8d867cfaf218f998a21b655b8bb0f4c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 09:47:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 27 Jul 2023 05:47:50 -0400 Subject: [Git][ghc/ghc][master] Link reference paper and package from System.Mem.{StableName,Weak} Message-ID: <64c23d465fb84_2fb451b9a8c689728@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 2 changed files: - libraries/base/System/Mem/StableName.hs - libraries/base/System/Mem/Weak.hs Changes: ===================================== libraries/base/System/Mem/StableName.hs ===================================== @@ -22,6 +22,13 @@ -- collector, meaning a re-hash would be necessary after every garbage -- collection. -- +-- See [Stretching the storage manager: weak pointers and stable names in +-- Haskell](https://www.microsoft.com/en-us/research/publication/stretching-the-storage-manager-weak-pointers-and-stable-names-in-haskell/) +-- by Simon Peyton Jones, Simon Marlow and Conal Elliott for detailed discussion +-- of stable names. An implementation of a memo table with stable names +-- can be found in [@stable-memo@](https://hackage.haskell.org/package/stable-memo) +-- package. +-- ------------------------------------------------------------------------------- module System.Mem.StableName ( ===================================== libraries/base/System/Mem/Weak.hs ===================================== @@ -47,6 +47,13 @@ -- generalisation of the basic weak-pointer idea, in which each -- weak pointer actually contains both a key and a value. -- +-- See [Stretching the storage manager: weak pointers and stable names in +-- Haskell](https://www.microsoft.com/en-us/research/publication/stretching-the-storage-manager-weak-pointers-and-stable-names-in-haskell/) +-- by Simon Peyton Jones, Simon Marlow and Conal Elliott for detailed discussion +-- of weak pointers. An implementation of a memo table with weak pointers +-- can be found in [@stable-memo@](https://hackage.haskell.org/package/stable-memo) +-- package. +-- ----------------------------------------------------------------------------- module System.Mem.Weak ( View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a80ca0868cac6e08fc56387852826457ff07569f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a80ca0868cac6e08fc56387852826457ff07569f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 10:04:32 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 06:04:32 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] 4 commits: ghc-toolchain: Parse javascript and ghcjs as a Arch and OS Message-ID: <64c24130f26e9_2fb451b9a78697189@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: 08158c62 by Rodrigo Mesquita at 2023-07-26T17:08:14+01:00 ghc-toolchain: Parse javascript and ghcjs as a Arch and OS - - - - - f57983f0 by Rodrigo Mesquita at 2023-07-26T17:08:31+01:00 ghc-toolchain: Fix ranlib option - - - - - aba57719 by Rodrigo Mesquita at 2023-07-26T17:09:40+01:00 Check Link Works with -Werror - - - - - ac8584b4 by Matthew Pickering at 2023-07-27T11:02:06+01:00 Only check for no_compact_unwind support on darwin While writing ghc-toolchain we noticed that the FP_PROG_LD_NO_COMPACT_UNWIND check is subtly wrong. Specifically, we pass -Wl,-no_compact_unwind to cc. However, ld.gold interprets this as -n o_compact_unwind, which is a valid argument. Fixes #23676 - - - - - 4 changed files: - m4/fp_prog_ld_no_compact_unwind.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -5,14 +5,21 @@ AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], [ AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_ld_no_compact_unwind=yes -else - fp_cv_ld_no_compact_unwind=no -fi -rm -rf conftest*]) +[ +case $build in + *-darwin) + echo 'int foo() { return 0; }' > conftest.c + ${CC-cc} -c conftest.c + if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then + fp_cv_ld_no_compact_unwind=yes + else + fp_cv_ld_no_compact_unwind=no + fi + rm -rf conftest* ;; + *) + fp_cv_ld_no_compact_unwind=no ;; +esac +]) FP_CAPITALIZE_YES_NO(["$fp_cv_ld_no_compact_unwind"], [LdHasNoCompactUnwind]) AC_SUBST([LdHasNoCompactUnwind]) ])# FP_PROG_LD_NO_COMPACT_UNWIND ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -146,7 +146,7 @@ options = , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr - , progOpts "ranlib" "ranlib utility" _optAr + , progOpts "ranlib" "ranlib utility" _optRanlib , progOpts "nm" "nm archiver" _optNm , progOpts "readelf" "readelf utility" _optReadelf , progOpts "merge-objs" "linker for merging objects" _optMergeObjs ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -53,6 +53,7 @@ parseArch cc arch = "riscv64" -> pure ArchRISCV64 "hppa" -> pure ArchUnknown "wasm32" -> pure ArchWasm32 + "javascript" -> pure ArchJavaScript _ -> throwE $ "Unknown architecture " ++ arch parseOs :: String -> M OS @@ -76,6 +77,7 @@ parseOs os = "aix" -> pure OSAIX "gnu" -> pure OSHurd "wasi" -> pure OSWasi + "ghcjs" -> pure OSGhcjs _ -> throwE $ "Unknown operating system " ++ os splitOn :: Char -> String -> [String] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -57,7 +57,7 @@ findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compile findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink ccLinkProgram <- linkSupportsTarget cc target ccLinkProgram ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram - ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram + ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind archOs cc ccLinkProgram ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram ccLinkIsGnu <- checkLinkIsGnu ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram @@ -124,16 +124,18 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- * Check if compiling for darwin -- * Then do the check -- * Otherwise say its just not supported -checkSupportsCompactUnwind :: Cc -> Program -> M Bool -checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ - withTempDir $ \dir -> do - let test_o = dir "test.o" - test2_o = dir "test2.o" +checkSupportsCompactUnwind :: ArchOS -> Cc -> Program -> M Bool +checkSupportsCompactUnwind archOs cc ccLink + | OSDarwin <- archOS_OS archOs = checking "whether the cc linker understands -no_compact_unwind" $ + withTempDir $ \dir -> do + let test_o = dir "test.o" + test2_o = dir "test2.o" - compileC cc test_o "int foo() { return 0; }" + compileC cc test_o "int foo() { return 0; }" - exitCode <- runProgram ccLink ["-r", "-Wl,-no_compact_unwind", "-o", test2_o, test_o] - return $ isSuccess exitCode + exitCode <- runProgram ccLink ["-r", "-Wl,-no_compact_unwind", "-o", test2_o, test_o] + return $ isSuccess exitCode + | otherwise = return False checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -163,7 +165,7 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do let out = dir "test" err = "linker didn't produce any output" - callProgram ccLink ["-o", out, test_o, main_o] + callProgram ccLink ["-Werror", "-o", out, test_o, main_o] expectFileExists out err -- Linking in windows might produce an executable with an ".exe" extension <|> expectFileExists (out <.> "exe") err View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c2ba60da2991a08bdd01af9d3d267da1c9f5086...ac8584b429184fb6f10fa3d6ee7068239b3a8a0c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c2ba60da2991a08bdd01af9d3d267da1c9f5086...ac8584b429184fb6f10fa3d6ee7068239b3a8a0c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 11:57:37 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 07:57:37 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] 10 commits: ghc-toolchain: Match CPP args with configure script Message-ID: <64c25bb1b7045_2fb451b9a287155c0@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: bf644b17 by Matthew Pickering at 2023-07-27T12:56:50+01:00 ghc-toolchain: Match CPP args with configure script At the moment we need ghc-toolchain to precisely match the output as provided by the normal configure script. The normal configure script (FP_HSCPP_CMD_WITH_ARGS) branches on whether we are using clang or gcc so we match that logic exactly in ghc-toolchain. The old implementation (which checks if certain flags are supported) is better but for now we have to match to catch any potential errors in the configuration. Ticket: #23720 - - - - - 0eafebf4 by Matthew Pickering at 2023-07-27T12:56:50+01:00 configure: Fix `-Wl,--no-as-needed` check The check was failing because the args supplied by $$1 were quoted which failed because then the C compiler thought they were an input file. Fixes #23720 - - - - - 69c18bcd by Matthew Pickering at 2023-07-27T12:56:50+01:00 configure: Add flag which turns ghc-toolchain check into error We want to catch these errors in CI, but first we need to a flag which turns this check into an error. - - - - - d6667ade by Matthew Pickering at 2023-07-27T12:56:50+01:00 ci: Enable --enable-strict-ghc-toolchain-check for all CI jobs This will cause any CI job to fail if we have a mismatch between what ghc-toolchain reports and what ./configure natively reports. Fixing these kinds of issues is highest priority for 9.10 release. - - - - - 043a5145 by Rodrigo Mesquita at 2023-07-27T12:56:50+01:00 Pass user-specified options to ghc-toolchain The current user interface to configuring target toolchains is `./configure`. In !9263 we added a new tool to configure target toolchains called `ghc-toolchain`, but the blessed way of creating these toolchains is still through configure. However, we were not passing the user-specified options given with the `./configure` invocation to the ghc-toolchain tool. This commit remedies that by storing the user options and environment variables in USER_* variables, which then get passed to GHC-toolchain. The exception to the rule is the windows bundled toolchain, which overrides the USER_* variables with whatever flags the windows bundled toolchain requires to work. We consider the bundled toolchain to be effectively the user specifying options, since the actual user delegated that configuration work. Closes #23678 - - - - - 4afca2ed by Matthew Pickering at 2023-07-27T12:56:50+01:00 HACK: remove dependency on hadrian-ghci job - - - - - 2461f5df by Rodrigo Mesquita at 2023-07-27T12:56:50+01:00 ghc-toolchain: Parse javascript and ghcjs as a Arch and OS - - - - - 3dda25ec by Rodrigo Mesquita at 2023-07-27T12:56:50+01:00 ghc-toolchain: Fix ranlib option - - - - - b6eec13a by Rodrigo Mesquita at 2023-07-27T12:56:50+01:00 Check Link Works with -Werror - - - - - e9921441 by Matthew Pickering at 2023-07-27T12:56:50+01:00 Only check for no_compact_unwind support on darwin While writing ghc-toolchain we noticed that the FP_PROG_LD_NO_COMPACT_UNWIND check is subtly wrong. Specifically, we pass -Wl,-no_compact_unwind to cc. However, ld.gold interprets this as -n o_compact_unwind, which is a valid argument. Fixes #23676 - - - - - 14 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - configure.ac - m4/fp_cpp_cmd_with_args.m4 - m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_link_supports_no_as_needed.m4 - m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_setup_windows_toolchain.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -157,6 +157,7 @@ configureArgsStr bc = unwords $ ++ ["--with-intree-gmp" | Just _ <- pure (crossTarget bc) ] ++ ["--with-system-libffi" | crossTarget bc == Just "wasm32-wasi" ] ++ ["--enable-ipe-data-compression" | withZstd bc ] + ++ ["--enable-strict-ghc-toolchain-check"] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -728,7 +729,7 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAllowFailure = False jobStage = "full-build" - jobNeeds = ["hadrian-ghc-in-ghci"] + jobNeeds = [] --["hadrian-ghc-in-ghci"] --------------------------------------------------------------------------- -- Job Modifiers ===================================== .gitlab/jobs.yaml ===================================== @@ -29,12 +29,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -56,7 +51,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -94,12 +89,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -121,7 +111,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } @@ -155,12 +145,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -182,7 +167,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate" } @@ -216,12 +201,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -243,7 +223,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", @@ -282,12 +262,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -309,7 +284,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" @@ -344,12 +319,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -371,7 +341,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -406,12 +376,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -433,7 +398,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" @@ -468,12 +433,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -495,7 +455,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -537,12 +497,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -564,7 +519,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -601,12 +556,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -629,7 +579,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -666,12 +616,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -694,7 +639,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -731,12 +676,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -759,7 +699,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -796,12 +736,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -823,7 +758,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -860,12 +795,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -887,7 +817,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -924,12 +854,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -951,7 +876,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -988,12 +913,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-centos7:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1015,7 +935,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", @@ -1051,12 +971,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1078,7 +993,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" @@ -1113,12 +1028,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1140,7 +1050,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" @@ -1175,12 +1085,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1202,7 +1107,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", @@ -1238,12 +1143,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1265,7 +1165,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" @@ -1300,12 +1200,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1327,7 +1222,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" @@ -1362,12 +1257,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1389,7 +1279,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" @@ -1424,12 +1314,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1451,7 +1336,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" @@ -1486,12 +1371,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1513,7 +1393,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -1550,12 +1430,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1577,7 +1452,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -1614,12 +1489,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1641,7 +1511,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -1679,12 +1549,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1706,7 +1571,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" @@ -1741,12 +1606,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1768,7 +1628,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc", "XZ_OPT": "-9" @@ -1803,12 +1663,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1830,7 +1685,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" @@ -1865,12 +1720,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1892,7 +1742,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -1929,12 +1779,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -1956,7 +1801,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", @@ -1994,12 +1839,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2021,7 +1861,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -2058,12 +1898,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-rocky8:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2085,7 +1920,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", @@ -2121,12 +1956,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu18_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2148,7 +1978,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" @@ -2183,12 +2013,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu20_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2210,7 +2035,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" @@ -2241,12 +2066,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2268,7 +2088,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2303,12 +2123,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2330,7 +2145,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", @@ -2369,12 +2184,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2396,7 +2206,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2436,12 +2246,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2463,7 +2268,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2500,12 +2305,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2527,7 +2327,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2564,12 +2364,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2591,7 +2386,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", @@ -2634,12 +2429,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2662,7 +2452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2700,12 +2490,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2728,7 +2513,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2766,12 +2551,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2794,7 +2574,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", @@ -2832,12 +2612,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-centos7:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2859,7 +2634,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-centos7-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2896,12 +2671,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2923,7 +2693,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -2960,12 +2730,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -2987,7 +2752,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3024,12 +2789,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3051,7 +2811,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3088,12 +2848,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3115,7 +2870,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc", "BUILD_FLAVOUR": "release+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", @@ -3152,12 +2907,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3179,7 +2929,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3216,12 +2966,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3243,7 +2988,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3282,12 +3027,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3309,7 +3049,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release+debug_info", "BUILD_FLAVOUR": "release+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3348,12 +3088,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3375,7 +3110,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--haddock-base-url --hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", @@ -3414,12 +3149,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-rocky8:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3441,7 +3171,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-rocky8-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3478,12 +3208,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu18_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3505,7 +3230,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3542,12 +3267,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu20_04:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3569,7 +3289,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", "RUNTEST_ARGS": "", @@ -3602,12 +3322,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3629,7 +3344,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-int_native-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3665,12 +3380,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3692,7 +3402,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-release", "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", @@ -3732,12 +3442,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3759,7 +3464,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-darwin-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi ", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", @@ -3800,12 +3505,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3827,7 +3527,7 @@ "BIN_DIST_NAME": "ghc-x86_64-freebsd13-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", + "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "RUNTEST_ARGS": "", @@ -3863,12 +3563,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3891,7 +3586,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", - "CONFIGURE_ARGS": "--disable-ld-override ", + "CONFIGURE_ARGS": "--disable-ld-override --enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", "RUNTEST_ARGS": "", @@ -3927,12 +3622,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -3954,7 +3644,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -3990,12 +3680,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4018,7 +3703,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4054,12 +3739,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_17-wasm:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4082,7 +3762,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "BUILD_FLAVOUR": "release+fully_static", - "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", + "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi --enable-strict-ghc-toolchain-check", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", @@ -4118,12 +3798,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4145,7 +3820,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } @@ -4179,12 +3854,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4207,7 +3877,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "CONFIGURE_ARGS": "--disable-tables-next-to-code --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } @@ -4241,12 +3911,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4268,7 +3933,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-numa-slow-validate", "BUILD_FLAVOUR": "slow-validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "ENABLE_NUMA": "1", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" @@ -4303,12 +3968,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4330,7 +3990,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-unregisterised", + "CONFIGURE_ARGS": "--enable-unregisterised --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } @@ -4364,12 +4024,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", @@ -4391,7 +4046,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "CONFIGURE_ARGS": "--enable-ipe-data-compression --enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } @@ -4425,12 +4080,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4452,7 +4102,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } @@ -4486,12 +4136,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4513,7 +4158,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } @@ -4547,12 +4192,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "allow_failure": true, @@ -4575,7 +4215,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+thread_sanitizer", "BUILD_FLAVOUR": "validate+thread_sanitizer", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "HADRIAN_ARGS": "--docs=none", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", @@ -4611,12 +4251,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4638,7 +4273,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", "RUNTEST_ARGS": "", @@ -4674,12 +4309,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4701,7 +4331,7 @@ "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--with-intree-gmp", + "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", @@ -4738,12 +4368,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/)) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*non-moving GC.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4765,7 +4390,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc", "BUILD_FLAVOUR": "validate+boot_nonmoving_gc", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity", "TEST_ENV": "x86_64-linux-deb11-validate+boot_nonmoving_gc" } @@ -4799,12 +4424,7 @@ }, "dependencies": [], "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-fedora33:$DOCKER_REV", - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4826,7 +4446,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release", "BUILD_FLAVOUR": "release", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LLC": "/bin/false", "OPT": "/bin/false", "RUNTEST_ARGS": "", @@ -4858,12 +4478,7 @@ }, "dependencies": [], "image": null, - "needs": [ - { - "artifacts": false, - "job": "hadrian-ghc-in-ghci" - } - ], + "needs": [], "rules": [ { "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", @@ -4885,7 +4500,7 @@ "BIN_DIST_NAME": "ghc-x86_64-windows-validate", "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.8.1.0", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", ===================================== configure.ac ===================================== @@ -42,6 +42,15 @@ dnl works as expected, since we're slightly modifying how Autoconf dnl interprets build/host/target and how this interacts with $CC tests test -n "$target_alias" && ac_tool_prefix=$target_alias- +dnl ---------------------------------------------------------- +dnl ** Store USER specified environment variables to pass them on to +dnl ** ghc-toolchain (in m4/ghc-toolchain.m4) +USER_CFLAGS="$CFLAGS" +USER_LDFLAGS="$LDFLAGS" +USER_LIBS="$LIBS" +USER_CXXFLAGS="$CXXFLAGS" + + dnl ---------------------------------------------------------- dnl ** Find unixy sort and find commands, dnl ** which are needed by FP_SETUP_PROJECT_VERSION @@ -171,6 +180,14 @@ AC_ARG_ENABLE(ghc-toolchain, ) AC_SUBST([EnableGhcToolchain]) +AC_ARG_ENABLE(strict-ghc-toolchain-check, +[AS_HELP_STRING([--enable-strict-ghc-toolchain-check], + [Whether to raise an error if the output of ghc-toolchain differs from configure])], + [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableStrictGhcToolchainCheck])], + [EnableStrictGhcToolchainCheck=NO] +) +AC_SUBST([EnableStrictGhcToolchainCheck]) + dnl CC_STAGE0, LD_STAGE0, AR_STAGE0 are like the "previous" variable dnl CC, LD, AR (inherited by CC_STAGE[123], etc.) dnl but instead used by stage0 for bootstrapping stage1 ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -45,6 +45,7 @@ AC_ARG_WITH(cpp-flags, # Use whatever flags were manually set, ignoring previously configured # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) CPP_ARGS="$CPP_ARGS $withval" + USER_CPP_ARGS="$withval" fi ], [ ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -39,6 +39,7 @@ AC_ARG_WITH(hs-cpp-flags, AC_MSG_WARN([Request to use $withval will be ignored]) else HS_CPP_ARGS=$withval + USER_HS_CPP_ARGS=$withval fi ], [ ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -8,9 +8,9 @@ AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) echo 'int f(int a) {return 2*a;}' > conftest.a.c echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c - $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 - $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 - if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + $CC -c -o conftest.a.o conftest.a.c 2>&1 + $CC -c -o conftest.b.o conftest.b.c 2>&1 + if "$CC" ${$1:+$$1} -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o 2>&1 then $1="$$1 -Wl,--no-as-needed" AC_MSG_RESULT([yes]) ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -5,14 +5,21 @@ AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], [ AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_ld_no_compact_unwind=yes -else - fp_cv_ld_no_compact_unwind=no -fi -rm -rf conftest*]) +[ +case $build in + *-darwin) + echo 'int foo() { return 0; }' > conftest.c + ${CC-cc} -c conftest.c + if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then + fp_cv_ld_no_compact_unwind=yes + else + fp_cv_ld_no_compact_unwind=no + fi + rm -rf conftest* ;; + *) + fp_cv_ld_no_compact_unwind=no ;; +esac +]) FP_CAPITALIZE_YES_NO(["$fp_cv_ld_no_compact_unwind"], [LdHasNoCompactUnwind]) AC_SUBST([LdHasNoCompactUnwind]) ])# FP_PROG_LD_NO_COMPACT_UNWIND ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -127,4 +127,13 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ MergeObjsCmd="" MergeObjsArgs="" AC_PATH_PROG([Genlib],[genlib]) + + + dnl We override the USER_* flags here since the user delegated + dnl configuration to the bundled windows toolchain, and these are the + dnl options required by the bundled windows toolchain. + USER_CFLAGS="$CFLAGS" + USER_CXXFLAGS="$CXXFLAGS" + USER_HS_CPP_ARGS="$HaskellCPPArgs" + USER_LDFLAGS="$CONF_GCC_LINKER_OPTS_STAGE2" ]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -93,6 +93,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], # the usual system locations, including the PATH, we are just explicit when # calling it through configure. rm -f acargs + echo "--triple=$target" >> acargs echo "--output=$1/default.target.ghc-toolchain" >> acargs echo "--llvm-triple=$LlvmTarget" >> acargs @@ -107,9 +108,20 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], echo "--merge-objs=$MergeObjsCmd" >> acargs echo "--readelf=$READELF" >> acargs echo "--windres=$WindresCmd" >> acargs + ENABLE_GHC_TOOLCHAIN_NOT_ARG([locally-executable], [$CrossCompiling]) ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) + ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) + ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + + dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. + ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$USER_CFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LDFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$USER_LIBS]) + ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$USER_CXXFLAGS]) + ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$USER_CPP_ARGS]) + ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$USER_HS_CPP_ARGS]) INVOKE_GHC_TOOLCHAIN() @@ -151,6 +163,11 @@ AC_DEFUN([VALIDATE_GHC_TOOLCHAIN],[ In light of it, if you've spotted this difference, please report a GHC bug at https://www.haskell.org/ghc/reportabug ]) + + case "$EnableStrictGhcToolchainCheck" in + YES) + AC_MSG_ERROR([Failing due to --enable-strict-ghc-toolchain-check]) + esac fi ]) ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -146,7 +146,7 @@ options = , progOpts "cxx" "C++ compiler" _optCxx , progOpts "cc-link" "C compiler for linking" _optCcLink , progOpts "ar" "ar archiver" _optAr - , progOpts "ranlib" "ranlib utility" _optAr + , progOpts "ranlib" "ranlib utility" _optRanlib , progOpts "nm" "nm archiver" _optNm , progOpts "readelf" "readelf utility" _optReadelf , progOpts "merge-objs" "linker for merging objects" _optMergeObjs ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -53,6 +53,7 @@ parseArch cc arch = "riscv64" -> pure ArchRISCV64 "hppa" -> pure ArchUnknown "wasm32" -> pure ArchWasm32 + "javascript" -> pure ArchJavaScript _ -> throwE $ "Unknown architecture " ++ arch parseOs :: String -> M OS @@ -76,6 +77,7 @@ parseOs os = "aix" -> pure OSAIX "gnu" -> pure OSHurd "wasi" -> pure OSWasi + "ghcjs" -> pure OSGhcjs _ -> throwE $ "Unknown operating system " ++ os splitOn :: Char -> String -> [String] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -37,21 +37,7 @@ findCc :: String -- ^ The llvm target to use if Cc supports --target findCc llvmTarget progOpt = checking "for C compiler" $ do -- TODO: We keep the candidate order we had in configure, but perhaps -- there's a more optimal one - ccProgram' <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] - - -- FIXME: This is a dreadful hack! - -- In reality, configure should pass these options to ghc-toolchain when - -- using the bundled windows toolchain, and ghc-toolchain should drop this around. - -- See #23678 - let ccProgram = if "mingw32" `isInfixOf` llvmTarget && takeBaseName (prgPath ccProgram') == "clang" - -- we inline the is-windows check here because we need Cc to call parseTriple - then - -- Signal that we are linking against UCRT with the _UCRT macro. This is - -- necessary on windows clang to ensure correct behavior when - -- MinGW-w64 headers are in the header include path (#22159). - ccProgram' & _prgFlags %++ "--rtlib=compiler-rt -D_UCRT" - else - ccProgram' + ccProgram <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] cc' <- ignoreUnusedArgs $ Cc {ccProgram} cc <- ccSupportsTarget llvmTarget cc' ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -4,10 +4,10 @@ module GHC.Toolchain.Tools.Cpp (HsCpp(..), findHsCpp, Cpp(..), findCpp) where import Control.Monad import System.FilePath +import Data.List(isInfixOf) import GHC.Toolchain.Prelude import GHC.Toolchain.Program -import GHC.Toolchain.Utils (withTempDir) import GHC.Toolchain.Tools.Cc @@ -38,11 +38,30 @@ findHsCpp progOpt cc = checking "for Haskell C preprocessor" $ do -- | Given a C preprocessor, figure out how it should be invoked to preprocess -- Haskell source. findHsCppArgs :: Program -> M [String] -findHsCppArgs cpp = withTempDir $ \dir -> do +findHsCppArgs cpp = do + + (_, stdout0, stderr0) <- readProgram cpp ["-x", "c", "/dev/null", "-dM", "-E"] + + if "__clang__" `isInfixOf` stdout0 || "__clang__" `isInfixOf` stderr0 + then return ["-undef", "-traditional", "-Wno-invalid-pp-token", "-Wno-unicode", "-Wno-trigraphs"] + else do + (_, stdout1, stderr1) <- readProgram cpp ["-v"] + if "gcc" `isInfixOf` stdout1 || "gcc" `isInfixOf` stderr1 + then return ["-undef", "-traditional"] + else do + logDebug "Can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly" + return [] + + +{- TODO: We want to just check which flags are accepted rather than branching on which compiler + we are using but this does not match what ./configure does (#23720) + + When we retire configure then this more precise logic can be reinstated. + withTmpDir $ \dir -> do let tmp_h = dir "tmp.h" -- Werror to ensure that unrecognized warnings result in an error - checkFlag flag = + let checkFlag flag = checking ("for "++flag++" support") $ callProgram cpp ["-Werror", flag, tmp_h] tryFlag flag = @@ -56,6 +75,7 @@ findHsCppArgs cpp = withTempDir $ \dir -> do , tryFlag "-Wno-unicode" , tryFlag "-Wno-trigraphs" ] + -} ----- C preprocessor ----- ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -57,7 +57,7 @@ findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compile findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink ccLinkProgram <- linkSupportsTarget cc target ccLinkProgram ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram - ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind cc ccLinkProgram + ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind archOs cc ccLinkProgram ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram ccLinkIsGnu <- checkLinkIsGnu ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram @@ -124,16 +124,18 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- * Check if compiling for darwin -- * Then do the check -- * Otherwise say its just not supported -checkSupportsCompactUnwind :: Cc -> Program -> M Bool -checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ - withTempDir $ \dir -> do - let test_o = dir "test.o" - test2_o = dir "test2.o" +checkSupportsCompactUnwind :: ArchOS -> Cc -> Program -> M Bool +checkSupportsCompactUnwind archOs cc ccLink + | OSDarwin <- archOS_OS archOs = checking "whether the cc linker understands -no_compact_unwind" $ + withTempDir $ \dir -> do + let test_o = dir "test.o" + test2_o = dir "test2.o" - compileC cc test_o "int foo() { return 0; }" + compileC cc test_o "int foo() { return 0; }" - exitCode <- runProgram ccLink ["-r", "-Wl,-no_compact_unwind", "-o", test2_o, test_o] - return $ isSuccess exitCode + exitCode <- runProgram ccLink ["-r", "-Wl,-no_compact_unwind", "-o", test2_o, test_o] + return $ isSuccess exitCode + | otherwise = return False checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -163,7 +165,7 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do let out = dir "test" err = "linker didn't produce any output" - callProgram ccLink ["-o", out, test_o, main_o] + callProgram ccLink ["-Werror", "-o", out, test_o, main_o] expectFileExists out err -- Linking in windows might produce an executable with an ".exe" extension <|> expectFileExists (out <.> "exe") err View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac8584b429184fb6f10fa3d6ee7068239b3a8a0c...e9921441079c18667b50f0d6a3e6f7ff911acec5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac8584b429184fb6f10fa3d6ee7068239b3a8a0c...e9921441079c18667b50f0d6a3e6f7ff911acec5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 12:34:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 27 Jul 2023 08:34:20 -0400 Subject: [Git][ghc/ghc][wip/T22404] 8 commits: This MR is an implementation of the proposal #516. Message-ID: <64c2644c8bc96_2fb451b9a6473446e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 4e01f918 by Simon Peyton Jones at 2023-07-27T13:34:09+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c Metric Increase: T18698b T9961 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0233775d7b07fe8bcd7ffd8b92d492b96e9b0e90...4e01f9180ce21f034462859eff715a5abb7b4be8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0233775d7b07fe8bcd7ffd8b92d492b96e9b0e90...4e01f9180ce21f034462859eff715a5abb7b4be8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 12:48:56 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 27 Jul 2023 08:48:56 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Slightly more aggressive postInlineUnconditionally Message-ID: <64c267b8738bf_2fb451b9aa0742497@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: b8ed2990 by Simon Peyton Jones at 2023-07-27T13:47:04+01:00 Slightly more aggressive postInlineUnconditionally - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Stats.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -4106,9 +4106,9 @@ what `f` is, instead of lambda-abstracting over it. To achieve this: -1. Do not postInlineUnconditionally a join point, until the Final - phase. (The Final phase is still quite early, so we might consider - delaying still more.) +1. Do not postInlineUnconditionally a join point, ever. Doing + postInlineUnconditionally is primarily to push allocation into cold + branches; but a join point doesn't allocate, so that's a non-motivation. 2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for all alternatives, except for exprIsTrival RHSs. Previously we used ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1538,7 +1538,7 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs = False -- Note [Top level and postInlineUnconditionally] | exprIsTrivial rhs = True | BC_Join {} <- bind_cxt = False -- See point (1) of Note [Duplicating join points] --- , not (phase == FinalPhase) = False -- in Simplify.hs + -- in GHC.Core.Opt.Simplify.Iteration | otherwise = case occ_info of OneOcc { occ_in_lam = in_lam, occ_int_cxt = int_cxt, occ_n_br = n_br } @@ -1547,10 +1547,10 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs | let not_inside_lam = in_lam == NotInsideLam -> n_br < 100 -- See #23627 - && ( (n_br == 1 && not_inside_lam) - -- See Note [Post-inline for single-use things] + && ( (n_br == 1) -- One syntactic occurrence + -- See Note [Post-inline for single-use things] || (is_lazy && smallEnoughToInline uf_opts unfolding)) - -- Lazy, and small enough to dup + -- Multiple syntactic occurences; but lazy, and small enough to dup -- ToDo: consider discount on smallEnoughToInline if int_cxt is true && (not_inside_lam || @@ -2353,6 +2353,14 @@ the outer case scrutinises the same variable as the outer case. This transformation is called Case Merging. It avoids that the same variable is scrutinised multiple times. +The auxiliary bindings b'=b are annoying, because they force another +simplifier pass, but there seems no easy way to avoid them. See +Note [Which transformations are innocuous] in GHC.Core.Opt.Stats. + +See also +* Note [Example of case-merging and caseRules] +* Note [Cascading case merge] + Note [Eliminate Identity Case] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ case e of ===> e @@ -2444,7 +2452,6 @@ Wrinkle 4: see Note [caseRules for dataToTag] in GHC.Core.Opt.ConstantFold - Note [Example of case-merging and caseRules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The case-transformation rules are quite powerful. Here's a @@ -2530,6 +2537,9 @@ mkCase, mkCase1, mkCase2, mkCase3 -------------------------------------------------- -- 1. Merge Nested Cases +-- See Note [Merge Nested Cases] +-- Note [Example of case-merging and caseRules] +-- Note [Cascading case merge] -------------------------------------------------- mkCase mode scrut outer_bndr alts_ty (Alt DEFAULT _ deflt_rhs : outer_alts) @@ -2572,6 +2582,7 @@ mkCase mode scrut bndr alts_ty alts = mkCase1 mode scrut bndr alts_ty alts -------------------------------------------------- -- 2. Eliminate Identity Case +-- See Note [Eliminate Identity Case] -------------------------------------------------- mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case @@ -2617,6 +2628,7 @@ mkCase1 mode scrut bndr alts_ty alts = mkCase2 mode scrut bndr alts_ty alts -------------------------------------------------- -- 2. Scrutinee Constant Folding +-- See Note [Scrutinee Constant Folding] -------------------------------------------------- mkCase2 mode scrut bndr alts_ty alts ===================================== compiler/GHC/Core/Opt/Stats.hs ===================================== @@ -179,6 +179,13 @@ PostInlineUnconditionally transformations for the same reason as PreInlineUnconditionally, so it's probably not innocuous anyway. + One annoying variant is this. CaseMerge introduces auxiliary bindings + let b = b' in ... + This takes another full run of the simplifier to elimiante. But if + the PostInlineUnconditionally, replacing b with b', is the only thing + that happens in a Simplifier run, that probably really is innocuous. + Perhaps an opportunity here. + KnownBranch, BetaReduction: May drop chunks of code, and thereby enable PreInlineUnconditionally for some let-binding which now occurs once View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8ed299073bc7149f868d1c6c0c95e45ac26d038 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8ed299073bc7149f868d1c6c0c95e45ac26d038 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 14:21:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 27 Jul 2023 10:21:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: ci: Test bootstrapping configurations with full-ci and on marge batches Message-ID: <64c27d6aed031_2fb451b9ac87712fb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - f3a7e535 by David Binder at 2023-07-27T11:54:33+00:00 Improve documentation for Data.Fixed - - - - - 6ff12598 by Ben Gamari at 2023-07-27T10:21:27-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 10 changed files: - .gitlab-ci.yml - hadrian/bootstrap/bootstrap.py - hadrian/bootstrap/generate_bootstrap_plans - − hadrian/bootstrap/plan-9_2_1.json - − hadrian/bootstrap/plan-9_2_2.json - − hadrian/bootstrap/plan-9_2_3.json - − hadrian/bootstrap/plan-9_2_4.json - − hadrian/bootstrap/plan-9_2_5.json - − hadrian/bootstrap/plan-9_2_6.json - − hadrian/bootstrap/plan-9_2_7.json The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01cdbf214afb1cb356f6f5727583ddce032456bb...6ff1259815849f0f3abb00a6a9168b4baadc72b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01cdbf214afb1cb356f6f5727583ddce032456bb...6ff1259815849f0f3abb00a6a9168b4baadc72b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 14:36:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 27 Jul 2023 10:36:22 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 2 commits: Don't create a trivial join point Message-ID: <64c280e61a7a_2fb451b9ac87767f0@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 66f436c7 by Simon Peyton Jones at 2023-07-27T14:50:33+01:00 Don't create a trivial join point - - - - - 0c32ab92 by Simon Peyton Jones at 2023-07-27T15:33:02+01:00 Two changes... * Simplify the too_many_occs thing in simplLetUnfolding It was preventing a jolly good unfolding of a join point in T15304 join j x = case x of R y -> y in ...lots of calls to j (R v).... * Backtrack on making postInlineUnconditionally more agressive. It made T19695 worse (in compile time anyway). - && ( (n_br == 1) -- One syntactic occurrence - -- See Note [Post-inline for single-use things] + && ( (n_br == 1 && not_inside_lam) -- One syntactic occurrence + -- See Note [Post-inline for single-use things] - - - - - 2 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3754,7 +3754,8 @@ mkDupableContWithDmds env _ , sc_fun_ty = fun_ty }) -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable | isNothing (isDataConId_maybe (ai_fun fun)) - , thumbsUpPlanA cont -- See point (3) of Note [Duplicating join points] + -- isDataConId: see point (3) of Note [Duplicating join points] + , thumbsUpPlanA cont = -- Use Plan A of Note [Duplicating StrictArg] -- pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $ do { let (_ : dmds) = ai_dmds fun @@ -3955,12 +3956,20 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool -- See Note [Duplicating alternatives] +-- and Note [Duplicating join point] esp point (2) ok_to_dup_alt case_bndr alt_bndrs alt_rhs + | exprIsTrivial alt_rhs + = True -- Includes things like (case x of {}) + | (Var v, args) <- collectArgs alt_rhs , all exprIsTrivial args = if isJust (isDataConId_maybe v) - then exprsFreeIds args `subVarSet` bndr_set - else True + then -- See Note [Duplicating join points] for the + -- reason for this apparently strange test + exprsFreeIds args `subVarSet` bndr_set + else True -- Duplicating a simple call (f a b c) is fine, + -- (especially if f is itself a join point). + | otherwise = False where @@ -4075,7 +4084,7 @@ See #4957 a fuller example. Note [Duplicating join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -IN #19996 we discovered that we want to be really careful about +In #19996 we discovered that we want to be really careful about inlining join points. Consider case (join $j x = K f x ) (in case v of ) @@ -4110,10 +4119,15 @@ To achieve this: postInlineUnconditionally is primarily to push allocation into cold branches; but a join point doesn't allocate, so that's a non-motivation. -2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for - all alternatives, except for exprIsTrival RHSs. Previously we used - exprIsDupable. This generates a lot more join points, but makes - them much more case-of-case friendly. +2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for all + alternatives, except for exprIsTrival RHSs (see `ok_to_dup_alt`). Previously + we used exprIsDupable. This generates a lot more join points, but makes them + much more case-of-case friendly. + + We are happy to duplicate + j a b = K b a + where all the arguments of the constructor are parameters of the join point + because then the "massive difference" described above can't happen. It is definitely worth checking for exprIsTrivial, otherwise we get an extra Simplifier iteration, because it is inlined in the next @@ -4121,7 +4135,10 @@ To achieve this: 3. By the same token we want to use Plan B in Note [Duplicating StrictArg] when the RHS of the new join point - is a data constructor application. That same Note explains why we + is a data constructor application. See the call to isDataConId in + the StrictArg case of mkDupableContWithDmds. + + That same Note [Duplicating StrictArg] explains why we sometimes want Plan A when the RHS of the new join point would be a non-data-constructor application @@ -4409,8 +4426,7 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf = -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify return noUnfolding - | isJoinId id - , too_many_occs (idOccInfo id) + | freshly_born_join_point id = -- This is a tricky one! -- See wrinkle (JU1) in Note [Do not add unfoldings to join points at birth] return noUnfolding @@ -4421,10 +4437,8 @@ simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf in mkLetUnfolding opts (bindContextLevel bind_cxt) VanillaSrc id new_rhs where - too_many_occs (ManyOccs {}) = True - too_many_occs (OneOcc { occ_n_br = n }) = n > 10 -- See #23627 - too_many_occs IAmDead = False - too_many_occs (IAmALoopBreaker {}) = False + freshly_born_join_point id = isJoinId id && isManyOccs (idOccInfo id) + -- OLD: too_many_occs (OneOcc { occ_n_br = n }) = n > 10 -- See #23627 ------------------- mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1547,8 +1547,8 @@ postInlineUnconditionally env bind_cxt old_bndr bndr rhs | let not_inside_lam = in_lam == NotInsideLam -> n_br < 100 -- See #23627 - && ( (n_br == 1) -- One syntactic occurrence - -- See Note [Post-inline for single-use things] + && ( (n_br == 1 && not_inside_lam) -- One syntactic occurrence + -- See Note [Post-inline for single-use things] || (is_lazy && smallEnoughToInline uf_opts unfolding)) -- Multiple syntactic occurences; but lazy, and small enough to dup -- ToDo: consider discount on smallEnoughToInline if int_cxt is true View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ed299073bc7149f868d1c6c0c95e45ac26d038...0c32ab928f154cadeb80dfdbe9d3b3b4ae13bed7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b8ed299073bc7149f868d1c6c0c95e45ac26d038...0c32ab928f154cadeb80dfdbe9d3b3b4ae13bed7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 14:40:03 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 10:40:03 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] add some javascript special cases Message-ID: <64c281c3bf4ed_2fb451b9a787774ee@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: a2a694ca by Matthew Pickering at 2023-07-27T15:39:41+01:00 add some javascript special cases - - - - - 1 changed file: - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -55,11 +55,11 @@ findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compile Nothing -> do -- If not then try to find decent linker flags findLinkFlags ldOverride cc rawCcLink <|> pure rawCcLink - ccLinkProgram <- linkSupportsTarget cc target ccLinkProgram - ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram + ccLinkProgram <- linkSupportsTarget archOs cc target ccLinkProgram + ccLinkSupportsNoPie <- checkSupportsNoPie ccLinkProgram ccLinkSupportsCompactUnwind <- checkSupportsCompactUnwind archOs cc ccLinkProgram - ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram - ccLinkIsGnu <- checkLinkIsGnu ccLinkProgram + ccLinkSupportsFilelist <- checkSupportsFilelist cc ccLinkProgram + ccLinkIsGnu <- checkLinkIsGnu archOs ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram let ccLink = CcLink {ccLinkProgram, ccLinkSupportsNoPie, @@ -87,8 +87,13 @@ findLinkFlags enableOverride cc ccLink | otherwise = return ccLink -linkSupportsTarget :: Cc -> String -> Program -> M Program -linkSupportsTarget cc target link +linkSupportsTarget :: ArchOS -> Cc -> String -> Program -> M Program +-- Javascript toolchain provided by emsdk just ignores --target flag so +-- we have this special case to match with ./configure (#23744) +linkSupportsTarget archOS _ _ c + | ArchJavaScript <- archOS_arch archOS + = return c +linkSupportsTarget _ cc target link = checking "whether cc linker supports --target" $ supportsTarget (Lens id const) (checkLinkWorks cc) target link @@ -170,8 +175,11 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do -- Linking in windows might produce an executable with an ".exe" extension <|> expectFileExists (out <.> "exe") err -checkLinkIsGnu :: Program -> M Bool -checkLinkIsGnu ccLink = do +checkLinkIsGnu :: ArchOS -> Program -> M Bool +checkLinkIsGnu archOs _ + -- emsdk is never going to provide gnu ld (See #23744) + | ArchJavaScript <- archOS_arch archOs = return False +checkLinkIsGnu _ ccLink = do out <- readProgramStdout ccLink ["-Wl,--version"] return ("GNU" `isInfixOf` out) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a694ca7dda92d5ccf02dccf5984b64b51533ca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2a694ca7dda92d5ccf02dccf5984b64b51533ca You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 14:49:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 10:49:31 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] check for emcc in gnu_LD check Message-ID: <64c283fb2421c_2fb451b9a3c783335@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: 561504af by Matthew Pickering at 2023-07-27T15:49:05+01:00 check for emcc in gnu_LD check - - - - - 1 changed file: - m4/fp_prog_ld_is_gnu.m4 Changes: ===================================== m4/fp_prog_ld_is_gnu.m4 ===================================== @@ -4,10 +4,19 @@ # GNU ld or not. AC_DEFUN([FP_PROG_LD_IS_GNU],[ AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[[if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then - fp_cv_gnu_ld=YES -else +[[ + +if $LD --version 2> /dev/null | grep "emcc" > /dev/null 2>&1; +then fp_cv_gnu_ld=NO -fi]]) +else + if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then + fp_cv_gnu_ld=YES + else + fp_cv_gnu_ld=NO + fi +fi + +]]) AC_SUBST([LdIsGNULd],["$fp_cv_gnu_ld"]) ])# FP_PROG_LD_IS_GNU View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/561504af9c0695b3ec908ff76ea78bbb84c8cb2d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/561504af9c0695b3ec908ff76ea78bbb84c8cb2d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 14:59:59 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 10:59:59 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] Add ldOverrideWhitelist to only default to ldOverride on windows/linux Message-ID: <64c2866f4655d_2fb451b9aa0787550@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: fea60d1b by Matthew Pickering at 2023-07-27T15:59:35+01:00 Add ldOverrideWhitelist to only default to ldOverride on windows/linux - - - - - 1 changed file: - utils/ghc-toolchain/exe/Main.hs Changes: ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -309,6 +309,15 @@ archHasNativeAdjustors = \case _ -> False +-- | The platforms which we attempt to override ld +ldOverrideWhitelist :: ArchOS -> Bool +ldOverrideWhitelist a = + case archOS_OS a of + OSLinux -> True + OSMinGW32 -> True + _ -> False + + mkTarget :: Opts -> M Target mkTarget opts = do -- Use Llvm target if specified, otherwise use triple as llvm target @@ -320,7 +329,7 @@ mkTarget opts = do (archOs, tgtVendor) <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) - ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (fromMaybe True (optLdOverride opts)) archOs cc readelf + ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (fromMaybe (ldOverrideWhitelist archOs) (optLdOverride opts)) archOs cc readelf ar <- findAr tgtVendor (optAr opts) -- TODO: We could have View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fea60d1b02f9332aba8365ac5dfd21924804952c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fea60d1b02f9332aba8365ac5dfd21924804952c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 15:02:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 27 Jul 2023 11:02:22 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Wibbles Message-ID: <64c286fe60d40_2fb451b9a6478823b@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 2687f395 by Simon Peyton Jones at 2023-07-27T16:02:11+01:00 Wibbles - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3783,8 +3783,8 @@ mkDupableContWithDmds env _ where thumbsUpPlanA (StrictBind {}) = True thumbsUpPlanA (Stop {}) = True - thumbsUpPlanA (Select {}) = False -- Not quite sure of this one, but it - -- benefits nofib digits-of-e1 quite a bit + thumbsUpPlanA (Select {}) = False -- Using Plan B benefits carryPropagate + -- in nofib digits-of-e2 thumbsUpPlanA (StrictArg {}) = False thumbsUpPlanA (CastIt { sc_cont = k }) = thumbsUpPlanA k thumbsUpPlanA (TickIt _ k) = thumbsUpPlanA k @@ -3956,7 +3956,7 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool -- See Note [Duplicating alternatives] --- and Note [Duplicating join point] esp point (2) +-- and Note [Duplicating join points] esp point (2) ok_to_dup_alt case_bndr alt_bndrs alt_rhs | exprIsTrivial alt_rhs = True -- Includes things like (case x of {}) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2687f3950d8f3f0d7f9e3d8f17e4ab9adf6ad09e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2687f3950d8f3f0d7f9e3d8f17e4ab9adf6ad09e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 15:11:50 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 27 Jul 2023 11:11:50 -0400 Subject: [Git][ghc/ghc][wip/T22404] Make the occurrence analyser smarter about join points Message-ID: <64c2893618e2c_37b561ba054812f6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 1fd04560 by Simon Peyton Jones at 2023-07-27T16:08:55+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. But the geom mean stay solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 13 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Var.hs - + testsuite/tests/simplCore/should_compile/T22404.hs - + testsuite/tests/simplCore/should_compile/T22404.stderr - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/stranal/should_compile/T21128.stderr - testsuite/tests/stranal/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1948,6 +1948,7 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- manifest arity for join points = -- pprTrace "finaliseArgBoxities" ( -- vcat [text "function:" <+> ppr fn + -- , text "max" <+> ppr max_wkr_args -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ (arg_dmds', set_lam_dmds arg_dmds' rhs) ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -1,7 +1,15 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} +{-# OPTIONS_GHC -cpp -Wno-incomplete-record-updates #-} + +{-# OPTIONS_GHC -fmax-worker-args=12 #-} +-- The -fmax-worker-args=12 is there because the main functions +-- are strict in the OccEnv, and it turned out that with the default settting +-- some functions would unbox the OccEnv ad some would not, depending on how +-- many /other/ arguments the function has. Inconsistent unboxing is very +-- bad for performance, so I increased the limit to allow it to unbox +-- consistently. {- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 @@ -58,9 +66,7 @@ import GHC.Utils.Misc import GHC.Builtin.Names( runRWKey ) import GHC.Unit.Module( Module ) -import Data.List (mapAccumL, mapAccumR) -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE +import Data.List (mapAccumL) {- ************************************************************************ @@ -76,7 +82,7 @@ Here's the externally-callable interface: occurAnalyseExpr :: CoreExpr -> CoreExpr occurAnalyseExpr expr = expr' where - (WithUsageDetails _ expr') = occAnal initOccEnv expr + WUD _ expr' = occAnal initOccEnv expr occurAnalysePgm :: Module -- Used only in debug output -> (Id -> Bool) -- Active unfoldings @@ -94,8 +100,8 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds init_env = initOccEnv { occ_rule_act = active_rule , occ_unf_act = active_unf } - (WithUsageDetails final_usage occ_anald_binds) = go init_env binds - (WithUsageDetails _ occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel + WUD final_usage occ_anald_binds = go binds init_env + WUD _ occ_anald_glommed_binds = occAnalRecBind init_env TopLevel imp_rule_edges (flattenBinds binds) initial_uds @@ -127,14 +133,10 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds -- Not BuiltinRules; see Note [Plugin rules] , let rhs_fvs = exprFreeIds rhs `delVarSetList` bndrs ] - go :: OccEnv -> [CoreBind] -> WithUsageDetails [CoreBind] - go !_ [] - = WithUsageDetails initial_uds [] - go env (bind:binds) - = WithUsageDetails final_usage (bind' ++ binds') - where - (WithUsageDetails bs_usage binds') = go env binds - (WithUsageDetails final_usage bind') = occAnalBind env TopLevel imp_rule_edges bind bs_usage + go :: [CoreBind] -> OccEnv -> WithUsageDetails [CoreBind] + go [] _ = WUD initial_uds [] + go (bind:binds) env = occAnalBind env TopLevel + imp_rule_edges bind (go binds) (++) {- ********************************************************************* * * @@ -599,7 +601,144 @@ This showed up when compiling Control.Concurrent.Chan.getChanContents. Hence the transitive rule_fv_env stuff described in Note [Rules and loop breakers]. ------------------------------------------------------------- +Note [Occurrence analysis for join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider these two somewhat artificial programs (#22404) + + Program (P1) Program (P2) + ------------------------------ ------------------------------------- + let v = in let v = in + join j = case v of (a,b) -> a + in case x of in case x of + A -> case v of (a,b) -> a A -> j + B -> case v of (a,b) -> a B -> j + C -> case v of (a,b) -> b C -> case v of (a,b) -> b + D -> [] D -> [] + +In (P1), `v` gets allocated, as a thunk, every time this code is executed. But +notice that `v` occurs at most once in any case branch; the occurrence analyser +spots this and returns a OneOcc{ occ_n_br = 3 } for `v`. Then the code in +GHC.Core.Opt.Simplify.Utils.postInlineUnconditionally inlines `v` at its three +use sites, and discards the let-binding. That way, we avoid allocating `v` in +the A,B,C branches (though we still compute it of course), and branch D +doesn't involve at all. This sometimes makes a Really Big +Difference. + +In (P2) we have shared the common RHS of A, B, in a join point `j`. We would +like to inline `v` in just the same way as in (P1). But the usual strategy +for let bindings is conservative and uses `andUDs` to combine usage from j's +RHS to its body; as if `j` was called on every code path (once, albeit). In +the case of (P2), we'll get ManyOccs for `v`. Important optimisation lost! + +Solving this problem makes the Simplifier less fragile. For example, +the Simplifier might inline `j`, and convert (P2) into (P1)... or it might +not, depending in a perhaps-fragile way on the size of the join point. +I was motivated to implement this feature of the occurrence analyser +when trying to make optimisation join points simpler and more robust +(see e.g. #23627). + +The occurrence analyser therefore has clever code that behaves just as +if you inlined `j` at all its call sites. Here is a tricky variant +to keep in mind: + + Program (P3) + ------------------------------- + join j = case v of (a,b) -> a + in case f v of + A -> j + B -> j + C -> [] + +If you mentally inline `j` you'll see that `v` is used twice on the path +through A, so it should have ManyOcc. Bear this case in mind! + +* We treat /non-recursive/ join points specially. Recursive join points are + treated like any other letrec, as before. Moreover, we only give this special + treatment to /pre-existing/ non-recursive join points, not the ones that we + discover for the first time in this sweep of the occurrence analyser. + +* In occ_env, the new (occ_join_points :: IdEnv OccInfoEnv) maps + each in-scope non-recursive join point, such as `j` above, to + a "zeroed form" of its RHS's usage details. The "zeroed form" + * deletes ManyOccs + * maps a OneOcc to OneOcc{ occ_n_br = 0 } + In our example, occ_join_points will be extended with + [j :-> [v :-> OneOcc{occ_n_br=0}]] + See addJoinPoint. + +* At an occurence of a join point, we do everything as normal, but add in the + UsageDetails from the occ_join_points. See mkOneOcc. + +* Crucially, at the NonRec binding of the join point, in `occAnalBind`, we use + `orUDs`, not `andUDs` to combine the usage from the RHS with the usage from + the body. + +Here are the consequences + +* Because of the perhaps-surprising OneOcc{occ_n_br=0} idea of the zeroed + form, the occ_n_br field of a OneOcc binder still counts the number of + /actual lexical occurrences/ of the variable. In Program P2, for example, + `v` will end up with OneOcc{occ_n_br=2}, not occ_n_br=3. + There are two lexical occurrences of `v`! + (NB: `orUDs` adds occ_n_br together, so occ_n_br=1 is impossible, too.) + +* In the tricky (P3) we'll get an `andUDs` of + * OneOcc{occ_n_br=0} from the occurrences of `j`) + * OneOcc{occ_n_br=1} from the (f v) + These are `andUDs` together in `addOccInfo`, and hence + `v` gets ManyOccs, just as it should. Clever! + +There are a couple of tricky wrinkles + +(W1) Consider this example which shadows `j`: + join j = rhs in + in case x of { K j -> ..j..; ... } + Clearly when we come to the pattern `K j` we must drop the `j` + entry in occ_join_points. + + This is done by `drop_shadowed_joins` in `addInScope`. + +(W2) Consider this example which shadows `v`: + join j = ...v... + in case x of { K v -> ..j..; ... } + + We can't make j's occurrences in the K alternative give rise to an + occurrence of `v` (via occ_join_points), because it'll just be deleted by + the `K v` pattern. Yikes. This is rare because shadowing is rare, but + it definitely can happen. Solution: when bringing `v` into scope at + the `K v` pattern, chuck out of occ_join_points any elements whose + UsageDetails mentions `v`. Instead, just `andUDs` all that usage in + right here. + + This requires work in two places. + * In `preprocess_env`, we detect if the newly-bound variables intersect + the free vars of occ_join_points. (These free vars are conveniently + simply the domain of the OccInfoEnv for that join point.) If so, + we zap the entire occ_join_points. + * In `postprcess_uds`, we add the chucked-out join points to the + returned UsageDetails, with `andUDs`. + +(W3) Consider this example, which shadows `j`, but this time in an argument + join j = rhs + in f (case x of { K j -> ...; ... }) + We can zap the entire occ_join_points when looking at the argument, + because `j` can't posibly occur -- it's a join point! And the smaller + occ_join_points is, the better. Smaller to look up in mkOneOcc, and + more important, less looking-up when checking (W2). + + This is done in setNonTailCtxt. It's important /not/ to do this for + join-point RHS's because of course `j` can occur there! + + NB: this is just about efficiency: it is always safe /not/ to zap the + occ_join_points. + +(W4) What if the join point binding has a stable unfolding, or RULES? + They are just alternative right-hand sides, and at each call site we + will use only one of them. So again, we can use `orUDs` to combine + usage info from all these alternatives RHSs. + +Wrinkles (W1) and (W2) are very similar to Note [Binder swap] (BS3). + Note [Finding join points] ~~~~~~~~~~~~~~~~~~~~~~~~~~ It's the occurrence analyser's job to find bindings that we can turn into join @@ -817,78 +956,134 @@ of both functions, serving as a specification: Non-recursive case: 'adjustNonRecRhs' -} -data WithUsageDetails a = WithUsageDetails !UsageDetails !a - -data WithTailUsageDetails a = WithTailUsageDetails !TailUsageDetails !a - ------------------------------------------------------------------ -- occAnalBind ------------------------------------------------------------------ -occAnalBind :: OccEnv -- The incoming OccEnv - -> TopLevelFlag - -> ImpRuleEdges - -> CoreBind - -> UsageDetails -- Usage details of scope - -> WithUsageDetails [CoreBind] -- Of the whole let(rec) - -occAnalBind !env lvl top_env (NonRec binder rhs) body_usage - = occAnalNonRecBind env lvl top_env binder rhs body_usage -occAnalBind env lvl top_env (Rec pairs) body_usage - = occAnalRecBind env lvl top_env pairs body_usage - ------------------ -occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr - -> UsageDetails -> WithUsageDetails [CoreBind] -occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage +occAnalBind + :: OccEnv + -> TopLevelFlag + -> ImpRuleEdges + -> CoreBind + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> ([CoreBind] -> r -> r) -- How to combine the scope with new binds + -> WithUsageDetails r -- Of the whole let(rec) + +occAnalBind env lvl ire (Rec pairs) thing_inside combine + = addInScopeList env (map fst pairs) $ \env -> + let WUD body_uds body' = thing_inside env + WUD bind_uds binds' = occAnalRecBind env lvl ire pairs body_uds + in WUD bind_uds (combine binds' body') + +occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine | isTyVar bndr -- A type let; we don't gather usage info - = WithUsageDetails body_usage [NonRec bndr rhs] + = let !(WUD body_uds res) = addInScopeOne env bndr thing_inside + in WUD body_uds (combine [NonRec bndr rhs] res) + + -- /Existing/ non-recursive join points + -- See Note [Occurrence analysis for join points] + | mb_join@(Just {}) <- isJoinId_maybe bndr + = -- Analyse the RHS and /then/ the body + let -- Analyse the rhs first, generating rhs_uds + !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs + rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of + -- Note [Occurrence analysis for join points] + + -- Now analyse the body, adding the join point + -- into the environment with addJoinPoint + !(WUD body_uds (occ, body)) = occAnalNonRecBody env bndr' $ \env -> + thing_inside (addJoinPoint env bndr' rhs_uds) + in + if isDeadOcc occ -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` + (combine [NonRec (tagNonRecBinder lvl occ bndr') rhs'] + body) + + -- The normal case, including newly-discovered join points + -- Analyse the body and /then/ the RHS + | WUD body_uds (occ,body) <- occAnalNonRecBody env bndr thing_inside + = if isDeadOcc occ -- Drop dead code; see Note [Dead code] + then WUD body_uds body + else let + -- Get the join info from the *new* decision; NB: bndr is not already a JoinId + -- See Note [Join points and unfoldings/rules] + -- => join arity O of Note [Join arity prediction based on joinRhsArity] + tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join = case tailCallInfo occ of + AlwaysTailCalled arity -> Just arity + _ -> Nothing + + !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs + in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs` + (combine [NonRec final_bndr rhs'] body) - | not (bndr `usedIn` body_usage) - = WithUsageDetails body_usage [] -- See Note [Dead code] +----------------- +occAnalNonRecBody :: OccEnv -> Id + -> (OccEnv -> WithUsageDetails r) -- Scope of the bind + -> (WithUsageDetails (OccInfo, r)) +occAnalNonRecBody env bndr thing_inside + = addInScopeOne env bndr $ \env -> + let !(WUD inner_uds res) = thing_inside env + !occ = lookupLetOccInfo inner_uds bndr + in WUD inner_uds (occ, res) - | otherwise -- It's mentioned in the body - = WithUsageDetails (body_usage' `andUDs` rhs_usage) [NonRec final_bndr final_rhs] +----------------- +occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity + -> Id -> CoreExpr + -> ([UsageDetails], Id, CoreExpr) +occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs + | null rules, null imp_rule_infos + = -- Fast path for common case of no rules. This is only worth + -- 0.1% perf on average, but it's also only a line or two of code + ( [adj_rhs_uds, adj_unf_uds], final_bndr_no_rules, final_rhs ) + | otherwise + = (adj_rhs_uds : adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs ) where - WithUsageDetails body_usage' tagged_bndr = tagNonRecBinder lvl body_usage bndr - - -- Get the join info from the *new* decision - -- See Note [Join points and unfoldings/rules] - -- => join arity O of Note [Join arity prediction based on joinRhsArity] - mb_join_arity = willBeJoinId_maybe tagged_bndr - is_join_point = isJust mb_join_arity + is_join_point = isJust mb_join --------- Right hand side --------- - env1 | is_join_point = env -- See Note [Join point RHSs] - | certainly_inline = env -- See Note [Cascading inlines] - | otherwise = rhsCtxt env + -- For join points, set occ_encl to OccVanilla, via setTailCtxt. If we have + -- join j = Just (f x) in ... + -- we do not want to float the (f x) to + -- let y = f x in join j = Just y in ... + -- That's that OccRhs would do; but there's no point because + -- j will never be scrutinised. + env1 | is_join_point = setTailCtxt env + | otherwise = setNonTailCtxt rhs_ctxt env -- Zap occ_join_points + rhs_ctxt = mkNonRecRhsCtxt bndr unf -- See Note [Sources of one-shot information] - rhs_env = env1 { occ_one_shots = argOneShots dmd } + rhs_env = addOneShotsFromDmd bndr env1 -- See Note [Join arity prediction based on joinRhsArity] -- Match join arity O from mb_join_arity with manifest join arity M as -- returned by of occAnalLamTail. It's totally OK for them to mismatch; -- hence adjust the UDs from the RHS - WithUsageDetails adj_rhs_uds final_rhs - = adjustNonRecRhs mb_join_arity $ occAnalLamTail rhs_env rhs - rhs_usage = adj_rhs_uds `andUDs` adj_unf_uds `andUDs` adj_rule_uds - final_bndr = tagged_bndr `setIdSpecialisation` mkRuleInfo rules' - `setIdUnfolding` unf2 + WUD adj_rhs_uds final_rhs = adjustNonRecRhs mb_join $ + occAnalLamTail rhs_env rhs + final_bndr_with_rules + | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdSpecialisation` mkRuleInfo rules' + `setIdUnfolding` unf2 + final_bndr_no_rules + | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdUnfolding` unf2 --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] - unf | isId bndr = idUnfolding bndr - | otherwise = NoUnfolding - WithTailUsageDetails unf_uds unf1 = occAnalUnfolding rhs_env unf - unf2 = markNonRecUnfoldingOneShots mb_join_arity unf1 - adj_unf_uds = adjustTailArity mb_join_arity unf_uds + unf = idUnfolding bndr + WTUD unf_tuds unf1 = occAnalUnfolding rhs_env unf + unf2 = markNonRecUnfoldingOneShots mb_join unf1 + adj_unf_uds = adjustTailArity mb_join unf_tuds --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] -- and Note [Join points and unfoldings/rules] - rules_w_uds = occAnalRules rhs_env bndr + rules = idCoreRules bndr + rules_w_uds = map (occAnalRule rhs_env) rules rules' = map fstOf3 rules_w_uds - imp_rule_uds = impRulesScopeUsage (lookupImpRules imp_rule_edges bndr) + imp_rule_infos = lookupImpRules imp_rule_edges bndr + imp_rule_uds = [impRulesScopeUsage imp_rule_infos] -- imp_rule_uds: consider -- h = ... -- g = ... @@ -897,21 +1092,27 @@ occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage -- that g is (since the RULE might turn g into h), so -- we make g mention h. - adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds - add_rule_uds (_, l, r) uds - = l `andUDs` adjustTailArity mb_join_arity r `andUDs` uds + adj_rule_uds :: [UsageDetails] + adj_rule_uds = imp_rule_uds ++ + [ l `andUDs` adjustTailArity mb_join r + | (_,l,r) <- rules_w_uds ] - ---------- - occ = idOccInfo tagged_bndr +mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl +-- Precondition: Id is not a join point +mkNonRecRhsCtxt bndr unf + | certainly_inline = OccVanilla -- See Note [Cascading inlines] + | otherwise = OccRhs + where certainly_inline -- See Note [Cascading inlines] - = case occ of + = -- mkNonRecRhsCtxt is only used for non-join points, so occAnalBind + -- has set the OccInfo for this binder before calling occAnalNonRecRhs + case idOccInfo bndr of OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 } -> active && not_stable _ -> False - dmd = idDemandInfo bndr active = isAlwaysActive (idInlineActivation bndr) - not_stable = not (isStableUnfolding (idUnfolding bndr)) + not_stable = not (isStableUnfolding unf) ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] @@ -921,38 +1122,17 @@ occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] -- * compute strongly-connected components -- * feed those components to occAnalRec -- See Note [Recursive bindings: the grand plan] -occAnalRecBind !env lvl imp_rule_edges pairs body_usage - = foldr (occAnalRec rhs_env lvl) (WithUsageDetails body_usage []) sccs +occAnalRecBind !rhs_env lvl imp_rule_edges pairs body_usage + = foldr (occAnalRec rhs_env lvl) (WUD body_usage []) sccs where sccs :: [SCC NodeDetails] - sccs = {-# SCC "occAnalBind.scc" #-} - stronglyConnCompFromEdgedVerticesUniq nodes + sccs = stronglyConnCompFromEdgedVerticesUniq nodes nodes :: [LetrecNode] - nodes = {-# SCC "occAnalBind.assoc" #-} - map (makeNode rhs_env imp_rule_edges bndr_set) pairs + nodes = map (makeNode rhs_env imp_rule_edges bndr_set) pairs bndrs = map fst pairs bndr_set = mkVarSet bndrs - rhs_env = env `addInScope` bndrs - -adjustNonRecRhs :: Maybe JoinArity -> WithTailUsageDetails CoreExpr -> WithUsageDetails CoreExpr --- ^ This function concentrates shared logic between occAnalNonRecBind and the --- AcyclicSCC case of occAnalRec. --- * It applies 'markNonRecJoinOneShots' to the RHS --- * and returns the adjusted rhs UsageDetails combined with the body usage -adjustNonRecRhs mb_join_arity (WithTailUsageDetails rhs_tuds rhs) - = WithUsageDetails rhs_uds' rhs' - where - --------- Marking (non-rec) join binders one-shot --------- - !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs - | otherwise = rhs - --------- Adjusting right-hand side usage --------- - rhs_uds' = adjustTailUsage mb_join_arity rhs' rhs_tuds - -bindersOfSCC :: SCC NodeDetails -> [Var] -bindersOfSCC (AcyclicSCC nd) = [nd_bndr nd] -bindersOfSCC (CyclicSCC ds) = map nd_bndr ds ----------------------------- occAnalRec :: OccEnv -> TopLevelFlag @@ -960,39 +1140,47 @@ occAnalRec :: OccEnv -> TopLevelFlag -> WithUsageDetails [CoreBind] -> WithUsageDetails [CoreBind] --- Check for Note [Dead code] --- NB: Only look at body_uds, ignoring uses in the SCC -occAnalRec !_ _ scc (WithUsageDetails body_uds binds) - | not (any (`usedIn` body_uds) (bindersOfSCC scc)) - = WithUsageDetails body_uds binds - -- The NonRec case is just like a Let (NonRec ...) above occAnalRec !_ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = wtuds })) - (WithUsageDetails body_uds binds) - = WithUsageDetails (body_uds' `andUDs` rhs_uds') (NonRec bndr' rhs' : binds) + (WUD body_uds binds) + | isDeadOcc occ -- Check for dead code: see Note [Dead code] + = WUD body_uds binds + | otherwise + = let tagged_bndr = tagNonRecBinder lvl occ bndr + mb_join_arity = willBeJoinId_maybe tagged_bndr + !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join_arity wtuds + !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) + !bndr' = tagged_bndr `setIdUnfolding` unf' + in WUD (body_uds `andUDs` rhs_uds') + (NonRec bndr' rhs' : binds) where - WithUsageDetails body_uds' tagged_bndr = tagNonRecBinder lvl body_uds bndr - mb_join_arity = willBeJoinId_maybe tagged_bndr - WithUsageDetails rhs_uds' rhs' = adjustNonRecRhs mb_join_arity wtuds - !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) - !bndr' = tagged_bndr `setIdUnfolding` unf' + occ = lookupLetOccInfo body_uds bndr -- The Rec case is the interesting one -- See Note [Recursive bindings: the grand plan] -- See Note [Loop breaking] -occAnalRec env lvl (CyclicSCC details_s) (WithUsageDetails body_uds binds) - = -- pprTrace "occAnalRec" (ppr loop_breaker_nodes) - WithUsageDetails final_uds (Rec pairs : binds) +occAnalRec env lvl (CyclicSCC details_s) (WUD body_uds binds) + | not (any needed details_s) + = -- Check for dead code: see Note [Dead code] + -- NB: Only look at body_uds, ignoring uses in the SCC + WUD body_uds binds + + | otherwise + = WUD final_uds (Rec pairs : binds) where all_simple = all nd_simple details_s + needed :: NodeDetails -> Bool + needed (ND { nd_bndr = bndr }) = isExportedId bndr || bndr `elemVarEnv` body_env + body_env = ud_env body_uds + ------------------------------ -- Make the nodes for the loop-breaker analysis -- See Note [Choosing loop breakers] for loop_breaker_nodes final_uds :: UsageDetails loop_breaker_nodes :: [LoopBreakerNode] - (WithUsageDetails final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s + WUD final_uds loop_breaker_nodes = mkLoopBreakerNodes env lvl body_uds details_s ------------------------------ weak_fvs :: VarSet @@ -1481,7 +1669,8 @@ instance Outputable NodeDetails where , text "simple =" <+> ppr (nd_simple nd) , text "active_rule_fvs =" <+> ppr (nd_active_rule_fvs nd) ]) - where WithTailUsageDetails uds _ = nd_rhs nd + where + WTUD uds _ = nd_rhs nd -- | Digraph with simplified and completely occurrence analysed -- 'SimpleNodeDetails', retaining just the info we need for breaking loops. @@ -1517,7 +1706,8 @@ makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> LetrecNode -- See Note [Recursive bindings: the grand plan] makeNode !env imp_rule_edges bndr_set (bndr, rhs) - = DigraphNode { node_payload = details + = -- pprTrace "makeNode" (ppr bndr <+> ppr (sizeVarSet bndr_set)) $ + DigraphNode { node_payload = details , node_key = varUnique bndr , node_dependencies = nonDetKeysUniqSet scope_fvs } -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR @@ -1525,20 +1715,20 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. where details = ND { nd_bndr = bndr' - , nd_rhs = WithTailUsageDetails scope_uds rhs' + , nd_rhs = WTUD (TUD rhs_ja unadj_scope_uds) rhs' , nd_inl = inl_fvs , nd_simple = null rules_w_uds && null imp_rule_info , nd_weak_fvs = weak_fvs , nd_active_rule_fvs = active_rule_fvs } - bndr' = bndr `setIdUnfolding` unf' - `setIdSpecialisation` mkRuleInfo rules' + bndr' | noBinderSwaps env = bndr -- See Note [Unfoldings and rules] + | otherwise = bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' -- NB: Both adj_unf_uds and adj_rule_uds have been adjusted to match the -- JoinArity rhs_ja of unadj_rhs_uds. unadj_inl_uds = unadj_rhs_uds `andUDs` adj_unf_uds unadj_scope_uds = unadj_inl_uds `andUDs` adj_rule_uds - scope_uds = TUD rhs_ja unadj_scope_uds -- Note [Rules are extra RHSs] -- Note [Rule dependency info] scope_fvs = udFreeVars bndr_set unadj_scope_uds @@ -1547,7 +1737,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) inl_fvs = udFreeVars bndr_set unadj_inl_uds -- inl_fvs: vars that would become free if the function was inlined. - -- We conservatively approximate that by thefree vars from the RHS + -- We conservatively approximate that by the free vars from the RHS -- and the unfolding together. -- See Note [inl_fvs] @@ -1566,15 +1756,18 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- Instead, do the occAnalLamTail call here and postpone adjustTailUsage -- until occAnalRec. In effect, we pretend that the RHS becomes a -- non-recursive join point and fix up later with adjustTailUsage. - rhs_env = rhsCtxt env - WithTailUsageDetails (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs - -- corresponding call to adjustTailUsage in occAnalRec and tagRecBinders + rhs_env | isJoinId bndr = setTailCtxt env + | otherwise = setNonTailCtxt OccRhs env + -- If bndr isn't an /existing/ join point, it's safe to zap the + -- occ_join_points, because they can't occur in RHS. + WTUD (TUD rhs_ja unadj_rhs_uds) rhs' = occAnalLamTail rhs_env rhs + -- The corresponding call to adjustTailUsage is in occAnalRec and tagRecBinders --------- Unfolding --------- -- See Note [Join points and unfoldings/rules] unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness -- here because that is what we are setting! - WithTailUsageDetails unf_tuds unf' = occAnalUnfolding rhs_env unf + WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf adj_unf_uds = adjustTailArity (Just rhs_ja) unf_tuds -- `rhs_ja` is `joinRhsArity rhs` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] @@ -1590,8 +1783,9 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- `rhs_ja` is `joinRhsArity rhs'` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_tuds) - | (r,l,rhs_tuds) <- occAnalRules rhs_env bndr ] + rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_wuds) + | rule <- idCoreRules bndr + , let (r,l,rhs_wuds) = occAnalRule rhs_env rule ] rules' = map fstOf3 rules_w_uds adj_rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds @@ -1624,11 +1818,12 @@ mkLoopBreakerNodes :: OccEnv -> TopLevelFlag -- d) adjust each RHS's usage details according to -- the binder's (new) shotness and join-point-hood mkLoopBreakerNodes !env lvl body_uds details_s - = WithUsageDetails final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') + = WUD final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') where - WithUsageDetails final_uds bndrs' = tagRecBinders lvl body_uds details_s + WUD final_uds bndrs' = tagRecBinders lvl body_uds details_s - mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs }) new_bndr + mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs + , nd_rhs = WTUD _ rhs }) new_bndr = DigraphNode { node_payload = simple_nd , node_key = varUnique old_bndr , node_dependencies = nonDetKeysUniqSet lb_deps } @@ -1637,7 +1832,6 @@ mkLoopBreakerNodes !env lvl body_uds details_s -- in nondeterministic order as explained in -- Note [Deterministic SCC] in GHC.Data.Graph.Directed. where - WithTailUsageDetails _ rhs = nd_rhs nd simple_nd = SND { snd_bndr = new_bndr, snd_rhs = rhs, snd_score = score } score = nodeScore env new_bndr lb_deps nd lb_deps = extendFvs_ rule_fv_env inl_fvs @@ -1677,7 +1871,7 @@ nodeScore :: OccEnv -> NodeDetails -> NodeScore nodeScore !env new_bndr lb_deps - (ND { nd_bndr = old_bndr, nd_rhs = WithTailUsageDetails _ bind_rhs }) + (ND { nd_bndr = old_bndr, nd_rhs = WTUD _ bind_rhs }) | not (isId old_bndr) -- A type or coercion variable is never a loop breaker = (100, 0, False) @@ -1974,36 +2168,48 @@ occAnalLamTail :: OccEnv -> CoreExpr -> WithTailUsageDetails CoreExpr -- In effect, the analysis result is for a non-recursive join point with -- manifest arity and adjustTailUsage does the fixup. -- See Note [Adjusting right-hand sides] -occAnalLamTail env (Lam bndr expr) - | isTyVar bndr - , let env1 = addOneInScope env bndr - , WithTailUsageDetails (TUD ja usage) expr' <- occAnalLamTail env1 expr - = WithTailUsageDetails (TUD (ja+1) usage) (Lam bndr expr') - -- Important: Keep the 'env' unchanged so that with a RHS like - -- \(@ x) -> K @x (f @x) - -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain - -- from inlining f. See the beginning of Note [Cascading inlines]. - - | otherwise -- So 'bndr' is an Id - = let (env_one_shots', bndr1) - = case occ_one_shots env of - [] -> ([], bndr) - (os : oss) -> (oss, updOneShotInfo bndr os) - -- Use updOneShotInfo, not setOneShotInfo, as pre-existing - -- one-shot info might be better than what we can infer, e.g. - -- due to explicit use of the magic 'oneShot' function. - -- See Note [The oneShot function] - - env1 = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } - env2 = addOneInScope env1 bndr - WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env2 expr - (usage', bndr2) = tagLamBinder usage bndr1 - in WithTailUsageDetails (TUD (ja+1) usage') (Lam bndr2 expr') +occAnalLamTail env expr + = let !(WUD usage expr') = occ_anal_lam_tail env expr + in WTUD (TUD (joinRhsArity expr) usage) expr' + +occ_anal_lam_tail :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr +-- Does not markInsidLam etc for the outmost batch of lambdas +occ_anal_lam_tail env expr@(Lam {}) + = go env [] expr + where + go :: OccEnv -> [Var] -> CoreExpr -> WithUsageDetails CoreExpr + go env rev_bndrs (Lam bndr body) + | isTyVar bndr + = go env (bndr:rev_bndrs) body + -- Important: Unlike a value binder, do not modify occ_encl + -- to OccVanilla, so that with a RHS like + -- \(@ x) -> K @x (f @x) + -- we'll see that (K @x (f @x)) is in a OccRhs, and hence refrain + -- from inlining f. See the beginning of Note [Cascading inlines]. + + | otherwise + = let (env_one_shots', bndr') + = case occ_one_shots env of + [] -> ([], bndr) + (os : oss) -> (oss, updOneShotInfo bndr os) + -- Use updOneShotInfo, not setOneShotInfo, as pre-existing + -- one-shot info might be better than what we can infer, e.g. + -- due to explicit use of the magic 'oneShot' function. + -- See Note [The oneShot function] + env' = env { occ_encl = OccVanilla, occ_one_shots = env_one_shots' } + in go env' (bndr':rev_bndrs) body + + go env rev_bndrs body + = addInScope env rev_bndrs $ \env -> + let !(WUD usage body') = occ_anal_lam_tail env body + wrap_lam body bndr = Lam (tagLamBinder usage bndr) body + in WUD (usage `addLamCoVarOccs` rev_bndrs) + (foldl' wrap_lam body' rev_bndrs) -- For casts, keep going in the same lambda-group -- See Note [Occurrence analysis for lambda binders] -occAnalLamTail env (Cast expr co) - = let WithTailUsageDetails (TUD ja usage) expr' = occAnalLamTail env expr +occ_anal_lam_tail env (Cast expr co) + = let WUD usage expr' = occ_anal_lam_tail env expr -- usage1: see Note [Gather occurrences of coercion variables] usage1 = addManyOccs usage (coVarsOfCo co) @@ -2019,10 +2225,10 @@ occAnalLamTail env (Cast expr co) -- GHC.Core.Lint: Note Note [Join points and casts] usage3 = markAllNonTail usage2 - in WithTailUsageDetails (TUD ja usage3) (Cast expr' co) + in WUD usage3 (Cast expr' co) -occAnalLamTail env expr = case occAnal env expr of - WithUsageDetails usage expr' -> WithTailUsageDetails (TUD 0 usage) expr' +occ_anal_lam_tail env expr -- Not Lam, not Cast + = occAnal env expr {- Note [Occ-anal and cast worker/wrapper] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2063,13 +2269,12 @@ occAnalUnfolding !env unf unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) | isStableSource src -> let - WithTailUsageDetails (TUD rhs_ja usage) rhs' = occAnalLamTail env rhs - - unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] - | otherwise = unf { uf_tmpl = rhs' } - in WithTailUsageDetails (TUD rhs_ja (markAllMany usage)) unf' + WTUD (TUD rhs_ja uds) rhs' = occAnalLamTail env rhs + unf' = unf { uf_tmpl = rhs' } + in WTUD (TUD rhs_ja (markAllMany uds)) unf' -- markAllMany: see Note [Occurrences in stable unfoldings] - | otherwise -> WithTailUsageDetails (TUD 0 emptyDetails) unf + + | otherwise -> WTUD (TUD 0 emptyDetails) unf -- For non-Stable unfoldings we leave them undisturbed, but -- don't count their usage because the simplifier will discard them. -- We leave them undisturbed because nodeScore uses their size info @@ -2078,43 +2283,36 @@ occAnalUnfolding !env unf -- scope remain in scope; there is no cloning etc. unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) - -> WithTailUsageDetails (TUD 0 final_usage) (unf { df_args = args' }) - where - env' = env `addInScope` bndrs - (WithUsageDetails usage args') = occAnalList env' args - final_usage = usage `addLamCoVarOccs` bndrs `delDetailsList` bndrs - -- delDetailsList; no need to use tagLamBinders because we + -> let WUD uds args' = addInScopeList env bndrs $ \ env -> + occAnalList env args + in WTUD (TUD 0 uds) (unf { df_args = args' }) + -- No need to use tagLamBinders because we -- never inline DFuns so the occ-info on binders doesn't matter - unf -> WithTailUsageDetails (TUD 0 emptyDetails) unf + unf -> WTUD (TUD 0 emptyDetails) unf -occAnalRules :: OccEnv - -> Id -- Get rules from here - -> [(CoreRule, -- Each (non-built-in) rule - UsageDetails, -- Usage details for LHS - TailUsageDetails)] -- Usage details for RHS -occAnalRules !env bndr - = map occ_anal_rule (idCoreRules bndr) +occAnalRule :: OccEnv + -> CoreRule + -> (CoreRule, -- Each (non-built-in) rule + UsageDetails, -- Usage details for LHS + TailUsageDetails) -- Usage details for RHS +occAnalRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) + = (rule', lhs_uds', TUD rhs_ja rhs_uds') where - occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) - = (rule', lhs_uds', TUD rhs_ja rhs_uds') - where - env' = env `addInScope` bndrs - rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] - | otherwise = rule { ru_args = args', ru_rhs = rhs' } + rule' = rule { ru_args = args', ru_rhs = rhs' } - (WithUsageDetails lhs_uds args') = occAnalList env' args - lhs_uds' = markAllManyNonTail (lhs_uds `delDetailsList` bndrs) - `addLamCoVarOccs` bndrs + WUD lhs_uds args' = addInScopeList env bndrs $ \env -> + occAnalList env args - (WithUsageDetails rhs_uds rhs') = occAnal env' rhs - -- Note [Rules are extra RHSs] - -- Note [Rule dependency info] - rhs_uds' = markAllMany $ - rhs_uds `delDetailsList` bndrs - rhs_ja = length args -- See Note [Join points and unfoldings/rules] + lhs_uds' = markAllManyNonTail lhs_uds + WUD rhs_uds rhs' = addInScopeList env bndrs $ \env -> + occAnal env rhs + -- Note [Rules are extra RHSs] + -- Note [Rule dependency info] + rhs_uds' = markAllMany rhs_uds + rhs_ja = length args -- See Note [Join points and unfoldings/rules] - occ_anal_rule other_rule = (other_rule, emptyDetails, TUD 0 emptyDetails) +occAnalRule _ other_rule = (other_rule, emptyDetails, TUD 0 emptyDetails) {- Note [Join point RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2178,7 +2376,7 @@ have no dead code. See Note [OccInfo in unfoldings and rules] in GHC.Core. Note [Cascading inlines] ~~~~~~~~~~~~~~~~~~~~~~~~ -By default we use an rhsCtxt for the RHS of a binding. This tells the +By default we use an OccRhs for the RHS of a binding. This tells the occ anal n that it's looking at an RHS, which has an effect in occAnalApp. In particular, for constructor applications, it makes the arguments appear to have NoOccInfo, so that we don't inline into @@ -2199,7 +2397,7 @@ Result: multiple simplifier iterations. Sigh. So, when analysing the RHS of x3 we notice that x3 will itself definitely inline the next time round, and so we analyse x3's rhs in -an ordinary context, not rhsCtxt. Hence the "certainly_inline" stuff. +an OccVanilla context, not OccRhs. Hence the "certainly_inline" stuff. Annoyingly, we have to approximate GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally. If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and @@ -2229,17 +2427,17 @@ for the various clauses. -} occAnalList :: OccEnv -> [CoreExpr] -> WithUsageDetails [CoreExpr] -occAnalList !_ [] = WithUsageDetails emptyDetails [] +occAnalList !_ [] = WUD emptyDetails [] occAnalList env (e:es) = let - (WithUsageDetails uds1 e') = occAnal env e - (WithUsageDetails uds2 es') = occAnalList env es - in WithUsageDetails (uds1 `andUDs` uds2) (e' : es') + (WUD uds1 e') = occAnal env e + (WUD uds2 es') = occAnalList env es + in WUD (uds1 `andUDs` uds2) (e' : es') occAnal :: OccEnv -> CoreExpr -> WithUsageDetails CoreExpr -- Gives info only about the "interesting" Ids -occAnal !_ expr@(Lit _) = WithUsageDetails emptyDetails expr +occAnal !_ expr@(Lit _) = WUD emptyDetails expr occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- At one stage, I gathered the idRuleVars for the variable here too, @@ -2250,9 +2448,9 @@ occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- weren't used at all. occAnal _ expr@(Type ty) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfType ty)) expr + = WUD (addManyOccs emptyDetails (coVarsOfType ty)) expr occAnal _ expr@(Coercion co) - = WithUsageDetails (addManyOccs emptyDetails (coVarsOfCo co)) expr + = WUD (addManyOccs emptyDetails (coVarsOfCo co)) expr -- See Note [Gather occurrences of coercion variables] {- Note [Gather occurrences of coercion variables] @@ -2288,7 +2486,7 @@ We gather CoVar occurrences from: * The (Type ty) and (Coercion co) cases of occAnal * The type 'ty' of a lambda-binder (\(x:ty). blah) - See addLamCoVarOccs + See addCoVarOccs But it is not necessary to gather CoVars from the types of other binders. @@ -2301,22 +2499,22 @@ But it is not necessary to gather CoVars from the types of other binders. occAnal env (Tick tickish body) | SourceNote{} <- tickish - = WithUsageDetails usage (Tick tickish body') + = WUD usage (Tick tickish body') -- SourceNotes are best-effort; so we just proceed as usual. -- If we drop a tick due to the issues described below it's -- not the end of the world. | tickish `tickishScopesLike` SoftScope - = WithUsageDetails (markAllNonTail usage) (Tick tickish body') + = WUD (markAllNonTail usage) (Tick tickish body') | Breakpoint _ _ ids _ <- tickish - = WithUsageDetails (usage_lam `andUDs` foldr addManyOcc emptyDetails ids) (Tick tickish body') + = WUD (addManyOccs usage_lam (mkVarSet ids)) (Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise - = WithUsageDetails usage_lam (Tick tickish body') + = WUD usage_lam (Tick tickish body') where - (WithUsageDetails usage body') = occAnal env body + (WUD usage body') = occAnal env body -- for a non-soft tick scope, we can inline lambdas only usage_lam = markAllNonTail (markAllInsideLam usage) -- TODO There may be ways to make ticks and join points play @@ -2328,59 +2526,77 @@ occAnal env (Tick tickish body) -- See #14242. occAnal env (Cast expr co) - = let (WithUsageDetails usage expr') = occAnal env expr + = let (WUD usage expr') = occAnal env expr usage1 = addManyOccs usage (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] usage2 = markAllNonTail usage1 -- usage3: calls inside expr aren't tail calls any more - in WithUsageDetails usage2 (Cast expr' co) + in WUD usage2 (Cast expr' co) occAnal env app@(App _ _) = occAnalApp env (collectArgsTicks tickishFloatable app) occAnal env expr@(Lam {}) - = adjustNonRecRhs Nothing $ occAnalLamTail env expr -- mb_join_arity == Nothing <=> markAllManyNonTail + = adjustNonRecRhs Nothing $ -- Nothing <=> markAllManyNonTail + occAnalLamTail env expr occAnal env (Case scrut bndr ty alts) = let - (WithUsageDetails scrut_usage scrut') = occAnal (scrutCtxt env alts) scrut - alt_env = addBndrSwap scrut' bndr $ env { occ_encl = OccVanilla } `addOneInScope` bndr - (alts_usage_s, alts') = mapAndUnzip (do_alt alt_env) alts - alts_usage = foldr orUDs emptyDetails alts_usage_s - (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr - total_usage = markAllNonTail scrut_usage `andUDs` alts_usage1 + WUD scrut_usage scrut' = occAnal (setScrutCtxt env alts) scrut + + WUD alts_usage (tagged_bndr, alts') + = addInScopeOne env bndr $ \env -> + let alt_env = addBndrSwap scrut' bndr $ + setTailCtxt env -- Kill off OccRhs + WUD alts_usage alts' = do_alts alt_env alts + tagged_bndr = tagLamBinder alts_usage bndr + in WUD alts_usage (tagged_bndr, alts') + + total_usage = markAllNonTail scrut_usage `andUDs` alts_usage -- Alts can have tail calls, but the scrutinee can't - in WithUsageDetails total_usage (Case scrut' tagged_bndr ty alts') + + in WUD total_usage (Case scrut' tagged_bndr ty alts') where + do_alts :: OccEnv -> [CoreAlt] -> WithUsageDetails [CoreAlt] + do_alts _ [] = WUD emptyDetails [] + do_alts env (alt:alts) = WUD (uds1 `orUDs` uds2) (alt':alts') + where + WUD uds1 alt' = do_alt env alt + WUD uds2 alts' = do_alts env alts + do_alt !env (Alt con bndrs rhs) - = let - (WithUsageDetails rhs_usage1 rhs1) = occAnal (env `addInScope` bndrs) rhs - (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs - in -- See Note [Binders in case alternatives] - (alt_usg, Alt con tagged_bndrs rhs1) + = addInScopeList env bndrs $ \ env -> + let WUD rhs_usage rhs' = occAnal env rhs + tagged_bndrs = tagLamBinders rhs_usage bndrs + in -- See Note [Binders in case alternatives] + WUD rhs_usage (Alt con tagged_bndrs rhs') occAnal env (Let bind body) - = let - body_env = env { occ_encl = OccVanilla } `addInScope` bindersOf bind - (WithUsageDetails body_usage body') = occAnal body_env body - (WithUsageDetails final_usage binds') = occAnalBind env NotTopLevel - noImpRuleEdges bind body_usage - in WithUsageDetails final_usage (mkLets binds' body') + = occAnalBind env NotTopLevel noImpRuleEdges bind + (\env -> occAnal env body) mkLets -occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -> WithUsageDetails CoreExpr +occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] + -> [OneShots] -- Very commonly empty, notably prior to dmd anal + -> WithUsageDetails CoreExpr -- The `fun` argument is just an accumulating parameter, -- the base for building the application we return occAnalArgs !env fun args !one_shots = go emptyDetails fun args one_shots where - go uds fun [] _ = WithUsageDetails uds fun + env_args = setNonTailCtxt OccVanilla env + + go uds fun [] _ = WUD uds fun go uds fun (arg:args) one_shots = go (uds `andUDs` arg_uds) (fun `App` arg') args one_shots' where - !(WithUsageDetails arg_uds arg') = occAnal arg_env arg + !(WUD arg_uds arg') = occAnal arg_env arg !(arg_env, one_shots') - | isTypeArg arg = (env, one_shots) - | otherwise = valArgCtxt env one_shots + | isTypeArg arg + = (env_args, one_shots) + | otherwise + = case one_shots of + [] -> (env_args, []) -- Fast path; one_shots is often empty + (os : one_shots') -> (addOneShots os env_args, one_shots') {- Applications are dealt with specially because we want @@ -2414,19 +2630,19 @@ occAnalApp !env (Var fun, args, ticks) -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , WithUsageDetails usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg - = WithUsageDetails usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + , WUD usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg + = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun_id, args, ticks) - = WithUsageDetails all_uds (mkTicks ticks app') + = WUD all_uds (mkTicks ticks app') where -- Lots of banged bindings: this is a very heavily bit of code, -- so it pays not to make lots of thunks here, all of which -- will ultimately be forced. !(fun', fun_id') = lookupBndrSwap env fun_id - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args one_shots + !(WUD args_uds app') = occAnalArgs env fun' args one_shots - fun_uds = mkOneOcc fun_id' int_cxt n_args + fun_uds = mkOneOcc env fun_id' int_cxt n_args -- NB: fun_uds is computed for fun_id', not fun_id -- See (BS1) in Note [The binder-swap substitution] @@ -2434,6 +2650,7 @@ occAnalApp env (Var fun_id, args, ticks) !final_args_uds = markAllNonTail $ markAllInsideLamIf (isRhsEnv env && is_exp) $ + -- isRhsEnv: see Note [OccEncl] args_uds -- We mark the free vars of the argument of a constructor or PAP -- as "inside-lambda", if it is the RHS of a let(rec). @@ -2462,13 +2679,13 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = WithUsageDetails (markAllNonTail (fun_uds `andUDs` args_uds)) + = WUD (markAllNonTail (fun_uds `andUDs` args_uds)) (mkTicks ticks app') where - !(WithUsageDetails args_uds app') = occAnalArgs env fun' args [] - !(WithUsageDetails fun_uds fun') = occAnal (addAppCtxt env args) fun + !(WUD args_uds app') = occAnalArgs env fun' args [] + !(WUD fun_uds fun') = occAnal (addAppCtxt env args) fun -- The addAppCtxt is a bit cunning. One iteration of the simplifier - -- often leaves behind beta redexs like + -- often leaves behind beta redexes like -- (\x y -> e) a1 a2 -- Here we would like to mark x,y as one-shot, and treat the whole -- thing much like a let. We do this by pushing some OneShotLam items @@ -2595,33 +2812,45 @@ data OccEnv -- then please replace x by (y |> mco) -- Invariant of course: idType x = exprType (y |> mco) , occ_bs_env :: !(IdEnv (OutId, MCoercion)) - -- Domain is Global and Local Ids - -- Range is just Local Ids + -- Domain is Global and Local Ids + -- Range is just Local Ids , occ_bs_rng :: !VarSet - -- Vars (TyVars and Ids) free in the range of occ_bs_env + -- Vars (TyVars and Ids) free in the range of occ_bs_env + + -- Usage details of the RHS of in-scope non-recursive join points + -- Invariant: no Id maps to an empty OccInfoEnv + -- See Note [Occurrence analysis for join points] + , occ_join_points :: !JoinPointInfo } +type JoinPointInfo = IdEnv OccInfoEnv ----------------------------- --- OccEncl is used to control whether to inline into constructor arguments --- For example: --- x = (p,q) -- Don't inline p or q --- y = /\a -> (p a, q a) -- Still don't inline p or q --- z = f (p,q) -- Do inline p,q; it may make a rule fire --- So OccEncl tells enough about the context to know what to do when --- we encounter a constructor application or PAP. --- --- OccScrut is used to set the "interesting context" field of OncOcc +{- Note [OccEncl] +~~~~~~~~~~~~~~~~~ +OccEncl is used to control whether to inline into constructor arguments. -data OccEncl - = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda - -- Don't inline into constructor args here +* OccRhs: consider + let p = in + let x = Just p + in ...case p of ... - | OccScrut -- Scrutintee of a case - -- Can inline into constructor args + Here `p` occurs syntactically once, but we want to mark it as InsideLam + to stop `p` inlining. We want to leave the x-binding as a constructor + applied to variables, so that the Simplifier can simplify that inner `case`. + + The OccRhs just tells occAnalApp to mark occurrences in constructor args + +* OccScrut: consider (case x of ...). Here we want to give `x` OneOcc + with "interesting context" field int_cxt = True. The OccScrut tells + occAnalApp (which deals with lone variables too) when to set this field + to True. +-} - | OccVanilla -- Argument of function, body of lambda, etc - -- Do inline into constructor args here +data OccEncl -- See Note [OccEncl] + = OccRhs -- RHS of let(rec), albeit perhaps inside a type lambda + | OccScrut -- Scrutintee of a case + | OccVanilla -- Everything else instance Outputable OccEncl where ppr OccRhs = text "occRhs" @@ -2641,17 +2870,20 @@ initOccEnv , occ_unf_act = \_ -> True , occ_rule_act = \_ -> True + , occ_join_points = emptyVarEnv , occ_bs_env = emptyVarEnv , occ_bs_rng = emptyVarSet } noBinderSwaps :: OccEnv -> Bool noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env -scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv -scrutCtxt !env alts - | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } - | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } +setScrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv +setScrutCtxt !env alts + = setNonTailCtxt encl env where + encl | interesting_alts = OccScrut + | otherwise = OccVanilla + interesting_alts = case alts of [] -> False [alt] -> not (isDefaultAlt alt) @@ -2660,34 +2892,160 @@ scrutCtxt !env alts -- non-default alternative. That in turn influences -- pre/postInlineUnconditionally. Grep for "occ_int_cxt"! -rhsCtxt :: OccEnv -> OccEnv -rhsCtxt !env = env { occ_encl = OccRhs, occ_one_shots = [] } - -valArgCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) -valArgCtxt !env [] - = (env { occ_encl = OccVanilla, occ_one_shots = [] }, []) -valArgCtxt env (one_shots:one_shots_s) - = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s) +setNonTailCtxt :: OccEncl -> OccEnv -> OccEnv +setNonTailCtxt ctxt !env + = env { occ_encl = ctxt + , occ_one_shots = [] + , occ_join_points = zapped_jp_env } + where + -- zapped_jp_env is basically just emptyVarEnv (hence zapped). See (W3) of + -- Note [Occurrence analysis for join points] Zapping improves efficiency, + -- slightly, if you accidentally introduce a bug, in which you zap [jx :-> uds] and + -- then find an occurrence of jx anyway, you might lose those uds, and + -- that might mean we don't record all occurrencs, and that means we + -- duplicate a redex.... a very nasty bug (which I encountered!). Hence + -- this DEBUG code which doesn't remove jx from the envt; it just gives it + -- emptyDetails, which in turn causes a panic in mkOneOcc. That will catch + -- this bug before it does any damage. +#ifdef DEBUG + zapped_jp_env = mapVarEnv (\ _ -> emptyVarEnv) (occ_join_points env) +#else + zapped_jp_env = emptyVarEnv +#endif + +setTailCtxt :: OccEnv -> OccEnv +setTailCtxt !env + = env { occ_encl = OccVanilla } + -- Preserve occ_one_shots, occ_join points + -- Do not use OccRhs for the RHS of a join point (which is a tail ctxt): + -- see Note [Join point RHSs] + +addOneShots :: OneShots -> OccEnv -> OccEnv +addOneShots os !env + | null os = env -- Fast path for common case + | otherwise = env { occ_one_shots = os } + +addOneShotsFromDmd :: Id -> OccEnv -> OccEnv +addOneShotsFromDmd bndr = addOneShots (argOneShots (idDemandInfo bndr)) isRhsEnv :: OccEnv -> Bool isRhsEnv (OccEnv { occ_encl = cxt }) = case cxt of OccRhs -> True _ -> False -addOneInScope :: OccEnv -> CoreBndr -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addOneInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndr - | bndr `elemVarSet` rng_vars = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnv` bndr } - -addInScope :: OccEnv -> [Var] -> OccEnv --- Needed for all Vars not just Ids --- See Note [The binder-swap substitution] (BS3) -addInScope env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) bndrs - | any (`elemVarSet` rng_vars) bndrs = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } - | otherwise = env { occ_bs_env = swap_env `delVarEnvList` bndrs } +addInScopeList :: OccEnv -> [Var] + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeList #-} +addInScopeList env bndrs thing_inside + | null bndrs = thing_inside env -- E.g. nullary constructors in a `case` + | otherwise = addInScope env bndrs thing_inside + +addInScopeOne :: OccEnv -> Id + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScopeOne #-} +addInScopeOne env bndr = addInScope env [bndr] + +addInScope :: OccEnv -> [Var] + -> (OccEnv -> WithUsageDetails a) -> WithUsageDetails a +{-# INLINE addInScope #-} +-- This function is called a lot, so we want to inline the fast path +-- so we don't have to allocate thing_inside and call it +-- The bndrs must include TyVars as well as Ids, because of +-- (BS3) in Note [Binder swap] +-- We do not assume that the bndrs are in scope order; in fact the +-- call in occ_anal_lam_tail gives them to addInScope in /reverse/ order + +-- Fast path when the is no environment-munging to do +-- This is rather common: notably at top level, but nested too +addInScope env bndrs thing_inside + | isEmptyVarEnv (occ_bs_env env) + , isEmptyVarEnv (occ_join_points env) + , WUD uds res <- thing_inside env + = WUD (delBndrsFromUDs bndrs uds) res + +addInScope env bndrs thing_inside + = WUD uds' res + where + bndr_set = mkVarSet bndrs + !(env', bad_joins) = preprocess_env env bndr_set + !(WUD uds res) = thing_inside env' + uds' = postprocess_uds bndrs bad_joins uds + +preprocess_env :: OccEnv -> VarSet -> (OccEnv, JoinPointInfo) +preprocess_env env@(OccEnv { occ_join_points = join_points + , occ_bs_rng = bs_rng_vars }) + bndr_set + | bad_joins = (drop_shadowed_swaps (drop_shadowed_joins env), join_points) + | otherwise = (drop_shadowed_swaps env, emptyVarEnv) + where + drop_shadowed_swaps :: OccEnv -> OccEnv + -- See Note [The binder-swap substitution] (BS3) + drop_shadowed_swaps env@(OccEnv { occ_bs_env = swap_env }) + | isEmptyVarEnv swap_env + = env + | bs_rng_vars `intersectsVarSet` bndr_set + = env { occ_bs_env = emptyVarEnv, occ_bs_rng = emptyVarSet } + | otherwise + = env { occ_bs_env = swap_env `minusUFM` bndr_fm } + + drop_shadowed_joins :: OccEnv -> OccEnv + -- See Note [Occurrence analysis for join points] wrinkle2 (W1) and (W2) + drop_shadowed_joins env = env { occ_join_points = emptyVarEnv } + + -- bad_joins is true if it would be wrong to push occ_join_points inwards + -- (a) `bndrs` includes any of the occ_join_points + -- (b) `bndrs` includes any variables free in the RHSs of occ_join_points + bad_joins :: Bool + bad_joins = nonDetStrictFoldVarEnv_Directly is_bad False join_points + + bndr_fm :: UniqFM Var Var + bndr_fm = getUniqSet bndr_set + + is_bad :: Unique -> OccInfoEnv -> Bool -> Bool + is_bad uniq join_uds rest + = uniq `elemUniqSet_Directly` bndr_set || + not (bndr_fm `disjointUFM` join_uds) || + rest + +postprocess_uds :: [Var] -> JoinPointInfo -> UsageDetails -> UsageDetails +postprocess_uds bndrs bad_joins uds + = add_bad_joins (delBndrsFromUDs bndrs uds) + where + add_bad_joins :: UsageDetails -> UsageDetails + -- Add usage info for occ_join_points that we cannot push inwards + -- because of shadowing + -- See Note [Occurrence analysis for join points] wrinkle (W2) + add_bad_joins uds + | isEmptyVarEnv bad_joins = uds + | otherwise = modifyUDEnv extend_with_bad_joins uds + + extend_with_bad_joins :: OccInfoEnv -> OccInfoEnv + extend_with_bad_joins env + = nonDetStrictFoldUFM_Directly add_bad_join env bad_joins + + add_bad_join :: Unique -> OccInfoEnv -> OccInfoEnv -> OccInfoEnv + -- Behave like `andUDs` when adding in the bad_joins + add_bad_join uniq join_env env + | uniq `elemVarEnvByKey` env = plusVarEnv_C andLocalOcc env join_env + | otherwise = env + +addJoinPoint :: OccEnv -> Id -> UsageDetails -> OccEnv +addJoinPoint env bndr rhs_uds + | isEmptyVarEnv zeroed_form + = env + | otherwise + = env { occ_join_points = extendVarEnv (occ_join_points env) bndr zeroed_form } + where + zeroed_form = mkZeroedForm rhs_uds +mkZeroedForm :: UsageDetails -> OccInfoEnv +-- See Note [Occurrence analysis for join points] for "zeroed form" +mkZeroedForm (UD { ud_env = rhs_occs }) + = mapMaybeUFM do_one rhs_occs + where + do_one :: LocalOcc -> Maybe LocalOcc + do_one (ManyOccL {}) = Nothing + do_one occ@(OneOccL {}) = Just (occ { lo_n_br = 0 }) -------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet @@ -3106,11 +3464,40 @@ with the 'OccInfoEnv'. Each of these extra environments is a "zapped set" recording which variables have been zapped in some way. Zapping all occurrence info then simply means setting the corresponding zapped set to the whole 'OccInfoEnv', a fast O(1) operation. + +Note [LocalOcc] +~~~~~~~~~~~~~~~ +LocalOcc is used purely internally, in the occurrence analyser. It differs from +GHC.Types.Basic.OccInfo because it has only OneOcc and ManyOcc; it does not need +IAmDead or IAmALoopBreaker. + +Note that `OneOccL` doesn't meant that it occurs /syntactially/ only once; it +means that it is /used/ only once. It might occur syntactically many times. +For example, in (case x of A -> y; B -> y; C -> True), +* `y` is used only once +* but it occurs syntactically twice + -} -type OccInfoEnv = IdEnv OccInfo -- A finite map from ids to their usage - -- INVARIANT: never IAmDead - -- (Deadness is signalled by not being in the map at all) +type OccInfoEnv = IdEnv LocalOcc -- A finite map from an expression's + -- free variables to their usage + +data LocalOcc -- See Note [LocalOcc] + = OneOccL { lo_n_br :: {-# UNPACK #-} !BranchCount -- Number of syntactic occurrences + , lo_tail :: !TailCallInfo + -- Combining (AlwaysTailCalled 2) and (AlwaysTailCalled 3) + -- gives NoTailCallInfo + , lo_int_cxt :: !InterestingCxt } + | ManyOccL !TailCallInfo + +instance Outputable LocalOcc where + ppr (OneOccL { lo_n_br = n, lo_tail = tci }) + = text "OneOccL" <> braces (ppr n <> comma <> ppr tci) + ppr (ManyOccL tci) = text "ManyOccL" <> braces (ppr tci) + +localTailCallInfo :: LocalOcc -> TailCallInfo +localTailCallInfo (OneOccL { lo_tail = tci }) = tci +localTailCallInfo (ManyOccL tci) = tci type ZappedSet = OccInfoEnv -- Values are ignored @@ -3118,53 +3505,67 @@ data UsageDetails = UD { ud_env :: !OccInfoEnv , ud_z_many :: !ZappedSet -- apply 'markMany' to these , ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these - , ud_z_no_tail :: !ZappedSet } -- apply 'markNonTail' to these - -- INVARIANT: All three zapped sets are subsets of the OccInfoEnv + , ud_z_tail :: !ZappedSet -- zap tail-call info for these + } + -- INVARIANT: All three zapped sets are subsets of ud_env instance Outputable UsageDetails where - ppr ud = ppr (ud_env (flattenUsageDetails ud)) - --- | Captures the result of applying 'occAnalLamTail' to a function `\xyz.body`. --- The TailUsageDetails records + ppr ud@(UD { ud_env = env, ud_z_tail = z_tail }) + = text "UD" <+> (braces $ fsep $ punctuate comma $ + [ ppr uq <+> text ":->" <+> ppr (lookupOccInfoByUnique ud uq) + | (uq, _) <- nonDetStrictFoldVarEnv_Directly do_one [] env ]) + $$ nest 2 (text "ud_z_tail" <+> ppr z_tail) + where + do_one :: Unique -> LocalOcc -> [(Unique,LocalOcc)] -> [(Unique,LocalOcc)] + do_one uniq occ occs = (uniq, occ) : occs + +--------------------- +-- | TailUsageDetails captures the result of applying 'occAnalLamTail' +-- to a function `\xyz.body`. The TailUsageDetails pairs together -- * the number of lambdas (including type lambdas: a JoinArity) --- * UsageDetails for the `body`, unadjusted by `adjustTailUsage`. --- If the binding turns out to be a join point with the indicated join --- arity, this unadjusted usage details is just what we need; otherwise we --- need to discard tail calls. That's what `adjustTailUsage` does. +-- * UsageDetails for the `body` of the lambda, unadjusted by `adjustTailUsage`. +-- If the binding turns out to be a join point with the indicated join +-- arity, this unadjusted usage details is just what we need; otherwise we +-- need to discard tail calls. That's what `adjustTailUsage` does. data TailUsageDetails = TUD !JoinArity !UsageDetails instance Outputable TailUsageDetails where ppr (TUD ja uds) = lambda <> ppr ja <> ppr uds +--------------------- +data WithUsageDetails a = WUD !UsageDetails !a +data WithTailUsageDetails a = WTUD !TailUsageDetails !a ------------------- -- UsageDetails API andUDs, orUDs :: UsageDetails -> UsageDetails -> UsageDetails -andUDs = combineUsageDetailsWith addOccInfo -orUDs = combineUsageDetailsWith orOccInfo +andUDs = combineUsageDetailsWith andLocalOcc +orUDs = combineUsageDetailsWith orLocalOcc -mkOneOcc :: Id -> InterestingCxt -> JoinArity -> UsageDetails -mkOneOcc id int_cxt arity - | isLocalId id - = emptyDetails { ud_env = unitVarEnv id occ_info } - | otherwise +mkOneOcc :: OccEnv -> Id -> InterestingCxt -> JoinArity -> UsageDetails +mkOneOcc !env id int_cxt arity + | not (isLocalId id) = emptyDetails - where - occ_info = OneOcc { occ_in_lam = NotInsideLam - , occ_n_br = oneBranch - , occ_int_cxt = int_cxt - , occ_tail = AlwaysTailCalled arity } -addManyOccId :: UsageDetails -> Id -> UsageDetails --- Add the non-committal (id :-> noOccInfo) to the usage details -addManyOccId ud id = ud { ud_env = extendVarEnv (ud_env ud) id noOccInfo } + | Just join_uds <- lookupVarEnv (occ_join_points env) id + = -- See Note [Occurrence analysis for join points] + assertPpr (not (isEmptyVarEnv join_uds)) (ppr id) $ + -- We only put non-empty join-points into occ_join_points + mkSimpleDetails (extendVarEnv join_uds id occ) + + | otherwise + = mkSimpleDetails (unitVarEnv id occ) + + where + occ = OneOccL { lo_n_br = 1, lo_int_cxt = int_cxt + , lo_tail = AlwaysTailCalled arity } -- Add several occurrences, assumed not to be tail calls -addManyOcc :: Var -> UsageDetails -> UsageDetails -addManyOcc v u | isId v = addManyOccId u v - | otherwise = u +add_many_occ :: Var -> OccInfoEnv -> OccInfoEnv +add_many_occ v env | isId v = extendVarEnv env v (ManyOccL NoTailCallInfo) + | otherwise = env -- Give a non-committal binder info (i.e noOccInfo) because -- a) Many copies of the specialised thing can appear -- b) We don't want to substitute a BIG expression inside a RULE @@ -3172,37 +3573,51 @@ addManyOcc v u | isId v = addManyOccId u v -- (Same goes for INLINE.) addManyOccs :: UsageDetails -> VarSet -> UsageDetails -addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set - -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes +addManyOccs uds var_set + | isEmptyVarSet var_set = uds + | otherwise = uds { ud_env = add_to (ud_env uds) } + where + add_to env = nonDetStrictFoldUniqSet add_many_occ env var_set + -- It's OK to use nonDetStrictFoldUniqSet here because add_many_occ commutes addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails -- Add any CoVars free in the type of a lambda-binder -- See Note [Gather occurrences of coercion variables] addLamCoVarOccs uds bndrs - = uds `addManyOccs` coVarsOfTypes (map varType bndrs) - -delDetails :: UsageDetails -> Id -> UsageDetails -delDetails ud bndr - = ud `alterUsageDetails` (`delVarEnv` bndr) - -delDetailsList :: UsageDetails -> [Id] -> UsageDetails -delDetailsList ud bndrs - = ud `alterUsageDetails` (`delVarEnvList` bndrs) + = foldr add uds bndrs + where + add bndr uds = uds `addManyOccs` coVarsOfType (varType bndr) emptyDetails :: UsageDetails -emptyDetails = UD { ud_env = emptyVarEnv - , ud_z_many = emptyVarEnv - , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } +emptyDetails = mkSimpleDetails emptyVarEnv isEmptyDetails :: UsageDetails -> Bool -isEmptyDetails = isEmptyVarEnv . ud_env +isEmptyDetails (UD { ud_env = env }) = isEmptyVarEnv env + +mkSimpleDetails :: OccInfoEnv -> UsageDetails +mkSimpleDetails env = UD { ud_env = env + , ud_z_many = emptyVarEnv + , ud_z_in_lam = emptyVarEnv + , ud_z_tail = emptyVarEnv } + +modifyUDEnv :: (OccInfoEnv -> OccInfoEnv) -> UsageDetails -> UsageDetails +modifyUDEnv f uds@(UD { ud_env = env }) = uds { ud_env = f env } + +delBndrsFromUDs :: [Var] -> UsageDetails -> UsageDetails +-- Delete these binders from the UsageDetails +delBndrsFromUDs bndrs (UD { ud_env = env, ud_z_many = z_many + , ud_z_in_lam = z_in_lam, ud_z_tail = z_tail }) + = UD { ud_env = env `delVarEnvList` bndrs + , ud_z_many = z_many `delVarEnvList` bndrs + , ud_z_in_lam = z_in_lam `delVarEnvList` bndrs + , ud_z_tail = z_tail `delVarEnvList` bndrs } markAllMany, markAllInsideLam, markAllNonTail, markAllManyNonTail :: UsageDetails -> UsageDetails -markAllMany ud = ud { ud_z_many = ud_env ud } -markAllInsideLam ud = ud { ud_z_in_lam = ud_env ud } -markAllNonTail ud = ud { ud_z_no_tail = ud_env ud } +markAllMany ud@(UD { ud_env = env }) = ud { ud_z_many = env } +markAllInsideLam ud@(UD { ud_env = env }) = ud { ud_z_in_lam = env } +markAllNonTail ud@(UD { ud_env = env }) = ud { ud_z_tail = env } +markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo markAllInsideLamIf, markAllNonTailIf :: Bool -> UsageDetails -> UsageDetails @@ -3212,21 +3627,18 @@ markAllInsideLamIf False ud = ud markAllNonTailIf True ud = markAllNonTail ud markAllNonTailIf False ud = ud - -markAllManyNonTail = markAllMany . markAllNonTail -- effectively sets to noOccInfo - -lookupDetails :: UsageDetails -> Id -> OccInfo -lookupDetails ud id - = case lookupVarEnv (ud_env ud) id of - Just occ -> doZapping ud id occ - Nothing -> IAmDead - -usedIn :: Id -> UsageDetails -> Bool -v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud +lookupTailCallInfo :: UsageDetails -> Id -> TailCallInfo +lookupTailCallInfo uds id + | UD { ud_z_tail = z_tail, ud_env = env } <- uds + , not (id `elemVarEnv` z_tail) + , Just occ <- lookupVarEnv env id + = localTailCallInfo occ + | otherwise + = NoTailCallInfo udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds -udFreeVars bndrs ud = restrictFreeVars bndrs (ud_env ud) +udFreeVars bndrs (UD { ud_env = env }) = restrictFreeVars bndrs env restrictFreeVars :: VarSet -> OccInfoEnv -> VarSet restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs @@ -3234,66 +3646,96 @@ restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs ------------------- -- Auxiliary functions for UsageDetails implementation -combineUsageDetailsWith :: (OccInfo -> OccInfo -> OccInfo) +combineUsageDetailsWith :: (LocalOcc -> LocalOcc -> LocalOcc) -> UsageDetails -> UsageDetails -> UsageDetails -combineUsageDetailsWith plus_occ_info ud1 ud2 - | isEmptyDetails ud1 = ud2 - | isEmptyDetails ud2 = ud1 +{-# INLINE combineUsageDetailsWith #-} +combineUsageDetailsWith plus_occ_info + uds1@(UD { ud_env = env1, ud_z_many = z_many1, ud_z_in_lam = z_in_lam1, ud_z_tail = z_tail1 }) + uds2@(UD { ud_env = env2, ud_z_many = z_many2, ud_z_in_lam = z_in_lam2, ud_z_tail = z_tail2 }) + | isEmptyVarEnv env1 = uds2 + | isEmptyVarEnv env2 = uds1 | otherwise - = UD { ud_env = plusVarEnv_C plus_occ_info (ud_env ud1) (ud_env ud2) - , ud_z_many = plusVarEnv (ud_z_many ud1) (ud_z_many ud2) - , ud_z_in_lam = plusVarEnv (ud_z_in_lam ud1) (ud_z_in_lam ud2) - , ud_z_no_tail = plusVarEnv (ud_z_no_tail ud1) (ud_z_no_tail ud2) } - -doZapping :: UsageDetails -> Var -> OccInfo -> OccInfo -doZapping ud var occ - = doZappingByUnique ud (varUnique var) occ - -doZappingByUnique :: UsageDetails -> Unique -> OccInfo -> OccInfo -doZappingByUnique (UD { ud_z_many = many - , ud_z_in_lam = in_lam - , ud_z_no_tail = no_tail }) - uniq occ - = occ2 + = UD { ud_env = plusVarEnv_C plus_occ_info env1 env2 + , ud_z_many = plusVarEnv z_many1 z_many2 + , ud_z_in_lam = plusVarEnv z_in_lam1 z_in_lam2 + , ud_z_tail = plusVarEnv z_tail1 z_tail2 } + +lookupLetOccInfo :: UsageDetails -> Id -> OccInfo +-- Don't use locally-generated occ_info for exported (visible-elsewhere) +-- things. Instead just give noOccInfo. +-- NB: setBinderOcc will (rightly) erase any LoopBreaker info; +-- we are about to re-generate it and it shouldn't be "sticky" +lookupLetOccInfo ud id + | isExportedId id = noOccInfo + | otherwise = lookupOccInfoByUnique ud (idUnique id) + +lookupOccInfo :: UsageDetails -> Id -> OccInfo +lookupOccInfo ud id = lookupOccInfoByUnique ud (idUnique id) + +lookupOccInfoByUnique :: UsageDetails -> Unique -> OccInfo +lookupOccInfoByUnique (UD { ud_env = env + , ud_z_many = z_many + , ud_z_in_lam = z_in_lam + , ud_z_tail = z_tail }) + uniq + = case lookupVarEnv_Directly env uniq of + Nothing -> IAmDead + Just (OneOccL { lo_n_br = n_br, lo_int_cxt = int_cxt + , lo_tail = tail_info }) + | uniq `elemVarEnvByKey`z_many + -> ManyOccs { occ_tail = mk_tail_info tail_info } + | otherwise + -> OneOcc { occ_in_lam = in_lam + , occ_n_br = n_br + , occ_int_cxt = int_cxt + , occ_tail = mk_tail_info tail_info } + where + in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam + | otherwise = NotInsideLam + + Just (ManyOccL tail_info) -> ManyOccs { occ_tail = mk_tail_info tail_info } where - occ1 | uniq `elemVarEnvByKey` many = markMany occ - | uniq `elemVarEnvByKey` in_lam = markInsideLam occ - | otherwise = occ - occ2 | uniq `elemVarEnvByKey` no_tail = markNonTail occ1 - | otherwise = occ1 - -alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails -alterUsageDetails !ud f - = UD { ud_env = f (ud_env ud) - , ud_z_many = f (ud_z_many ud) - , ud_z_in_lam = f (ud_z_in_lam ud) - , ud_z_no_tail = f (ud_z_no_tail ud) } - -flattenUsageDetails :: UsageDetails -> UsageDetails -flattenUsageDetails ud@(UD { ud_env = env }) - = UD { ud_env = mapUFM_Directly (doZappingByUnique ud) env - , ud_z_many = emptyVarEnv - , ud_z_in_lam = emptyVarEnv - , ud_z_no_tail = emptyVarEnv } + mk_tail_info ti + | uniq `elemVarEnvByKey` z_tail = NoTailCallInfo + | otherwise = ti + + ------------------- -- See Note [Adjusting right-hand sides] + +adjustNonRecRhs :: Maybe JoinArity + -> WithTailUsageDetails CoreExpr + -> WithUsageDetails CoreExpr +-- ^ This function concentrates shared logic between occAnalNonRecBind and the +-- AcyclicSCC case of occAnalRec. +-- * It applies 'markNonRecJoinOneShots' to the RHS +-- * and returns the adjusted rhs UsageDetails combined with the body usage +adjustNonRecRhs mb_join_arity rhs_wuds@(WTUD _ rhs) + = WUD rhs_uds' rhs' + where + --------- Marking (non-rec) join binders one-shot --------- + !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs + | otherwise = rhs + + --------- Adjusting right-hand side usage --------- + rhs_uds' = adjustTailUsage mb_join_arity rhs_wuds + adjustTailUsage :: Maybe JoinArity - -> CoreExpr -- Rhs, AFTER occAnalLamTail - -> TailUsageDetails -- From body of lambda - -> UsageDetails -adjustTailUsage mb_join_arity rhs (TUD rhs_ja usage) + -> WithTailUsageDetails CoreExpr -- Rhs usage, AFTER occAnalLamTail + -> UsageDetails +adjustTailUsage mb_join_arity (WTUD (TUD rhs_ja uds) rhs) = -- c.f. occAnal (Lam {}) markAllInsideLamIf (not one_shot) $ markAllNonTailIf (not exact_join) $ - usage + uds where one_shot = isOneShotFun rhs exact_join = mb_join_arity == Just rhs_ja adjustTailArity :: Maybe JoinArity -> TailUsageDetails -> UsageDetails -adjustTailArity mb_rhs_ja (TUD ud_ja usage) = - markAllNonTailIf (mb_rhs_ja /= Just ud_ja) usage +adjustTailArity mb_rhs_ja (TUD ja usage) + = markAllNonTailIf (mb_rhs_ja /= Just ja) usage markNonRecJoinOneShots :: JoinArity -> CoreExpr -> CoreExpr -- For a /non-recursive/ join point we can mark all @@ -3324,52 +3766,38 @@ markNonRecUnfoldingOneShots mb_join_arity unf type IdWithOccInfo = Id -tagLamBinders :: UsageDetails -- Of scope - -> [Id] -- Binders - -> (UsageDetails, -- Details with binders removed - [IdWithOccInfo]) -- Tagged binders +tagLamBinders :: UsageDetails -- Of scope + -> [Id] -- Binders + -> [IdWithOccInfo] -- Tagged binders tagLamBinders usage binders - = usage' `seq` (usage', bndrs') - where - (usage', bndrs') = mapAccumR tagLamBinder usage binders + = map (tagLamBinder usage) binders tagLamBinder :: UsageDetails -- Of scope -> Id -- Binder - -> (UsageDetails, -- Details with binder removed - IdWithOccInfo) -- Tagged binders + -> IdWithOccInfo -- Tagged binders -- Used for lambda and case binders --- It copes with the fact that lambda bindings can have a --- stable unfolding, used for join points +-- No-op on TyVars +-- A lambda binder never has an unfolding, so no need to look for that tagLamBinder usage bndr - = (usage2, bndr') + = setBinderOcc (markNonTail occ) bndr + -- markNonTail: don't try to make an argument into a join point where - occ = lookupDetails usage bndr - bndr' = setBinderOcc (markNonTail occ) bndr - -- Don't try to make an argument into a join point - usage1 = usage `delDetails` bndr - usage2 | isId bndr = addManyOccs usage1 (idUnfoldingVars bndr) - -- This is effectively the RHS of a - -- non-join-point binding, so it's okay to use - -- addManyOccsSet, which assumes no tail calls - | otherwise = usage1 + occ = lookupOccInfo usage bndr tagNonRecBinder :: TopLevelFlag -- At top level? - -> UsageDetails -- Of scope + -> OccInfo -- Of scope -> CoreBndr -- Binder - -> WithUsageDetails -- Details with binder removed - IdWithOccInfo -- Tagged binder - -tagNonRecBinder lvl usage binder - = let - occ = lookupDetails usage binder - will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) - occ' | will_be_join = -- must already be marked AlwaysTailCalled - assert (isAlwaysTailCalled occ) occ - | otherwise = markNonTail occ - binder' = setBinderOcc occ' binder - usage' = usage `delDetails` binder - in - WithUsageDetails usage' binder' + -> IdWithOccInfo -- Tagged binder +-- No-op on TyVars +-- Precondition: OccInfo is not IAmDead +tagNonRecBinder lvl occ bndr + = setBinderOcc occ' bndr + where + will_be_join = okForJoinPoint lvl bndr (tailCallInfo occ) + occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless + -- it was a join point before but is now dead + warnPprTrace (not (isAlwaysTailCalled occ)) "tagNonRecBinder" (ppr bndr <+> ppr occ) occ + | otherwise = markNonTail occ tagRecBinders :: TopLevelFlag -- At top level? -> UsageDetails -- Of body of let ONLY @@ -3381,18 +3809,17 @@ tagRecBinders :: TopLevelFlag -- At top level? -- details *before* tagging binders (because the tags depend on the RHSes). tagRecBinders lvl body_uds details_s = let - bndrs = map nd_bndr details_s + bndrs = map nd_bndr details_s -- 1. See Note [Join arity prediction based on joinRhsArity] -- Determine possible join-point-hood of whole group, by testing for -- manifest join arity M. -- This (re-)asserts that makeNode had made tuds for that same arity M! - unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s - test_manifest_arity ND{nd_rhs=WithTailUsageDetails tuds rhs} + unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s + test_manifest_arity ND{nd_rhs = WTUD tuds rhs} = adjustTailArity (Just (joinRhsArity rhs)) tuds - bndr_ne = expectNonEmpty "List of binders is never empty" bndrs - will_be_joins = decideJoinPointHood lvl unadj_uds bndr_ne + will_be_joins = decideRecJoinPointHood lvl unadj_uds bndrs mb_join_arity :: Id -> Maybe JoinArity -- mb_join_arity: See Note [Join arity prediction based on joinRhsArity] @@ -3401,42 +3828,33 @@ tagRecBinders lvl body_uds details_s -- Can't use willBeJoinId_maybe here because we haven't tagged -- the binder yet (the tag depends on these adjustments!) | will_be_joins - , let occ = lookupDetails unadj_uds bndr - , AlwaysTailCalled arity <- tailCallInfo occ + , AlwaysTailCalled arity <- lookupTailCallInfo unadj_uds bndr = Just arity | otherwise = assert (not will_be_joins) -- Should be AlwaysTailCalled if - Nothing -- we are making join points! + Nothing -- we are making join points! -- 2. Adjust usage details of each RHS, taking into account the -- join-point-hood decision - rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs rhs_tuds -- matching occAnalLamTail in makeNode - | ND { nd_bndr = bndr, nd_rhs = WithTailUsageDetails rhs_tuds rhs } - <- details_s ] + rhs_udss' = [ adjustTailUsage (mb_join_arity bndr) rhs_wuds + -- Matching occAnalLamTail in makeNode + | ND { nd_bndr = bndr, nd_rhs = rhs_wuds } <- details_s ] -- 3. Compute final usage details from adjusted RHS details - adj_uds = foldr andUDs body_uds rhs_udss' + adj_uds = foldr andUDs body_uds rhs_udss' -- 4. Tag each binder with its adjusted details - bndrs' = [ setBinderOcc (lookupDetails adj_uds bndr) bndr + bndrs' = [ setBinderOcc (lookupLetOccInfo adj_uds bndr) bndr | bndr <- bndrs ] - -- 5. Drop the binders from the adjusted details and return - usage' = adj_uds `delDetailsList` bndrs in - WithUsageDetails usage' bndrs' + WUD adj_uds bndrs' setBinderOcc :: OccInfo -> CoreBndr -> CoreBndr setBinderOcc occ_info bndr - | isTyVar bndr = bndr - | isExportedId bndr = if isManyOccs (idOccInfo bndr) - then bndr - else setIdOccInfo bndr noOccInfo - -- Don't use local usage info for visible-elsewhere things - -- BUT *do* erase any IAmALoopBreaker annotation, because we're - -- about to re-generate it and it shouldn't be "sticky" - - | otherwise = setIdOccInfo bndr occ_info + | isTyVar bndr = bndr + | occ_info == idOccInfo bndr = bndr + | otherwise = setIdOccInfo bndr occ_info -- | Decide whether some bindings should be made into join points or not, based -- on its occurrences. This is @@ -3450,41 +3868,47 @@ setBinderOcc occ_info bndr -- 'f' tail-calls 'g'. -- -- See Note [Invariants on join points] in "GHC.Core". -decideJoinPointHood :: TopLevelFlag -> UsageDetails - -> NonEmpty CoreBndr - -> Bool -decideJoinPointHood TopLevel _ _ - = False -decideJoinPointHood NotTopLevel usage bndrs - | isJoinId (NE.head bndrs) - = warnPprTrace (not all_ok) - "OccurAnal failed to rediscover join point(s)" (ppr bndrs) - all_ok - | otherwise - = all_ok +decideRecJoinPointHood :: TopLevelFlag -> UsageDetails + -> [CoreBndr] -> Bool +decideRecJoinPointHood lvl usage bndrs + = all ok bndrs -- Invariant 3: Either all are join points or none are where + ok bndr = okForJoinPoint lvl bndr (lookupTailCallInfo usage bndr) + +okForJoinPoint :: TopLevelFlag -> Id -> TailCallInfo -> Bool -- See Note [Invariants on join points]; invariants cited by number below. -- Invariant 2 is always satisfiable by the simplifier by eta expansion. - all_ok = -- Invariant 3: Either all are join points or none are - all ok bndrs - - ok bndr - | -- Invariant 1: Only tail calls, all same join arity - AlwaysTailCalled arity <- tailCallInfo (lookupDetails usage bndr) +okForJoinPoint lvl bndr tail_call_info + | isJoinId bndr -- A current join point should still be one! + = warnPprTrace lost_join "Lost join point" lost_join_doc $ + True + | valid_join + = True + | otherwise + = False + where + valid_join | NotTopLevel <- lvl + , AlwaysTailCalled arity <- tail_call_info - , -- Invariant 1 as applied to LHSes of rules - all (ok_rule arity) (idCoreRules bndr) + , -- Invariant 1 as applied to LHSes of rules + all (ok_rule arity) (idCoreRules bndr) - -- Invariant 2a: stable unfoldings - -- See Note [Join points and INLINE pragmas] - , ok_unfolding arity (realIdUnfolding bndr) + -- Invariant 2a: stable unfoldings + -- See Note [Join points and INLINE pragmas] + , ok_unfolding arity (realIdUnfolding bndr) - -- Invariant 4: Satisfies polymorphism rule - , isValidJoinPointType arity (idType bndr) - = True + -- Invariant 4: Satisfies polymorphism rule + , isValidJoinPointType arity (idType bndr) + = True + | otherwise + = False - | otherwise - = False + lost_join | Just ja <- isJoinId_maybe bndr + = not valid_join || + (case tail_call_info of -- Valid join but arity differs + AlwaysTailCalled ja' -> ja /= ja' + _ -> False) + | otherwise = False ok_rule _ BuiltinRule{} = False -- only possible with plugin shenanigans ok_rule join_arity (Rule { ru_args = args }) @@ -3500,6 +3924,16 @@ decideJoinPointHood NotTopLevel usage bndrs ok_unfolding _ _ = True + lost_join_doc + = vcat [ text "bndr:" <+> ppr bndr + , text "tc:" <+> ppr tail_call_info + , text "rules:" <+> ppr (idCoreRules bndr) + , case tail_call_info of + AlwaysTailCalled arity -> + vcat [ text "ok_unf:" <+> ppr (ok_unfolding arity (realIdUnfolding bndr)) + , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr)) ] + _ -> empty ] + willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity willBeJoinId_maybe bndr | isId bndr @@ -3546,44 +3980,25 @@ See Invariant 2a of Note [Invariants on join points] in GHC.Core ************************************************************************ -} -markMany, markInsideLam, markNonTail :: OccInfo -> OccInfo - -markMany IAmDead = IAmDead -markMany occ = ManyOccs { occ_tail = occ_tail occ } - -markInsideLam occ@(OneOcc {}) = occ { occ_in_lam = IsInsideLam } -markInsideLam occ = occ - +markNonTail :: OccInfo -> OccInfo markNonTail IAmDead = IAmDead markNonTail occ = occ { occ_tail = NoTailCallInfo } -addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo - -addOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } - -- Both branches are at least One - -- (Argument is never IAmDead) +andLocalOcc :: LocalOcc -> LocalOcc -> LocalOcc +andLocalOcc occ1 occ2 = ManyOccL (tci1 `andTailCallInfo` tci2) + where + !tci1 = localTailCallInfo occ1 + !tci2 = localTailCallInfo occ2 --- (orOccInfo orig new) is used +orLocalOcc :: LocalOcc -> LocalOcc -> LocalOcc +-- (orLocalOcc occ1 occ2) is used -- when combining occurrence info from branches of a case - -orOccInfo (OneOcc { occ_in_lam = in_lam1 - , occ_n_br = nbr1 - , occ_int_cxt = int_cxt1 - , occ_tail = tail1 }) - (OneOcc { occ_in_lam = in_lam2 - , occ_n_br = nbr2 - , occ_int_cxt = int_cxt2 - , occ_tail = tail2 }) - = OneOcc { occ_n_br = nbr1 + nbr2 - , occ_in_lam = in_lam1 `mappend` in_lam2 - , occ_int_cxt = int_cxt1 `mappend` int_cxt2 - , occ_tail = tail1 `andTailCallInfo` tail2 } - -orOccInfo a1 a2 = assert (not (isDeadOcc a1 || isDeadOcc a2)) $ - ManyOccs { occ_tail = tailCallInfo a1 `andTailCallInfo` - tailCallInfo a2 } +orLocalOcc (OneOccL { lo_n_br = nbr1, lo_int_cxt = int_cxt1, lo_tail = tci1 }) + (OneOccL { lo_n_br = nbr2, lo_int_cxt = int_cxt2, lo_tail = tci2 }) + = OneOccL { lo_n_br = nbr1 + nbr2 + , lo_int_cxt = int_cxt1 `mappend` int_cxt2 + , lo_tail = tci1 `andTailCallInfo` tci2 } +orLocalOcc occ1 occ2 = andLocalOcc occ1 occ2 andTailCallInfo :: TailCallInfo -> TailCallInfo -> TailCallInfo andTailCallInfo info@(AlwaysTailCalled arity1) (AlwaysTailCalled arity2) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -443,23 +443,39 @@ emptyRuleEnv = RuleEnv { re_local_rules = emptyNameEnv getRules :: RuleEnv -> Id -> [CoreRule] -- Given a RuleEnv and an Id, find the visible rules for that Id -- See Note [Where rules are found] -getRules (RuleEnv { re_local_rules = local_rules - , re_home_rules = home_rules - , re_eps_rules = eps_rules +-- +-- This function is quite heavily used, so it's worth trying to make it efficient +getRules (RuleEnv { re_local_rules = local_rule_base + , re_home_rules = home_rule_base + , re_eps_rules = eps_rule_base , re_visible_orphs = orphs }) fn | Just {} <- isDataConId_maybe fn -- Short cut for data constructor workers = [] -- and wrappers, which never have any rules - | otherwise - = idCoreRules fn ++ - get local_rules ++ - find_visible home_rules ++ - find_visible eps_rules + | Just export_flag <- isLocalId_maybe fn + = -- LocalIds can't have rules in the local_rule_base (used for imported fns) + -- nor external packages; but there can (just) be rules in another module + -- in the home package, if it is exported + case export_flag of + NotExported -> idCoreRules fn + Exported -> case get home_rule_base of + [] -> idCoreRules fn + home_rules -> drop_orphs home_rules ++ idCoreRules fn + | otherwise + = -- This case expression is a fast path, to avoid calling the + -- recursive (++) in the common case where there are no rules at all + case (get local_rule_base, get home_rule_base, get eps_rule_base) of + ([], [], []) -> idCoreRules fn + (local_rules, home_rules, eps_rules) -> local_rules ++ + drop_orphs home_rules ++ + drop_orphs eps_rules ++ + idCoreRules fn where fn_name = idName fn - find_visible rb = filter (ruleIsVisible orphs) (get rb) + drop_orphs [] = [] -- Fast path; avoid invoking recursive filter + drop_orphs xs = filter (ruleIsVisible orphs) xs get rb = lookupNameEnv rb fn_name `orElse` [] ruleIsVisible :: ModuleSet -> CoreRule -> Bool ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -263,7 +263,6 @@ simple_opt_expr env expr go lam@(Lam {}) = go_lam env [] lam go (Case e b ty as) - -- See Note [Getting the map/coerce RULE to work] | isDeadBinder b , Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e' -- We don't need to be concerned about floats when looking for coerce. ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -180,24 +180,6 @@ instance Outputable CallCtxt where ppr RuleArgCtxt = text "RuleArgCtxt" {- -Note [Occurrence analysis of unfoldings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We do occurrence-analysis of unfoldings once and for all, when the -unfolding is built, rather than each time we inline them. - -But given this decision it's vital that we do -*always* do it. Consider this unfolding - \x -> letrec { f = ...g...; g* = f } in body -where g* is (for some strange reason) the loop breaker. If we don't -occ-anal it when reading it in, we won't mark g as a loop breaker, and -we may inline g entirely in body, dropping its binding, and leaving -the occurrence in f out of scope. This happened in #8892, where -the unfolding in question was a DFun unfolding. - -But more generally, the simplifier is designed on the -basis that it is looking at occurrence-analysed expressions, so better -ensure that they actually are. - Note [Calculate unfolding guidance on the non-occ-anal'd expression] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Notice that we give the non-occur-analysed expression to ===================================== compiler/GHC/Core/Unfold/Make.hs ===================================== @@ -86,7 +86,7 @@ mkDFunUnfolding bndrs con ops = DFunUnfolding { df_bndrs = bndrs , df_con = con , df_args = map occurAnalyseExpr ops } - -- See Note [Occurrence analysis of unfoldings] + -- See Note [OccInfo in unfoldings and rules] in GHC.Core mkDataConUnfolding :: CoreExpr -> Unfolding -- Used for non-newtype data constructors with non-trivial wrappers @@ -338,7 +338,7 @@ mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr mkCoreUnfolding src top_lvl expr precomputed_cache guidance = CoreUnfolding { uf_tmpl = cache `seq` occurAnalyseExpr expr - -- occAnalyseExpr: see Note [Occurrence analysis of unfoldings] + -- occAnalyseExpr: see Note [OccInfo in unfoldings and rules] in GHC.Core -- See #20905 for what a discussion of this 'seq'. -- We are careful to make sure we only -- have one copy of an unfolding around at once. @@ -459,7 +459,7 @@ With that in mind we want to maintain the invariant that each unfolding only ref a single CoreExpr. One place where we have to be careful is in mkCoreUnfolding. * The template of the unfolding is the result of performing occurrence analysis - (Note [Occurrence analysis of unfoldings]) + (Note [OccInfo in unfoldings and rules] in GHC.Core) * Predicates are applied to the unanalysed expression Therefore if we are not thoughtful about forcing you can end up in a situation where the ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -1008,14 +1008,23 @@ of the type of the method signature. * * ************************************************************************ -This data type is used exclusively by the simplifier, but it appears in a +Note [OccInfo] +~~~~~~~~~~~~~ +The OccInfo data type is used exclusively by the simplifier, but it appears in a SubstResult, which is currently defined in GHC.Types.Var.Env, which is pretty near the base of the module hierarchy. So it seemed simpler to put the defn of -OccInfo here, safely at the bottom +OccInfo here, safely at the bottom. + +Note that `OneOcc` doesn't meant that it occurs /syntactially/ only once; it +means that it is /used/ only once. It might occur syntactically many times. +For example, in (case x of A -> y; B -> y; C -> True), +* `y` is used only once +* but it occurs syntactically twice + -} -- | identifier Occurrence Information -data OccInfo +data OccInfo -- See Note [OccInfo] = ManyOccs { occ_tail :: !TailCallInfo } -- ^ There are many occurrences, or unknown occurrences @@ -1113,8 +1122,9 @@ instance Monoid InsideLam where mappend = (Semi.<>) ----------------- -data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo] - | NoTailCallInfo +data TailCallInfo + = AlwaysTailCalled {-# UNPACK #-} !JoinArity -- See Note [TailCallInfo] + | NoTailCallInfo deriving (Eq) tailCallInfo :: OccInfo -> TailCallInfo ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Types.Var ( -- ** Predicates isId, isTyVar, isTcTyVar, - isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar, + isLocalVar, isLocalId, isLocalId_maybe, isCoVar, isNonCoVarId, isTyCoVar, isGlobalId, isExportedId, mustHaveLocalBinding, @@ -95,6 +95,9 @@ module GHC.Types.Var ( tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders, mapVarBndr, mapVarBndrs, + -- ** ExportFlag + ExportFlag(..), + -- ** Constructing TyVar's mkTyVar, mkTcTyVar, @@ -1246,6 +1249,10 @@ isLocalId :: Var -> Bool isLocalId (Id { idScope = LocalId _ }) = True isLocalId _ = False +isLocalId_maybe :: Var -> Maybe ExportFlag +isLocalId_maybe (Id { idScope = LocalId ef }) = Just ef +isLocalId_maybe _ = Nothing + -- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's -- These are the variables that we need to pay attention to when finding free -- variables, or doing dependency analysis. ===================================== testsuite/tests/simplCore/should_compile/T22404.hs ===================================== @@ -0,0 +1,28 @@ +module T22404 where + +{-# NOINLINE foo #-} +foo :: [a] -> (a,a) +foo [x,y] = (x,y) +foo (x:xs) = foo xs + +data T = A | B | C | D + +-- The point of this test is that 'v' ought +-- not to be a thunk in the optimised program +-- It is used only once in each branch. But we +-- need a clever occurrence analyser to spot it; +-- see Note [Occurrence analysis for join points] +-- in GHC.Core.Opt.OccurAnoa + +f x xs = let v = foo xs in + + let {-# NOINLINE j #-} + j True = case v of (a,b) -> a + j False = case v of (a,b) -> b + in + + case x of + A -> j True + B -> j False + C -> case v of (a,b) -> b + D -> x ===================================== testsuite/tests/simplCore/should_compile/T22404.stderr ===================================== ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -492,3 +492,6 @@ test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], m test('T23074', normal, compile, ['-O -ddump-rules']) test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) test('T23567', [extra_files(['T23567A.hs'])], multimod_compile, ['T23567', '-O -v0']) + +# The -ddump-simpl of T22404 should have no let-bindings +test('T22404', [only_ways(['optasm']), check_errmsg(r'let') ], compile, ['-ddump-simpl -dsuppress-uniques']) ===================================== testsuite/tests/stranal/should_compile/T21128.stderr ===================================== @@ -1,133 +0,0 @@ - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 137, types: 92, coercions: 4, joins: 0/0} - -lvl = "error"# - -lvl1 = unpackCString# lvl - -$trModule4 = "main"# - -lvl2 = unpackCString# $trModule4 - -$trModule2 = "T21128a"# - -lvl3 = unpackCString# $trModule2 - -lvl4 = "./T21128a.hs"# - -lvl5 = unpackCString# lvl4 - -lvl6 = I# 4# - -lvl7 = I# 20# - -lvl8 = I# 25# - -lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8 - -lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack - -$windexError - = \ @a @b ww eta eta1 eta2 -> - error - (lvl10 `cast` :: CallStack ~R# (?callStack::CallStack)) - (++ (ww eta) (++ (ww eta1) (ww eta2))) - -indexError - = \ @a @b $dShow eta eta1 eta2 -> - case $dShow of { C:Show ww ww1 ww2 -> - $windexError ww1 eta eta1 eta2 - } - -$trModule3 = TrNameS $trModule4 - -$trModule1 = TrNameS $trModule2 - -$trModule = Module $trModule3 $trModule1 - -$wlvl - = \ ww ww1 ww2 -> - $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww) - -index - = \ l u i -> - case l of { I# x -> - case i of { I# y -> - case <=# x y of { - __DEFAULT -> case u of { I# ww -> $wlvl y ww x }; - 1# -> - case u of { I# y1 -> - case <# y y1 of { - __DEFAULT -> $wlvl y y1 x; - 1# -> I# (-# y x) - } - } - } - } - } - - - - -==================== Tidy Core ==================== -Result size of Tidy Core - = {terms: 108, types: 47, coercions: 0, joins: 3/4} - -$trModule4 = "main"# - -$trModule3 = TrNameS $trModule4 - -$trModule2 = "T21128"# - -$trModule1 = TrNameS $trModule2 - -$trModule = Module $trModule3 $trModule1 - -i = I# 1# - -l = I# 0# - -lvl = \ y -> $windexError $fShowInt_$cshow l y l - -lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i - -$wtheresCrud - = \ ww ww1 -> - let { y = I# ww1 } in - join { - lvl2 - = case <=# ww 1# of { - __DEFAULT -> case lvl1 ww y of wild { }; - 1# -> - case <# 1# ww1 of { - __DEFAULT -> case lvl1 ww y of wild { }; - 1# -> -# 1# ww - } - } } in - join { - lvl3 - = case <# 0# ww1 of { - __DEFAULT -> case lvl y of wild { }; - 1# -> 0# - } } in - joinrec { - $wgo ww2 - = case ww2 of wild { - __DEFAULT -> jump $wgo (-# wild 1#); - 0# -> jump lvl3; - 1# -> jump lvl2 - }; } in - jump $wgo ww - -theresCrud - = \ x y -> - case x of { I# ww -> - case y of { I# ww1 -> - case $wtheresCrud ww ww1 of ww2 { __DEFAULT -> I# ww2 } - } - } - - - ===================================== testsuite/tests/stranal/should_compile/all.T ===================================== @@ -84,8 +84,11 @@ test('T20510', [ grep_errmsg(r'jump \$wgo') ], compile, ['-dsuppress-uniques -dd test('T20817', [ grep_errmsg(r'Str') ], compile, ['-dsuppress-uniques -ddump-stranal']) # T21150: Check that t{,1,2} haven't been inlined. test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques -ddump-exitify']) + # T21128: Check that y is not reboxed in $wtheresCrud +# If so, there should be no `let` for y test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl']) + test('T21265', normal, compile, ['']) test('EtaExpansion', normal, compile, ['']) test('T22039', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fd04560a00667d5af087ba2bfe21ac02186cfb6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fd04560a00667d5af087ba2bfe21ac02186cfb6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 15:19:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 27 Jul 2023 11:19:28 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 3 commits: gitlab-ci: Mark linker_unload_native as broken on Alpine Message-ID: <64c28b002474b_37b561ba06883941@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: a3756043 by Ben Gamari at 2023-07-24T11:37:25-04:00 gitlab-ci: Mark linker_unload_native as broken on Alpine Due to lack of dlinfo() support, which is necessary for sound unloading support. - - - - - 877ec97b by Ben Gamari at 2023-07-25T12:57:55-04:00 linker/PEi386: Don't sign-extend symbol section number Previously we incorrectly interpreted PE section numbers as signed values. However, this isn't the case; rather, it's an unsigned 16-bit number with a few special bit-patterns (0xffff and 0xfffe). This resulted in #22941 as the linker would conclude that the sections were invalid. Fixing this required quite a bit of refactoring. Closes #22941. - - - - - f2f16867 by Ben Gamari at 2023-07-27T10:20:03-04:00 ghc-prim: Bump version to 0.11 - - - - - 11 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - libraries/base/base.cabal - libraries/ghc-bignum/ghc-bignum.cabal - libraries/ghc-compact/ghc-compact.cabal - libraries/ghc-heap/ghc-heap.cabal.in - libraries/ghc-prim/ghc-prim.cabal - libraries/ghci/ghci.cabal.in - libraries/text - rts/linker/PEi386.c - rts/linker/PEi386.h Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -434,7 +434,8 @@ distroVariables Alpine = mconcat , "HADRIAN_ARGS" =: "--docs=no-sphinx" -- encoding004: due to lack of locale support -- T10458, ghcilink002: due to #17869 - , "BROKEN_TESTS" =: "encoding004 T10458" + -- linker_unload_native: due to lack of dlinfo() support + , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native" ] distroVariables Centos7 = mconcat [ "HADRIAN_ARGS" =: "--docs=no-sphinx" ===================================== .gitlab/jobs.yaml ===================================== @@ -598,7 +598,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -660,7 +660,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate", - "BROKEN_TESTS": "encoding004 T10458", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -722,7 +722,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", @@ -2536,7 +2536,7 @@ "variables": { "BIGNUM_BACKEND": "native", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2599,7 +2599,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+fully_static+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -2662,7 +2662,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+no_split_sections", - "BROKEN_TESTS": "encoding004 T10458", + "BROKEN_TESTS": "encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", @@ -3647,7 +3647,7 @@ "variables": { "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static", - "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458", + "BROKEN_TESTS": "ghcilink002 linker_unload_native encoding004 T10458 linker_unload_native", "BUILD_FLAVOUR": "validate+fully_static", "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", ===================================== libraries/base/base.cabal ===================================== @@ -86,7 +86,7 @@ Library build-depends: rts == 1.0.*, - ghc-prim >= 0.5.1.0 && < 0.11, + ghc-prim >= 0.5.1.0 && < 0.12, ghc-bignum >= 1.0 && < 2.0 exposed-modules: ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -77,7 +77,7 @@ library ForeignFunctionInterface build-depends: - ghc-prim >= 0.5.1.0 && < 0.11 + ghc-prim >= 0.5.1.0 && < 0.12 hs-source-dirs: src/ include-dirs: include/ ===================================== libraries/ghc-compact/ghc-compact.cabal ===================================== @@ -39,7 +39,7 @@ library UnboxedTuples CPP - build-depends: ghc-prim >= 0.5.3 && < 0.11, + build-depends: ghc-prim >= 0.5.3 && < 0.12, base >= 4.9.0 && < 4.20, bytestring >= 0.10.6.0 && <0.12 ghc-options: -Wall ===================================== libraries/ghc-heap/ghc-heap.cabal.in ===================================== @@ -23,7 +23,7 @@ library default-language: Haskell2010 build-depends: base >= 4.9.0 && < 5.0 - , ghc-prim > 0.2 && < 0.11 + , ghc-prim > 0.2 && < 0.12 , rts == 1.0.* , containers >= 0.6.2.1 && < 0.7 ===================================== libraries/ghc-prim/ghc-prim.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.2 name: ghc-prim -version: 0.10.0 +version: 0.11.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause license-file: LICENSE ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -76,7 +76,7 @@ library rts, array == 0.5.*, base >= 4.8 && < 4.20, - ghc-prim >= 0.5.0 && < 0.11, + ghc-prim >= 0.5.0 && < 0.12, binary == 0.8.*, bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit deaaef6216d3df524f8b998c54b317478094473c +Subproject commit fe14df3f578cd49cb72555f25c49843a8671dfd2 ===================================== rts/linker/PEi386.c ===================================== @@ -697,8 +697,16 @@ size_t getSymbolSize ( COFF_HEADER_INFO *info ) } } +// Constants which may be returned by getSymSectionNumber. +// See https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#section-number-values +#define PE_SECTION_UNDEFINED ((uint32_t) 0) +#define PE_SECTION_ABSOLUTE ((uint32_t) -1) +#define PE_SECTION_DEBUG ((uint32_t) -2) + +// Returns either PE_SECTION_{UNDEFINED,ABSOLUTE,DEBUG} or the (one-based) +// section number of the given symbol. __attribute__ ((always_inline)) inline -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) { ASSERT(info); ASSERT(sym); @@ -707,7 +715,13 @@ int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ) case COFF_ANON_BIG_OBJ: return sym->ex.SectionNumber; default: - return sym->og.SectionNumber; + // Take care to only sign-extend reserved values; see #22941. + switch (sym->og.SectionNumber) { + case IMAGE_SYM_UNDEFINED: return PE_SECTION_UNDEFINED; + case IMAGE_SYM_ABSOLUTE : return PE_SECTION_ABSOLUTE; + case IMAGE_SYM_DEBUG: return PE_SECTION_DEBUG; + default: return (uint16_t) sym->og.SectionNumber; + } } } @@ -1652,7 +1666,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) StgWord globalBssSize = 0; for (unsigned int i=0; i < info->numberOfSymbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - if (getSymSectionNumber (info, sym) == IMAGE_SYM_UNDEFINED + if (getSymSectionNumber (info, sym) == PE_SECTION_UNDEFINED && getSymValue (info, sym) > 0 && getSymStorageClass (info, sym) != IMAGE_SYM_CLASS_SECTION) { globalBssSize += getSymValue (info, sym); @@ -1685,21 +1699,39 @@ ocGetNames_PEi386 ( ObjectCode* oc ) for (unsigned int i = 0; i < (uint32_t)oc->n_symbols; i++) { COFF_symbol* sym = &oc->info->symbols[i]; - int32_t secNumber = getSymSectionNumber (info, sym); uint32_t symValue = getSymValue (info, sym); uint8_t symStorageClass = getSymStorageClass (info, sym); - SymbolAddr *addr = NULL; bool isWeak = false; SymbolName *sname = get_sym_name (getSymShortName (info, sym), oc); - Section *section = secNumber > 0 ? &oc->sections[secNumber-1] : NULL; + + uint32_t secNumber = getSymSectionNumber (info, sym); + Section *section; + switch (secNumber) { + case PE_SECTION_UNDEFINED: + // N.B. This may be a weak symbol + section = NULL; + break; + case PE_SECTION_ABSOLUTE: + IF_DEBUG(linker, debugBelch("symbol %s is ABSOLUTE, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + case PE_SECTION_DEBUG: + IF_DEBUG(linker, debugBelch("symbol %s is DEBUG, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); + continue; + default: + CHECK(secNumber < (uint32_t) oc->n_sections); + section = &oc->sections[secNumber-1]; + } SymType type; switch (getSymType(oc->info->ch_info, sym)) { case 0x00: type = SYM_TYPE_DATA; break; case 0x20: type = SYM_TYPE_CODE; break; default: - debugBelch("Invalid symbol type: 0x%x\n", getSymType(oc->info->ch_info, sym)); + debugBelch("Symbol %s has invalid type 0x%x\n", + sname, getSymType(oc->info->ch_info, sym)); return 1; } @@ -1730,8 +1762,18 @@ ocGetNames_PEi386 ( ObjectCode* oc ) CHECK(symValue == 0); COFF_symbol_aux_weak_external *aux = (COFF_symbol_aux_weak_external *) (sym+1); COFF_symbol* targetSym = &oc->info->symbols[aux->TagIndex]; - int32_t targetSecNumber = getSymSectionNumber (info, targetSym); - Section *targetSection = targetSecNumber > 0 ? &oc->sections[targetSecNumber-1] : NULL; + + uint32_t targetSecNumber = getSymSectionNumber (info, targetSym); + Section *targetSection; + switch (targetSecNumber) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + targetSection = NULL; + break; + default: + targetSection = &oc->sections[targetSecNumber-1]; + } addr = (SymbolAddr*) ((size_t) targetSection->start + getSymValue(info, targetSym)); } else if ( secNumber == IMAGE_SYM_UNDEFINED && symValue > 0) { @@ -1850,6 +1892,9 @@ ocGetNames_PEi386 ( ObjectCode* oc ) return false; break; + } else if (secNumber == PE_SECTION_UNDEFINED) { + IF_DEBUG(linker, debugBelch("symbol %s is UNDEFINED, skipping...\n", sname)); + i += getSymNumberOfAuxSymbols (info, sym); } if ((addr != NULL || isWeak) @@ -1976,7 +2021,19 @@ ocResolve_PEi386 ( ObjectCode* oc ) debugBelch("'\n" )); if (getSymStorageClass (info, sym) == IMAGE_SYM_CLASS_STATIC) { - Section section = oc->sections[getSymSectionNumber (info, sym)-1]; + uint32_t sect_n = getSymSectionNumber (info, sym); + switch (sect_n) { + case PE_SECTION_UNDEFINED: + case PE_SECTION_ABSOLUTE: + case PE_SECTION_DEBUG: + errorBelch(" | %" PATH_FMT ": symbol `%s' has invalid section number %02x", + oc->fileName, symbol, sect_n); + return false; + default: + break; + } + CHECK(sect_n < (uint32_t) oc->n_sections); + Section section = oc->sections[sect_n - 1]; S = ((size_t)(section.start)) + ((size_t)(getSymValue (info, sym))); } else { ===================================== rts/linker/PEi386.h ===================================== @@ -143,7 +143,7 @@ struct _Alignments { COFF_OBJ_TYPE getObjectType ( char* image, pathchar* fileName ); COFF_HEADER_INFO* getHeaderInfo ( ObjectCode* oc ); size_t getSymbolSize ( COFF_HEADER_INFO *info ); -int32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); +uint32_t getSymSectionNumber ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint32_t getSymValue ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymStorageClass ( COFF_HEADER_INFO *info, COFF_symbol* sym ); uint8_t getSymNumberOfAuxSymbols ( COFF_HEADER_INFO *info, COFF_symbol* sym ); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9ef5a44e54073854571a8b421e64e63706e4572...f2f16867e8912e52a0f3f5492c7f30eeb6d444b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9ef5a44e54073854571a8b421e64e63706e4572...f2f16867e8912e52a0f3f5492c7f30eeb6d444b5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 15:37:46 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 11:37:46 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] Fix plaform glob in FPTOOLS_SET_C_LD_FLAGS Message-ID: <64c28f4a16519_37b561b9fc884163@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: 37705321 by Matthew Pickering at 2023-07-27T16:32:30+01:00 Fix plaform glob in FPTOOLS_SET_C_LD_FLAGS [...] Content analysis details: (6.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4976] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Matthew Pickering (@mpickering)" Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] Fix plaform glob in FPTOOLS_SET_C_LD_FLAGS Date: Thu, 27 Jul 2023 11:37:46 -0400 Size: 16684 URL: From gitlab at gitlab.haskell.org Thu Jul 27 15:48:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 27 Jul 2023 11:48:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-haddock-opts Message-ID: <64c291c141662_37b561ba02c8482a@gitlab.mail> Ben Gamari pushed new branch wip/hadrian-haddock-opts at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-haddock-opts You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 15:48:19 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 27 Jul 2023 11:48:19 -0400 Subject: [Git][ghc/ghc][wip/hadrian-haddock-opts] 11 commits: Fix pretty printing of WARNING pragmas Message-ID: <64c291c3e53e7_37b561ba054850fa@gitlab.mail> Ben Gamari pushed to branch wip/hadrian-haddock-opts at Glasgow Haskell Compiler / GHC Commits: 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 6b06288b by Ben Gamari at 2023-07-27T11:48:14-04:00 hadrian: Allow haddock options to be passed via key-value settings - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/TyThing.hs - compiler/GHC/Unit/Module/Warnings.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1615a69d0a40f06d9c227eece8e2a2b42440e650...6b06288b565548ab306f255158fc7d84c2c526d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1615a69d0a40f06d9c227eece8e2a2b42440e650...6b06288b565548ab306f255158fc7d84c2c526d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 16:27:59 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Thu, 27 Jul 2023 12:27:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22935 Message-ID: <64c29b0f8d229_37b561ba040936a4@gitlab.mail> Matthew Craven pushed new branch wip/T22935 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22935 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 16:33:01 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Thu, 27 Jul 2023 12:33:01 -0400 Subject: [Git][ghc/ghc][wip/T22935] Make pseq robust by using seq# Message-ID: <64c29c3d51ccf_37b561ba01893893@gitlab.mail> Matthew Craven pushed to branch wip/T22935 at Glasgow Haskell Compiler / GHC Commits: 7d2e5b17 by Matthew Craven at 2023-07-27T12:31:51-04:00 Make pseq robust by using seq# Fixes #23699, fixes #23233. Note [seq# magic] is expanded, fixing #22935. The two tests for T15226 do not really test issue #15226; instead they check that we can unbox through seq# in some conditions. The way we previously achieved that for these two test cases is generally bogus; see the new wrinkle S6 in Note [seq# magic]. Safely unboxing through seq# is probably possible under the right conditions but deserves a new primop and is left as future work. Metric Increase: T15226 T15226a - - - - - 2 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - libraries/base/GHC/Conc/Sync.hs Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -823,7 +823,6 @@ primOpRules nm = \case AddrAddOp -> mkPrimOpRule nm 2 [ rightIdentityPlatform zeroi ] - SeqOp -> mkPrimOpRule nm 4 [ seqRule ] SparkOp -> mkPrimOpRule nm 4 [ sparkRule ] _ -> Nothing @@ -2080,36 +2079,86 @@ mechanism for 'evaluate' evaluate a = IO $ \s -> seq# a s The semantics of seq# is + * wait for all earlier actions in the State#-token-thread to complete * evaluate its first argument * and return it Things to note -* Why do we need a primop at all? That is, instead of - case seq# x s of (# x, s #) -> blah - why not instead say this? - case x of { DEFAULT -> blah) +S1. Why do we need a primop at all? That is, instead of + case seq# x s of (# x, s #) -> blah + why not instead say this? + case x of { DEFAULT -> blah) - Reason (see #5129): if we saw - catch# (\s -> case x of { DEFAULT -> raiseIO# exn s }) handler + Reason (see #5129): if we saw + catch# (\s -> case x of { DEFAULT -> raiseIO# exn s }) handler - then we'd drop the 'case x' because the body of the case is bottom - anyway. But we don't want to do that; the whole /point/ of - seq#/evaluate is to evaluate 'x' first in the IO monad. + then we'd drop the 'case x' because the body of the case is bottom + anyway. But we don't want to do that; the whole /point/ of + seq#/evaluate is to evaluate 'x' first in the IO monad. - In short, we /always/ evaluate the first argument and never - just discard it. + In short, we /always/ evaluate the first argument and never + just discard it. -* Why return the value? So that we can control sharing of seq'd - values: in - let x = e in x `seq` ... x ... - We don't want to inline x, so better to represent it as - let x = e in case seq# x RW of (# _, x' #) -> ... x' ... - also it matches the type of rseq in the Eval monad. +S2. Why return the value? So that we can control sharing of seq'd + values: in + let x = e in x `seq` ... x ... + We don't want to inline x, so better to represent it as + let x = e in case seq# x RW of (# _, x' #) -> ... x' ... + also it matches the type of rseq in the Eval monad. -Implementing seq#. The compiler has magic for SeqOp in +S3. seq# is also used to implement pseq#: + + pseq !x y = case seq# x realWorld# of + (# s, _ #) -> case seq# y s of + (# _, y' #) -> y' + + The state token threading between `seq# x realWorld#` and `seq# y s` + should ensure that `y` is not evaluated before `x`. Historically we + used instead ``pseq x y = x `seq` lazy y``, but this was not robust; + see #23233 and #23699. + +S4. We do not consider `seq# x s` to raise a precise exception even + when `x` certainly raises an exception; doing so would cause + `evaluate` and `pseq` to interfere with unrelated strictness properties. + +S5. Because seq# waits for all earlier actions in its + State#-token-thread to complete before evaluating its first + argument, it is (perhaps surprisingly) NOT unconditionally strict + in that first argument. Making it strict in its first argument + would semantically permit us to re-order the eval with respect to + earlier actions in the State#-token-thread, undermining the + utility of `evaluate` for sequencing evaluation with respect to + side-effects. + + A user who wants strictness can ask for it as easily as writing + `evaluate $! x` instead of `evaluate x`: + + * `evaluate x` means "evaluate `x` at exactly this moment" + * `evaluate $! x` means "evaluate `x` at this moment /or earlier/" + +S6. We used to rewrite `seq# x s` to `(# s, x #)` with the + reasoning that x has already been evaluated, so seq# has nothing + to do. But doing so defeats the ordering that seq# provides. + Consider this example: + + (start) + evaluate $! x + + (inline $! and evaluate) + case x of !x' -> IO $ \s -> seq# x' s -- GHC.Core.Opt.ConstantFold.seqRule: eliminate (seq# s) + (x' is whnf) + case x of !x' -> IO (\s -> (# s, x' #)) + + Note that this last expression is equivalent to `pure $! x`. Its + evaluation of `x` is completely untethered to the state thread of + any enclosing sequence of IO actions; as such the simplifier may + drop the eval entirely if `x` is used strictly later in the + sequence of IO actions. + + +Implementing seq#. The compiler has magic for SeqOp in - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq# @@ -2121,15 +2170,14 @@ Implementing seq#. The compiler has magic for SeqOp in in GHC.Core.Opt.Simplify -} -seqRule :: RuleM CoreExpr -seqRule = do - [Type _ty_a, Type _ty_s, a, s] <- getArgs - guard $ exprIsHNF a - return $ mkCoreUnboxedTuple [s, a] -- spark# :: forall a s . a -> State# s -> (# State# s, a #) sparkRule :: RuleM CoreExpr -sparkRule = seqRule -- reduce on HNF, just the same +sparkRule = do + [Type _ty_a, Type _ty_s, a, s] <- getArgs + guard $ exprIsHNF a + return $ mkCoreUnboxedTuple [s, a] + -- reduce on HNF -- XXX perhaps we shouldn't do this, because a spark eliminated by -- this rule won't be counted as a dud at runtime? ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -519,19 +519,21 @@ labelThreadByteArray# (ThreadId t) str = -- but 'seq' is now defined in GHC.Prim -- -- "pseq" is defined a bit weirdly (see below) --- --- The reason for the strange "lazy" call is that --- it fools the compiler into thinking that pseq and par are non-strict in --- their second argument (even if it inlines pseq at the call site). --- If it thinks pseq is strict in "y", then it often evaluates --- "y" before "x", which is totally wrong. - +-- The state token threading is meant to ensure that +-- we cannot move the eval of y before the eval of x {-# INLINE pseq #-} pseq :: a -> b -> b -pseq x y = x `seq` lazy y +pseq !x y = case seq# x realWorld# of + (# s, _ #) -> case seq# y s of + (# _, y' #) -> y' {-# INLINE par #-} par :: a -> b -> b +-- The reason for the strange "lazy" call is that +-- it fools the compiler into thinking that par are non-strict in +-- their second argument (even if it inlines par at the call site). +-- If it thinks par is strict in "y", then it often evaluates +-- "y" before "x", which is totally wrong. par x y = case (par# x) of { _ -> lazy y } -- | Internal function used by the RTS to run sparks. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d2e5b17f1467c3181a43b82af5165a8106a03a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d2e5b17f1467c3181a43b82af5165a8106a03a5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 17:19:30 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 13:19:30 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] ghc-toolchain: Pass ld-override onto ghc-toolchain Message-ID: <64c2a72223ecc_37b561ba06810137a@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: b6723702 by Matthew Pickering at 2023-07-27T18:19:18+01:00 ghc-toolchain: Pass ld-override onto ghc-toolchain - - - - - 2 changed files: - m4/find_ld.m4 - m4/ghc_toolchain.m4 Changes: ===================================== m4/find_ld.m4 ===================================== @@ -77,7 +77,7 @@ AC_DEFUN([FIND_LD],[ dnl dnl See #21712. AC_CHECK_TARGET_TOOL([LD], [ld]) - elif test "x$enable_ld_override" = "xyes"; then + elif test "x$enable_ld_override" = "xYES"; then find_ld else AC_CHECK_TARGET_TOOL([LD], [ld]) ===================================== m4/ghc_toolchain.m4 ===================================== @@ -12,8 +12,12 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], [ if test "$2" = "YES"; then echo "--enable-$1" >> acargs + elif test "$2" = "yes"; then + echo "--enable-$1" >> acargs elif test "$2" = "NO"; then echo "--disable-$1" >> acargs + elif test "$2" = "no"; then + echo "--disable-$1" >> acargs fi ]) @@ -23,6 +27,10 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_NOT_ARG], echo "--enable-$1" >> acargs elif test "$2" = "YES"; then echo "--disable-$1" >> acargs + elif test "$2" = "no"; then + echo "--enable-$1" >> acargs + elif test "$2" = "yes"; then + echo "--disable-$1" >> acargs fi ]) @@ -114,6 +122,7 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) ENABLE_GHC_TOOLCHAIN_ARG([libffi-adjustors], [$UseLibffiForAdjustors]) + ENABLE_GHC_TOOLCHAIN_ARG([ld-override], [$enable_ld_override]) dnl We store USER_* variants of all user-specified flags to pass them over to ghc-toolchain. ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$USER_CFLAGS]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b6723702acd2888e63763cce87ade2cbde775b6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b6723702acd2888e63763cce87ade2cbde775b6e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 17:40:33 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Thu, 27 Jul 2023 13:40:33 -0400 Subject: [Git][ghc/ghc][wip/T22935] add missing BangPatterns Message-ID: <64c2ac1117cdb_37b561b9ff010264f@gitlab.mail> Matthew Craven pushed to branch wip/T22935 at Glasgow Haskell Compiler / GHC Commits: fa90e728 by Matthew Craven at 2023-07-27T13:38:46-04:00 add missing BangPatterns - - - - - 1 changed file: - libraries/base/GHC/Conc/Sync.hs Changes: ===================================== libraries/base/GHC/Conc/Sync.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa90e728f461d552b82a054b29af5ae285f4fb8c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa90e728f461d552b82a054b29af5ae285f4fb8c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 17:42:55 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 27 Jul 2023 13:42:55 -0400 Subject: [Git][ghc/ghc][wip/ghc-toolchain-fixes] 2 commits: ghc-toolchain: Pass ld-override onto ghc-toolchain Message-ID: <64c2ac9f22d42_37b561b9ff010629@gitlab.mail> Matthew Pickering pushed to branch wip/ghc-toolchain-fixes at Glasgow Haskell Compiler / GHC Commits: 814f4c22 by Matthew Pickering at 2023-07-27T18:38:27+01:00 ghc-toolchain: Pass ld-override onto ghc-toolchain - - - - - f06e2993 by Matthew Pickering at 2023-07-27T18:42:31+01:00 ld override: Make whitelist override user given option - - - - - 2 changed files: - m4/ghc_toolchain.m4 - utils/ghc-toolchain/exe/Main.hs Changes: ===================================== m4/ghc_toolchain.m4 ===================================== @@ -12,8 +12,12 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], [ if test "$2" = "YES"; then echo "--enable-$1" >> acargs + elif test "$2" = "yes"; then + echo "--enable-$1" >> acargs elif test "$2" = "NO"; then echo "--disable-$1" >> acargs + elif test "$2" = "no"; then + echo "--disable-$1" >> acargs fi ]) @@ -23,6 +27,10 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_NOT_ARG], echo "--enable-$1" >> acargs elif test "$2" = "YES"; then echo "--disable-$1" >> acargs + elif test "$2" = "no"; then + echo "--enable-$1" >> acargs + elif test "$2" = "yes"; then + echo "--disable-$1" >> acargs fi ]) ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -329,7 +329,7 @@ mkTarget opts = do (archOs, tgtVendor) <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) - ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (fromMaybe (ldOverrideWhitelist archOs) (optLdOverride opts)) archOs cc readelf + ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (ldOverrideWhitelist archOs && fromMaybe True (optLdOverride opts)) archOs cc readelf ar <- findAr tgtVendor (optAr opts) -- TODO: We could have View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b6723702acd2888e63763cce87ade2cbde775b6e...f06e2993d54c67de0d1f011d54700703a32351ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b6723702acd2888e63763cce87ade2cbde775b6e...f06e2993d54c67de0d1f011d54700703a32351ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 17:43:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 27 Jul 2023 13:43:49 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] ghc-prim: Bump version to 0.11 Message-ID: <64c2acd5308c5_37b561b9ff010719@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 62cb821e by Ben Gamari at 2023-07-27T13:43:13-04:00 ghc-prim: Bump version to 0.11 - - - - - 9 changed files: - ghc/ghc-bin.cabal.in - libraries/base/base.cabal - libraries/ghc-bignum/ghc-bignum.cabal - libraries/ghc-compact/ghc-compact.cabal - libraries/ghc-heap/ghc-heap.cabal.in - libraries/ghc-prim/ghc-prim.cabal - libraries/ghci/ghci.cabal.in - libraries/text - testsuite/tests/backpack/should_compile/bkp16.stderr Changes: ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -57,7 +57,7 @@ Executable ghc -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: deepseq >= 1.4 && < 1.6, - ghc-prim >= 0.5.0 && < 0.11, + ghc-prim >= 0.5.0 && < 0.12, ghci == @ProjectVersionMunged@, haskeline == 0.8.*, exceptions == 0.10.*, ===================================== libraries/base/base.cabal ===================================== @@ -86,7 +86,7 @@ Library build-depends: rts == 1.0.*, - ghc-prim >= 0.5.1.0 && < 0.11, + ghc-prim >= 0.5.1.0 && < 0.12, ghc-bignum >= 1.0 && < 2.0 exposed-modules: ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -77,7 +77,7 @@ library ForeignFunctionInterface build-depends: - ghc-prim >= 0.5.1.0 && < 0.11 + ghc-prim >= 0.5.1.0 && < 0.12 hs-source-dirs: src/ include-dirs: include/ ===================================== libraries/ghc-compact/ghc-compact.cabal ===================================== @@ -39,7 +39,7 @@ library UnboxedTuples CPP - build-depends: ghc-prim >= 0.5.3 && < 0.11, + build-depends: ghc-prim >= 0.5.3 && < 0.12, base >= 4.9.0 && < 4.20, bytestring >= 0.10.6.0 && <0.12 ghc-options: -Wall ===================================== libraries/ghc-heap/ghc-heap.cabal.in ===================================== @@ -23,7 +23,7 @@ library default-language: Haskell2010 build-depends: base >= 4.9.0 && < 5.0 - , ghc-prim > 0.2 && < 0.11 + , ghc-prim > 0.2 && < 0.12 , rts == 1.0.* , containers >= 0.6.2.1 && < 0.7 ===================================== libraries/ghc-prim/ghc-prim.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.2 name: ghc-prim -version: 0.10.0 +version: 0.11.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause license-file: LICENSE ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -76,7 +76,7 @@ library rts, array == 0.5.*, base >= 4.8 && < 4.20, - ghc-prim >= 0.5.0 && < 0.11, + ghc-prim >= 0.5.0 && < 0.12, binary == 0.8.*, bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit deaaef6216d3df524f8b998c54b317478094473c +Subproject commit fe14df3f578cd49cb72555f25c49843a8671dfd2 ===================================== testsuite/tests/backpack/should_compile/bkp16.stderr ===================================== @@ -2,8 +2,8 @@ [1 of 1] Compiling Int[sig] ( p/Int.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[Int=base-4.17.0.0:GHC.Exts] - Instantiating p[Int=base-4.17.0.0:GHC.Exts] - [1 of 1] Including ghc-prim-0.10.0 + [1 of 1] Including p[Int=base-4.19.0.0:GHC.Exts] + Instantiating p[Int=base-4.19.0.0:GHC.Exts] + [1 of 1] Including ghc-prim-0.11.0 [1 of 1] Compiling Int[sig] ( p/Int.hsig, bkp16.out/p/p-97PZnzqiJmd2hTwUNGdjod/Int.o ) [1 of 1] Instantiating p View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62cb821ef2ef0d47c4cf88a6f2aeb7f75106d361 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62cb821ef2ef0d47c4cf88a6f2aeb7f75106d361 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 18:03:46 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 27 Jul 2023 14:03:46 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 22 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c2b1822512a_37b561ba06811246@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 26436b9d by Apoorv Ingle at 2023-07-27T12:50:56-05:00 Fixes #18324 #23147 #20020 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - make the ExpandedStmt generated expression location-less - Introduce ExpansionStmt for proper `hsSplitApps` - Introduce `VAExpansionStmt` that is just like `VAExpansion` but for statements - Aligning expand stmt context pushing on error stack. - Pop error context while checking do expansion generated GRHSs inside HsLam so that we do not print the previous statement error context - makes template haskell happy - some fix for let expansions - accepting new test output for some tests: Typeable1, hpc_fork, tough, tough2 etc. preserve the expansion stmts right until desugaring - - - - - 441547ab by Apoorv Ingle at 2023-07-27T12:51:01-05:00 some fixes after rebasing and doc changes - - - - - b4bc17b2 by Apoorv Ingle at 2023-07-27T12:51:30-05:00 Fixes #22788 #15598 #22086. Added testcases for each - - - - - 604f6ff9 by Apoorv Ingle at 2023-07-27T12:51:34-05:00 fix the body statement error context - - - - - 7f9a5dc2 by Apoorv Ingle at 2023-07-27T12:51:34-05:00 fix warnings for non-exhausitive patterns location blame and discarded values in do block statements - - - - - 4f3f00fd by Apoorv Ingle at 2023-07-27T12:52:09-05:00 fixing location infos for stmts and their expansions - - - - - 91a52e7f by Apoorv Ingle at 2023-07-27T12:52:12-05:00 new test outputs for T18324 and T22086 - - - - - c361c4db by Apoorv Ingle at 2023-07-27T12:52:12-05:00 get locations right for bind statement expressions - - - - - 159c24df by Apoorv Ingle at 2023-07-27T12:52:12-05:00 fixing DoExpanion2 test - - - - - b59d091f by Apoorv Ingle at 2023-07-27T12:52:12-05:00 some comments - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac4d0665fee2cee3108fcf1ef814c5631b67da35...b59d091f8e359643f69830f7348a20a2b46a69a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ac4d0665fee2cee3108fcf1ef814c5631b67da35...b59d091f8e359643f69830f7348a20a2b46a69a1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 18:12:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 27 Jul 2023 14:12:42 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Update Match Datatype Message-ID: <64c2b39ae9ba4_37b561ba01811443@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 31fcd2fa by David Knothe at 2023-07-27T14:12:27-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 750390d2 by David Binder at 2023-07-27T14:12:30-04:00 Improve documentation for Data.Fixed - - - - - be96d684 by Ben Gamari at 2023-07-27T14:12:30-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 8 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs - libraries/base/Data/Fixed.hs - libraries/ghc-prim/cbits/atomic.c Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -206,11 +206,8 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss -- ==> case rhs of C x# y# -> body do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas - ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } - ; var <- selectMatchVar ManyTy upat + ; let eqn = EqnMatch { eqn_pat = pat, eqn_rest = EqnDone (cantFailMatchResult body) } + ; var <- selectMatchVar ManyTy (unLoc pat) -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -29,8 +29,12 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated, requiresPMC ) +import GHC.Types.Basic ( Origin(..), requiresPMC ) import GHC.Types.SourceText + ( FractionalLit, + IntegralLit(il_value), + negateFractionalLit, + integralFractionalLit ) import GHC.Driver.DynFlags import GHC.Hs import GHC.Hs.Syn.Type @@ -193,13 +197,9 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineEqnRhss (NEL.fromList eqns) -match (v:vs) ty eqns -- Eqns *can* be empty +match (v:vs) ty eqns -- Eqns can be empty, but each equation is nonempty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ do { dflags <- getDynFlags ; let platform = targetPlatform dflags @@ -222,12 +222,11 @@ match (v:vs) ty eqns -- Eqns *can* be empty dropGroup :: Functor f => f (PatGroup,EquationInfo) -> f EquationInfo dropGroup = fmap snd - match_groups :: [NonEmpty (PatGroup,EquationInfo)] -> DsM (NonEmpty (MatchResult CoreExpr)) - -- Result list of [MatchResult CoreExpr] is always non-empty + match_groups :: [NonEmpty (PatGroup,EquationInfoNE)] -> DsM (NonEmpty (MatchResult CoreExpr)) match_groups [] = matchEmpty v ty match_groups (g:gs) = mapM match_group $ g :| gs - match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr) + match_group :: NonEmpty (PatGroup,EquationInfoNE) -> DsM (MatchResult CoreExpr) match_group eqns@((group,_) :| _) = case group of PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns']) @@ -267,20 +266,20 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] -matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns -matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchBangs (var :| vars) ty eqns = do { match_result <- match (var:vars) ty $ NEL.toList $ decomposeFirstPat getBangPat <$> eqns ; return (mkEvalMatchResult var ty match_result) } -matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Apply the coercion to the match variable and then match that -matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) +matchCoercion (var :| vars) ty eqns@(eqn1 :| _) = do { let XPat (CoPat co pat _) = firstPat eqn1 ; let pat_ty' = hsPatType pat ; var' <- newUniqueId var (idMult var) pat_ty' @@ -290,9 +289,9 @@ matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) { let bind = NonRec var' (core_wrap (Var var)) ; return (mkCoLetMatchResult bind match_result) } } -matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Apply the view function to the match variable and then match that -matchView (var :| vars) ty (eqns@(eqn1 :| _)) +matchView (var :| vars) ty eqns@(eqn1 :| _) = do { -- we could pass in the expr from the PgView, -- but this needs to extract the pat anyway -- to figure out the type of the fresh variable @@ -309,10 +308,9 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _)) match_result) } -- decompose the first pattern and leave the rest alone -decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} -decomposeFirstPat _ _ = panic "decomposeFirstPat" +decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfoNE -> EquationInfoNE +decomposeFirstPat extract eqn@(EqnMatch { eqn_pat = pat }) = eqn{eqn_pat = fmap extract pat} +decomposeFirstPat _ (EqnDone {}) = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc getCoPat (XPat (CoPat _ pat _)) = pat @@ -405,15 +403,14 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ eqn@(EqnDone {}) = return (idDsWrapper, eqn) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v eqn@(EqnMatch { eqn_pat = (L loc pat) }) = do + (wrap, pat') <- tidy1 v (not . isGoodSrcSpan . locA $ loc) pat + return (wrap, eqn{eqn_pat = L loc pat' }) tidy1 :: Id -- The Id being scrutinised - -> Origin -- Was this a pattern the user wrote? + -> Bool -- `True` if the pattern was generated, `False` if it was user-written -> Pat GhcTc -- The pattern against which it is to be matched -> DsM (DsWrapper, -- Extra bindings to do before the match Pat GhcTc) -- Equivalent pattern @@ -424,10 +421,10 @@ tidy1 :: Id -- The Id being scrutinised -- It eliminates many pattern forms (as-patterns, variable patterns, -- list patterns, etc) and returns any created bindings in the wrapper. -tidy1 v o (ParPat _ _ pat _) = tidy1 v o (unLoc pat) -tidy1 v o (SigPat _ pat _) = tidy1 v o (unLoc pat) +tidy1 v g (ParPat _ _ pat _) = tidy1 v g (unLoc pat) +tidy1 v g (SigPat _ pat _) = tidy1 v g (unLoc pat) tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty) -tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p +tidy1 v g (BangPat _ (L l p)) = tidy_bang_pat v g l p -- case v of { x -> mr[] } -- = case v of { _ -> let x=v in mr[] } @@ -436,8 +433,8 @@ tidy1 v _ (VarPat _ (L _ var)) -- case v of { x at p -> mr[] } -- = case v of { p -> let x=v in mr[] } -tidy1 v o (AsPat _ (L _ var) _ pat) - = do { (wrap, pat') <- tidy1 v o (unLoc pat) +tidy1 v g (AsPat _ (L _ var) _ pat) + = do { (wrap, pat') <- tidy1 v g (unLoc pat) ; return (wrapBind var v . wrap, pat') } {- now, here we handle lazy patterns: @@ -489,22 +486,22 @@ tidy1 _ _ (SumPat tys pat alt arity) -- See Note [Unboxed tuple RuntimeRep vars] in TyCon -- LitPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (LitPat _ lit) - = do { unless (isGenerated o) $ +tidy1 _ g (LitPat _ lit) + = do { unless g $ warnAboutOverflowedLit lit ; return (idDsWrapper, tidyLitPat lit) } -- NPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) - = do { unless (isGenerated o) $ +tidy1 _ g (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) + = do { unless g $ let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v } | otherwise = lit in warnAboutOverflowedOverLit lit' ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) } -- NPlusKPat: we may want to warn about the literals -tidy1 _ o n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) - = do { unless (isGenerated o) $ do +tidy1 _ g n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) + = do { unless g $ do warnAboutOverflowedOverLit lit1 warnAboutOverflowedOverLit lit2 ; return (idDsWrapper, n) } @@ -514,28 +511,28 @@ tidy1 _ _ non_interesting_pat = return (idDsWrapper, non_interesting_pat) -------------------- -tidy_bang_pat :: Id -> Origin -> SrcSpanAnnA -> Pat GhcTc +tidy_bang_pat :: Id -> Bool -> SrcSpanAnnA -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc) -- Discard par/sig under a bang -tidy_bang_pat v o _ (ParPat _ _ (L l p) _) = tidy_bang_pat v o l p -tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p +tidy_bang_pat v g _ (ParPat _ _ (L l p) _) = tidy_bang_pat v g l p +tidy_bang_pat v g _ (SigPat _ (L l p) _) = tidy_bang_pat v g l p -- Push the bang-pattern inwards, in the hope that -- it may disappear next time -tidy_bang_pat v o l (AsPat x v' at p) - = tidy1 v o (AsPat x v' at (L l (BangPat noExtField p))) -tidy_bang_pat v o l (XPat (CoPat w p t)) - = tidy1 v o (XPat $ CoPat w (BangPat noExtField (L l p)) t) +tidy_bang_pat v g l (AsPat x v' at p) + = tidy1 v g (AsPat x v' at (L l (BangPat noExtField p))) +tidy_bang_pat v g l (XPat (CoPat w p t)) + = tidy1 v g (XPat $ CoPat w (BangPat noExtField (L l p)) t) -- Discard bang around strict pattern -tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(ListPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(TuplePat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p +tidy_bang_pat v g _ p@(LitPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(ListPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(TuplePat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(SumPat {}) = tidy1 v g p -- Data/newtype constructors -tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) +tidy_bang_pat v g l p@(ConPat { pat_con = L _ (RealDataCon dc) , pat_args = args , pat_con_ext = ConPatTc { cpt_arg_tys = arg_tys @@ -544,8 +541,8 @@ tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) -- Newtypes: push bang inwards (#9844) = if isNewTyCon (dataConTyCon dc) - then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) - else tidy1 v o p -- Data types: discard the bang + then tidy1 v g (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) + else tidy1 v g p -- Data types: discard the bang where (ty:_) = dataConInstArgTys dc arg_tys @@ -808,16 +805,14 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags - ; let upats = map (unLoc . decideBangHood dflags) pats + ; let upats = map (decideBangHood dflags) pats -- pat_nablas is the covered set *after* matching the pattern, but -- before any of the GRHSs. We extend the environment with pat_nablas -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats match_result } discard_warnings_if_skip_pmc orig = if requiresPMC orig @@ -958,10 +953,9 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) else getLdiNablas - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = - updPmNablasMatchResult ldi_nablas match_result } + ; let eqn_info = EqnMatch { eqn_pat = decideBangHood dflags pat + , eqn_rest = + EqnDone $ updPmNablasMatchResult ldi_nablas match_result } -- See Note [Long-distance information in do notation] -- in GHC.HsToCore.Expr. @@ -999,6 +993,13 @@ data PatGroup -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors @@ -1019,7 +1020,7 @@ the PgN constructor as a FractionalLit if numeric, and add a PgOverStr construct for overloaded strings. -} -groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInfo)] +groupEquations :: Platform -> [EquationInfoNE] -> [NonEmpty (PatGroup, EquationInfoNE)] -- If the result is of form [g1, g2, g3], -- (a) all the (pg,eq) pairs in g1 have the same pg -- (b) none of the gi are empty @@ -1163,8 +1164,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2' -- the fixities have been straightened out by now, so it's safe -- to ignore them? - exp (OpApp _ l o ri) (OpApp _ l' o' ri') = - lexp l l' && lexp o o' && lexp ri ri' + exp (OpApp _ l g ri) (OpApp _ l' o' ri') = + lexp l l' && lexp g o' && lexp ri ri' exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n' exp (SectionL _ e1 e2) (SectionL _ e1' e2') = lexp e1 e1' && lexp e2 e2' ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -21,7 +21,6 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( match ) import GHC.Hs import GHC.HsToCore.Binds import GHC.Core.ConLike -import GHC.Types.Basic import GHC.Tc.Utils.TcType import GHC.Core.Multiplicity import GHC.HsToCore.Monad @@ -95,7 +94,7 @@ have-we-used-all-the-constructors? question; the local function matchConFamily :: NonEmpty Id -> Type - -> NonEmpty (NonEmpty EquationInfo) + -> NonEmpty (NonEmpty EquationInfoNE) -> DsM (MatchResult CoreExpr) -- Each group of eqns is for a single constructor matchConFamily (var :| vars) ty groups @@ -114,7 +113,7 @@ matchConFamily (var :| vars) ty groups matchPatSyn :: NonEmpty Id -> Type - -> NonEmpty EquationInfo + -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchPatSyn (var :| vars) ty eqns = do let mult = idMult var @@ -130,7 +129,7 @@ type ConArgPats = HsConPatDetails GhcTc matchOneConLike :: [Id] -> Type -> Mult - -> NonEmpty EquationInfo + -> NonEmpty EquationInfoNE -> DsM (CaseAlt ConLike) matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single constructor = do { let inst_tys = assert (all tcIsTcTyVar ex_tvs) $ @@ -144,7 +143,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- and returns the types of the *value* args, which is what we want match_group :: [Id] - -> NonEmpty (ConArgPats, EquationInfo) + -> NonEmpty (ConArgPats, EquationInfoNE) -> DsM (MatchResult CoreExpr) -- All members of the group have compatible ConArgPats match_group arg_vars arg_eqn_prs @@ -154,24 +153,21 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, EqnMatch { + eqn_pat = L _ (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind }}) + , eqn_rest = rest }) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated SkipPmc - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , prependPats (conArgPats val_arg_tys args) rest ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we @@ -185,7 +181,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- suggestions for the new variables -- Divide into sub-groups; see Note [Record patterns] - ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfo)) + ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfoNE)) groups = NE.groupBy1 compatible_pats $ fmap (\eqn -> (pat_args (firstPat eqn), eqn)) (eqn1 :| eqns) @@ -257,14 +253,14 @@ conArgPats :: [Scaled Type]-- Instantiated argument types -- Used only to fill in the types of WildPats, which -- are probably never looked at anyway -> ConArgPats - -> [Pat GhcTc] -conArgPats _arg_tys (PrefixCon _ ps) = map unLoc ps -conArgPats _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2] + -> [LPat GhcTc] +conArgPats _arg_tys (PrefixCon _ ps) = ps +conArgPats _arg_tys (InfixCon p1 p2) = [p1, p2] conArgPats arg_tys (RecCon (HsRecFields { rec_flds = rpats })) - | null rpats = map WildPat (map scaledThing arg_tys) + | null rpats = map (noLocA . WildPat . scaledThing) arg_tys -- Important special case for C {}, which can be used for a -- datacon that isn't declared to have fields at all - | otherwise = map (unLoc . hfbRHS . unLoc) rpats + | otherwise = map (hfbRHS . unLoc) rpats {- Note [Record patterns] ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -607,7 +607,7 @@ tidyNPat over_lit mb_neg eq outer_ty matchLiterals :: NonEmpty Id -> Type -- ^ Type of the whole case expression - -> NonEmpty (NonEmpty EquationInfo) -- ^ All PgLits + -> NonEmpty (NonEmpty EquationInfoNE) -- ^ All PgLits -> DsM (MatchResult CoreExpr) matchLiterals (var :| vars) ty sub_groups @@ -625,11 +625,11 @@ matchLiterals (var :| vars) ty sub_groups return (mkCoPrimCaseMatchResult var ty $ NEL.toList alts) } where - match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group :: NonEmpty EquationInfoNE -> DsM (Literal, MatchResult CoreExpr) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let EqnMatch { eqn_pat = L _ (LitPat _ hs_lit) } = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -682,7 +682,7 @@ hsLitKey _ l = pprPanic "hsLitKey" (ppr l) ************************************************************************ -} -matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchNPats (var :| vars) ty (eqn1 :| eqns) -- All for the same literal = do { let NPat _ (L _ lit) mb_neg eq_chk = firstPat eqn1 ; lit_expr <- dsOverLit lit @@ -711,7 +711,7 @@ We generate: \end{verbatim} -} -matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- All NPlusKPats, for the *same* literal k matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) = do { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus @@ -727,7 +727,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 (EqnMatch { eqn_pat = L _ (NPlusKPat _ (L _ n) _ _ _ _), eqn_rest = rest }) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -49,7 +49,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), EquationInfoNE, prependPats, mkEqnInfo, eqnMatchResult, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -92,7 +93,6 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) @@ -132,27 +132,42 @@ instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match data EquationInfo - = EqnInfo { eqn_pats :: [Pat GhcTc] - -- ^ The patterns for an equation - -- - -- NB: We have /already/ applied 'decideBangHood' to - -- these patterns. See Note [decideBangHood] in "GHC.HsToCore.Utils" - - , eqn_orig :: Origin - -- ^ Was this equation present in the user source? - -- - -- This helps us avoid warnings on patterns that GHC elaborated. - -- - -- For instance, the pattern @-1 :: Word@ gets desugared into - -- @W# -1## :: Word@, but we shouldn't warn about an overflowed - -- literal for /both/ of these cases. - - , eqn_rhs :: MatchResult CoreExpr - -- ^ What to do after match - } + = EqnMatch { eqn_pat :: LPat GhcTc + -- ^ The first pattern of the equation + -- + -- NB: The location info is used to determine whether the + -- pattern is generated or not. + -- This helps us avoid warnings on patterns that GHC elaborated. + -- + -- NB: We have /already/ applied 'decideBangHood' to this + -- pattern. See Note [decideBangHood] in "GHC.HsToCore.Utils" + + , eqn_rest :: EquationInfo } + -- ^ The rest of the equation after its first pattern + + | EqnDone + -- The empty tail of an equation having no more patterns + (MatchResult CoreExpr) + -- ^ What to do after match + +type EquationInfoNE = EquationInfo +-- An EquationInfo which has at least one pattern + +prependPats :: [LPat GhcTc] -> EquationInfo -> EquationInfo +prependPats [] eqn = eqn +prependPats (pat:pats) eqn = EqnMatch { eqn_pat = pat, eqn_rest = prependPats pats eqn } + +mkEqnInfo :: [LPat GhcTc] -> MatchResult CoreExpr -> EquationInfo +mkEqnInfo pats = prependPats pats . EqnDone + +eqnMatchResult :: EquationInfo -> MatchResult CoreExpr +eqnMatchResult (EqnDone rhs) = rhs +eqnMatchResult (EqnMatch { eqn_rest = eq }) = eqnMatchResult eq instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . allEqnPats where + allEqnPats (EqnDone {}) = [] + allEqnPats (EqnMatch { eqn_pat = pat, eqn_rest = eq }) = unLoc pat : allEqnPats eq type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, shiftEqns, combineEqnRhss, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -194,12 +194,16 @@ The ``equation info'' used by @match@ is relatively complicated and worthy of a type synonym and a few handy functions. -} -firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat :: EquationInfoNE -> Pat GhcTc +firstPat (EqnMatch { eqn_pat = pat }) = unLoc pat +firstPat (EqnDone {}) = error "firstPat: no patterns" -shiftEqns :: Functor f => f EquationInfo -> f EquationInfo +shiftEqns :: Functor f => f EquationInfoNE -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap eqn_rest + +combineEqnRhss :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineEqnRhss eqns = return $ foldr1 combineMatchResults $ map eqnMatchResult (NEL.toList eqns) -- Functions on MatchResult CoreExprs ===================================== libraries/base/Data/Fixed.hs ===================================== @@ -13,10 +13,19 @@ -- Stability : stable -- Portability : portable -- --- This module defines a \"Fixed\" type for fixed-precision arithmetic. --- The parameter to 'Fixed' is any type that's an instance of 'HasResolution'. --- 'HasResolution' has a single method that gives the resolution of the 'Fixed' --- type. +-- This module defines a 'Fixed' type for working with fixed-point arithmetic. +-- Fixed-point arithmetic represents fractional numbers with a fixed number of +-- digits for their fractional part. This is different to the behaviour of the floating-point +-- number types 'Float' and 'Double', because the number of digits of the +-- fractional part of 'Float' and 'Double' numbers depends on the size of the number. +-- Fixed point arithmetic is frequently used in financial mathematics, where they +-- are used for representing decimal currencies. +-- +-- The type 'Fixed' is used for fixed-point fractional numbers, which are internally +-- represented as an 'Integer'. The type 'Fixed' takes one parameter, which should implement +-- the typeclass 'HasResolution', to specify the number of digits of the fractional part. +-- This module provides instances of the `HasResolution` typeclass for arbitrary typelevel +-- natural numbers, and for some canonical important fixed-point representations. -- -- This module also contains generalisations of 'div', 'mod', and 'divMod' to -- work with any 'Real' instance. @@ -31,18 +40,49 @@ ----------------------------------------------------------------------------- module Data.Fixed -( - div',mod',divMod', - +( -- * The Fixed Type Fixed(..), HasResolution(..), showFixed, + -- * Resolution \/ Scaling Factors + -- | The resolution or scaling factor determines the number of digits in the fractional part. + -- + -- +------------+----------------------+--------------------------+--------------------------+ + -- | Resolution | Scaling Factor | Synonym for \"Fixed EX\" | show (12345 :: Fixed EX) | + -- +============+======================+==========================+==========================+ + -- | E0 | 1\/1 | Uni | 12345.0 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E1 | 1\/10 | Deci | 1234.5 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E2 | 1\/100 | Centi | 123.45 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E3 | 1\/1 000 | Milli | 12.345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E6 | 1\/1 000 000 | Micro | 0.012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E9 | 1\/1 000 000 000 | Nano | 0.000012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E12 | 1\/1 000 000 000 000 | Pico | 0.000000012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- + + -- ** 1\/1 E0,Uni, + -- ** 1\/10 E1,Deci, + -- ** 1\/100 E2,Centi, + -- ** 1\/1 000 E3,Milli, + -- ** 1\/1 000 000 E6,Micro, + -- ** 1\/1 000 000 000 E9,Nano, - E12,Pico + -- ** 1\/1 000 000 000 000 + E12,Pico, + -- * Generalized Functions on Real's + div', + mod', + divMod' ) where import Data.Data @@ -67,7 +107,14 @@ mod' :: (Real a) => a -> a -> a mod' n d = n - (fromInteger f) * d where f = div' n d --- | The type parameter should be an instance of 'HasResolution'. +-- | The type of fixed-point fractional numbers. +-- The type parameter specifies the number of digits of the fractional part and should be an instance of the 'HasResolution' typeclass. +-- +-- === __Examples__ +-- +-- @ +-- MkFixed 12345 :: Fixed E3 +-- @ newtype Fixed (a :: k) = MkFixed Integer deriving ( Eq -- ^ @since 2.01 , Ord -- ^ @since 2.01 @@ -77,6 +124,7 @@ newtype Fixed (a :: k) = MkFixed Integer -- Our manual instance has the more general (Typeable a) context. tyFixed :: DataType tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed] + conMkFixed :: Constr conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix @@ -87,7 +135,9 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where dataTypeOf _ = tyFixed toConstr _ = conMkFixed +-- | Types which can be used as a resolution argument to the 'Fixed' type constructor must implement the 'HasResolution' typeclass. class HasResolution (a :: k) where + -- | Provide the resolution for a fixed-point fractional number. resolution :: p a -> Integer -- | For example, @Fixed 1000@ will give you a 'Fixed' with a resolution of 1000. @@ -109,33 +159,26 @@ withResolution foo = withType (foo . resolution) -- resolution of the 'Fixed' value. For example, when enumerating values of -- resolution @10^-3@ of @type Milli = Fixed E3@, -- --- @ --- succ (0.000 :: Milli) == 0.001 --- @ --- +-- >>> succ (0.000 :: Milli) +-- 0.001 -- -- and likewise -- --- @ --- pred (0.000 :: Milli) == -0.001 --- @ --- +-- >>> pred (0.000 :: Milli) +-- -0.001 -- -- In other words, 'succ' and 'pred' increment and decrement a fixed-precision -- value by the least amount such that the value's resolution is unchanged. -- For example, @10^-12@ is the smallest (positive) amount that can be added to -- a value of @type Pico = Fixed E12@ without changing its resolution, and so -- --- @ --- succ (0.000000000000 :: Pico) == 0.000000000001 --- @ --- +-- >>> succ (0.000000000000 :: Pico) +-- 0.000000000001 -- -- and similarly -- --- @ --- pred (0.000000000000 :: Pico) == -0.000000000001 --- @ +-- >>> pred (0.000000000000 :: Pico) +-- -0.000000000001 -- -- -- This is worth bearing in mind when defining 'Fixed' arithmetic sequences. In @@ -175,6 +218,7 @@ instance Enum (Fixed a) where -- -- >>> (0.2 * 0.6 :: Deci) * 0.9 == 0.2 * (0.6 * 0.9) -- False +-- -- >>> (0.1 + 0.1 :: Deci) * 0.5 == 0.1 * 0.5 + 0.1 * 0.5 -- False instance (HasResolution a) => Num (Fixed a) where @@ -223,6 +267,15 @@ withDot "" = "" withDot s = '.':s -- | First arg is whether to chop off trailing zeros +-- +-- === __Examples__ +-- +-- >>> showFixed True (MkFixed 10000 :: Fixed E3) +-- "10" +-- +-- >>> showFixed False (MkFixed 10000 :: Fixed E3) +-- "10.000" +-- showFixed :: (HasResolution a) => Bool -> Fixed a -> String showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa)) showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where @@ -256,58 +309,135 @@ convertFixed (Number n) e = ceiling (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail +-- | Resolution of 1, this works the same as Integer. data E0 -- | @since 4.1.0.0 instance HasResolution E0 where resolution _ = 1 --- | resolution of 1, this works the same as Integer + +-- | Resolution of 1, this works the same as Integer. +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E0) +-- "12345.0" +-- +-- >>> show (MkFixed 12345 :: Uni) +-- "12345.0" +-- type Uni = Fixed E0 +-- | Resolution of 10^-1 = .1 data E1 -- | @since 4.1.0.0 instance HasResolution E1 where resolution _ = 10 --- | resolution of 10^-1 = .1 + +-- | Resolution of 10^-1 = .1 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E1) +-- "1234.5" +-- +-- >>> show (MkFixed 12345 :: Deci) +-- "1234.5" +-- type Deci = Fixed E1 +-- | Resolution of 10^-2 = .01, useful for many monetary currencies data E2 -- | @since 4.1.0.0 instance HasResolution E2 where resolution _ = 100 --- | resolution of 10^-2 = .01, useful for many monetary currencies + +-- | Resolution of 10^-2 = .01, useful for many monetary currencies +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E2) +-- "123.45" +-- +-- >>> show (MkFixed 12345 :: Centi) +-- "123.45" +-- type Centi = Fixed E2 +-- | Resolution of 10^-3 = .001 data E3 -- | @since 4.1.0.0 instance HasResolution E3 where resolution _ = 1000 --- | resolution of 10^-3 = .001 + +-- | Resolution of 10^-3 = .001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E3) +-- "12.345" +-- +-- >>> show (MkFixed 12345 :: Milli) +-- "12.345" +-- type Milli = Fixed E3 +-- | Resolution of 10^-6 = .000001 data E6 -- | @since 2.01 instance HasResolution E6 where resolution _ = 1000000 --- | resolution of 10^-6 = .000001 + +-- | Resolution of 10^-6 = .000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E6) +-- "0.012345" +-- +-- >>> show (MkFixed 12345 :: Micro) +-- "0.012345" +-- type Micro = Fixed E6 +-- | Resolution of 10^-9 = .000000001 data E9 -- | @since 4.1.0.0 instance HasResolution E9 where resolution _ = 1000000000 --- | resolution of 10^-9 = .000000001 + +-- | Resolution of 10^-9 = .000000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E9) +-- "0.000012345" +-- +-- >>> show (MkFixed 12345 :: Nano) +-- "0.000012345" +-- type Nano = Fixed E9 +-- | Resolution of 10^-12 = .000000000001 data E12 -- | @since 2.01 instance HasResolution E12 where resolution _ = 1000000000000 --- | resolution of 10^-12 = .000000000001 + +-- | Resolution of 10^-12 = .000000000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E12) +-- "0.000000012345" +-- +-- >>> show (MkFixed 12345 :: Pico) +-- "0.000000012345" +-- type Pico = Fixed E12 ===================================== libraries/ghc-prim/cbits/atomic.c ===================================== @@ -279,28 +279,36 @@ extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord8 *) x, (StgWord8) old, (StgWord8) new); + StgWord8 expected = (StgWord8) old; + __atomic_compare_exchange_n((StgWord8 *) x, &expected, (StgWord8) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord16 *) x, (StgWord16) old, (StgWord16) new); + StgWord16 expected = (StgWord16) old; + __atomic_compare_exchange_n((StgWord16 *) x, &expected, (StgWord16) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new); + StgWord32 expected = (StgWord32) old; + __atomic_compare_exchange_n((StgWord32 *) x, &expected, (StgWord32) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new); StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) { - return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new); + StgWord64 expected = (StgWord64) old; + __atomic_compare_exchange_n((StgWord64 *) x, &expected, (StgWord64) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } // Atomic exchange operations View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ff1259815849f0f3abb00a6a9168b4baadc72b5...be96d684d0e6bfa6ae0e9425f34048fab2e744d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ff1259815849f0f3abb00a6a9168b4baadc72b5...be96d684d0e6bfa6ae0e9425f34048fab2e744d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 22:03:53 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 27 Jul 2023 18:03:53 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-with-fallback -finfo-table-map-with-stack Message-ID: <64c2e9c9ed851_37b561c5e8ab01637f9@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 6e9272db by Finley McIlwaine at 2023-07-27T16:03:40-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 16 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/phases.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e9272dbf797d1cd889afaa7c25cf90703751dec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6e9272dbf797d1cd889afaa7c25cf90703751dec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 22:11:24 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 27 Jul 2023 18:11:24 -0400 Subject: [Git][ghc/ghc][wip/t23702] 14 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c2eb8c34ac2_37b561ba004164133@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 1f4ef242 by Finley McIlwaine at 2023-07-27T16:09:53-06:00 Add -dipe-stats flag This is useful for seeing which info tables have information. - - - - - 5ae5c2a1 by Finley McIlwaine at 2023-07-27T16:10:52-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Pmc/Utils.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e9272dbf797d1cd889afaa7c25cf90703751dec...5ae5c2a1a417122c250b87841b5bf901117c8dd9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6e9272dbf797d1cd889afaa7c25cf90703751dec...5ae5c2a1a417122c250b87841b5bf901117c8dd9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Jul 27 22:16:46 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 27 Jul 2023 18:16:46 -0400 Subject: [Git][ghc/ghc][wip/no-stub-dir-include] 309 commits: Generate Addr# access ops programmatically Message-ID: <64c2ecce2cfac_37b561c5bcb40164827@gitlab.mail> Finley McIlwaine pushed to branch wip/no-stub-dir-include at Glasgow Haskell Compiler / GHC Commits: 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - 2bf7bd3f by Finley McIlwaine at 2023-07-27T16:15:50-06:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - − .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - − .gitlab/merge_request_templates/backport-for-8.8.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c69d97986a0901fe79bd311f22a152551c5cf0a8...2bf7bd3f7c616128d520da50c9d26d23a8c31061 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c69d97986a0901fe79bd311f22a152551c5cf0a8...2bf7bd3f7c616128d520da50c9d26d23a8c31061 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 12:39:02 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 28 Jul 2023 08:39:02 -0400 Subject: [Git][ghc/ghc][wip/T23578] Native 32-bit Enum Int64/Word64 instances Message-ID: <64c3b6e68c148_37b561c5e8ac427364f@gitlab.mail> Jaro Reinders pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC Commits: 95ddecef by Jaro Reinders at 2023-07-28T14:32:38+02:00 Native 32-bit Enum Int64/Word64 instances This commits adds more performant Enum Int64 and Enum Word64 instances for 32-bit platforms, replacing the Integer-based implementation. These instances are a copy of the Enum Int and Enum Word instances with minimal changes to manipulate Int64 and Word64 instead. On i386 this yields a 1.5x performance increase and for the JavaScript back end it even yields a 5.6x speedup. - - - - - 2 changed files: - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs Changes: ===================================== libraries/base/GHC/Int.hs ===================================== @@ -753,27 +753,153 @@ instance Enum Int64 where | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = I# (int64ToInt# x#) | otherwise = fromEnumError "Int64" x -#if WORD_SIZE_IN_BITS < 64 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFrom #-} - enumFrom = integralEnumFrom - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThen #-} - enumFromThen = integralEnumFromThen + enumFrom (I64# x) = eftInt64 x maxInt64# + where !(I64# maxInt64#) = maxBound + -- Blarg: technically I guess enumFrom isn't strict! + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromTo #-} - enumFromTo = integralEnumFromTo - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThenTo #-} - enumFromThenTo = integralEnumFromThenTo -#else - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFrom #-} - enumFrom = boundedEnumFrom + enumFromTo (I64# x) (I64# y) = eftInt64 x y + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThen #-} - enumFromThen = boundedEnumFromThen -#endif + enumFromThen (I64# x1) (I64# x2) = efdInt64 x1 x2 + + -- See Note [Stable Unfolding for list producers] in GHC.Enum + {-# INLINE enumFromThenTo #-} + enumFromThenTo (I64# x1) (I64# x2) (I64# y) = efdtInt64 x1 x2 y + + +----------------------------------------------------- +-- eftInt64 and eftInt64FB deal with [a..b], which is the +-- most common form, so we take a lot of care +-- In particular, we have rules for deforestation + +-- See Note [How the Enum rules work] in GHC.Enum +{-# RULES +"eftInt64" [~1] forall x y. eftInt64 x y = build (\ c n -> eftInt64FB c n x y) +"eftInt64List" [1] eftInt64FB (:) [] = eftInt64 + #-} + +{-# NOINLINE [1] eftInt64 #-} +eftInt64 :: Int64# -> Int64# -> [Int64] +-- [x1..x2] +eftInt64 x0 y | isTrue# (x0 `geInt64#` y) = [] + | otherwise = go x0 + where + go x = I64# x : if isTrue# (x `eqInt64#` y) + then [] + else go (x `plusInt64#` (intToInt64# 1#)) + +{-# INLINE [0] eftInt64FB #-} -- See Note [Inline FB functions] in GHC.List +eftInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> r +eftInt64FB c n x0 y | isTrue# (x0 `geInt64#` y) = n + | otherwise = go x0 + where + go x = I64# x `c` if isTrue# (x `eqInt64#` y) + then n + else go (x `plusInt64#` (intToInt64# 1#)) + -- Watch out for y=maxBound; hence ==, not > + -- Be very careful not to have more than one "c" + -- so that when eftInfFB is inlined we can inline + -- whatever is bound to "c" + + +----------------------------------------------------- +-- efdInt64 and efdtInt64 deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Int64 overflow. + +-- See Note [How the Enum rules work] in GHC.Enum +{-# RULES +"efdtInt64" [~1] forall x1 x2 y. + efdtInt64 x1 x2 y = build (\ c n -> efdtInt64FB c n x1 x2 y) +"efdtInt64UpList" [1] efdtInt64FB (:) [] = efdtInt64 + #-} + +efdInt64 :: Int64# -> Int64# -> [Int64] +-- [x1,x2..maxInt64] +efdInt64 x1 x2 + | isTrue# (x2 `geInt64#` x1) = case maxBound of I64# y -> efdtInt64Up x1 x2 y + | otherwise = case maxBound of I64# y -> efdtInt64Dn x1 x2 y + +{-# NOINLINE [1] efdtInt64 #-} +efdtInt64 :: Int64# -> Int64# -> Int64# -> [Int64] +-- [x1,x2..y] +efdtInt64 x1 x2 y + | isTrue# (x2 `geInt64#` x1) = efdtInt64Up x1 x2 y + | otherwise = efdtInt64Dn x1 x2 y + +{-# INLINE [0] efdtInt64FB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64FB c n x1 x2 y + | isTrue# (x2 `geInt64#` x1) = efdtInt64UpFB c n x1 x2 y + | otherwise = efdtInt64DnFB c n x1 x2 y + +-- Requires x2 >= x1 +efdtInt64Up :: Int64# -> Int64# -> Int64# -> [Int64] +efdtInt64Up x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then [] else [I64# x1] + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subInt64#` x1 -- >= 0 + !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtInt64#` y') = [I64# x] + | otherwise = I64# x : go_up (x `plusInt64#` delta) + in I64# x1 : go_up x2 + +-- Requires x2 >= x1 +{-# INLINE [0] efdtInt64UpFB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64UpFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64UpFB c n x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then n else I64# x1 `c` n + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subInt64#` x1 -- >= 0 + !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `geInt64#` y') = I64# x `c` n + | otherwise = I64# x `c` go_up (x `plusInt64#` delta) + in I64# x1 `c` go_up x2 + +-- Requires x2 <= x1 +efdtInt64Dn :: Int64# -> Int64# -> Int64# -> [Int64] +efdtInt64Dn x1 x2 y -- Be careful about underflow! + | isTrue# (y `geInt64#` x2) = if isTrue# (y `geInt64#` x1) then [] else [I64# x1] + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subInt64#` x1 -- <= 0 + !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltInt64#` y') = [I64# x] + | otherwise = I64# x : go_dn (x `plusInt64#` delta) + in I64# x1 : go_dn x2 + +-- Requires x2 <= x1 +{-# INLINE [0] efdtInt64DnFB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64DnFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64DnFB c n x1 x2 y -- Be careful about underflow! + | isTrue# (y `geInt64#` x2) = if isTrue# (y `geInt64#` x1) then n else I64# x1 `c` n + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subInt64#` x1 -- <= 0 + !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltInt64#` y') = I64# x `c` n + | otherwise = I64# x `c` go_dn (x `plusInt64#` delta) + in I64# x1 `c` go_dn x2 + -- | @since 2.01 instance Integral Int64 where ===================================== libraries/base/GHC/Word.hs ===================================== @@ -730,37 +730,155 @@ instance Enum Word64 where | x <= fromIntegral (maxBound::Int) = I# (word2Int# (word64ToWord# x#)) | otherwise = fromEnumError "Word64" x -#if WORD_SIZE_IN_BITS < 64 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFrom #-} - enumFrom = integralEnumFrom - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThen #-} - enumFromThen = integralEnumFromThen + enumFrom (W64# x#) = eftWord64 x# maxWord# + where !(W64# maxWord#) = maxBound + -- Blarg: technically I guess enumFrom isn't strict! + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromTo #-} - enumFromTo = integralEnumFromTo - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThenTo #-} - enumFromThenTo = integralEnumFromThenTo -#else - -- use Word's Enum as it has better support for fusion. We can't use - -- `boundedEnumFrom` and `boundedEnumFromThen` -- which use Int's Enum - -- instance -- because Word64 isn't compatible with Int/Int64's domain. - -- - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFrom #-} - enumFrom x = map fromIntegral (enumFrom (fromIntegral x :: Word)) + enumFromTo (W64# x) (W64# y) = eftWord64 x y + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThen #-} - enumFromThen x y = map fromIntegral (enumFromThen (fromIntegral x :: Word) (fromIntegral y)) - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromTo #-} - enumFromTo x y = map fromIntegral (enumFromTo (fromIntegral x :: Word) (fromIntegral y)) + enumFromThen (W64# x1) (W64# x2) = efdWord64 x1 x2 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThenTo #-} - enumFromThenTo x y z = map fromIntegral (enumFromThenTo (fromIntegral x :: Word) (fromIntegral y) (fromIntegral z)) -#endif + enumFromThenTo (W64# x1) (W64# x2) (W64# y) = efdtWord64 x1 x2 y + + +----------------------------------------------------- +-- eftWord64 and eftWord64FB deal with [a..b], which is the +-- most common form, so we take a lot of care +-- In particular, we have rules for deforestation + +{-# RULES +"eftWord64" [~1] forall x y. eftWord64 x y = build (\ c n -> eftWord64FB c n x y) +"eftWord64List" [1] eftWord64FB (:) [] = eftWord64 + #-} + +-- The Enum rules for Word64 work much the same way that they do for Int. +-- See Note [How the Enum rules work]. + +{-# NOINLINE [1] eftWord64 #-} +eftWord64 :: Word64# -> Word64# -> [Word64] +-- [x1..x2] +eftWord64 x0 y | isTrue# (x0 `gtWord64#` y) = [] + | otherwise = go x0 + where + go x = W64# x : if isTrue# (x `eqWord64#` y) + then [] + else go (x `plusWord64#` (wordToWord64# 1##)) + +{-# INLINE [0] eftWord64FB #-} -- See Note [Inline FB functions] in GHC.List +eftWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> r +eftWord64FB c n x0 y | isTrue# (x0 `gtWord64#` y) = n + | otherwise = go x0 + where + go x = W64# x `c` if isTrue# (x `eqWord64#` y) + then n + else go (x `plusWord64#` (wordToWord64# 1##)) + -- Watch out for y=maxBound; hence ==, not > + -- Be very careful not to have more than one "c" + -- so that when eftInfFB is inlined we can inline + -- whatever is bound to "c" + + +----------------------------------------------------- +-- efdWord64 and efdtWord64 deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Word64 overflow. + +-- See Note [How the Enum rules work] +{-# RULES +"efdtWord64" [~1] forall x1 x2 y. + efdtWord64 x1 x2 y = build (\ c n -> efdtWord64FB c n x1 x2 y) +"efdtWord64UpList" [1] efdtWord64FB (:) [] = efdtWord64 + #-} + +efdWord64 :: Word64# -> Word64# -> [Word64] +-- [x1,x2..maxWord64] +efdWord64 x1 x2 + | isTrue# (x2 `geWord64#` x1) = case maxBound of W64# y -> efdtWord64Up x1 x2 y + | otherwise = case minBound of W64# y -> efdtWord64Dn x1 x2 y + +{-# NOINLINE [1] efdtWord64 #-} +efdtWord64 :: Word64# -> Word64# -> Word64# -> [Word64] +-- [x1,x2..y] +efdtWord64 x1 x2 y + | isTrue# (x2 `geWord64#` x1) = efdtWord64Up x1 x2 y + | otherwise = efdtWord64Dn x1 x2 y + +{-# INLINE [0] efdtWord64FB #-} -- See Note [Inline FB functions] in GHC.List +efdtWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r +efdtWord64FB c n x1 x2 y + | isTrue# (x2 `geWord64#` x1) = efdtWord64UpFB c n x1 x2 y + | otherwise = efdtWord64DnFB c n x1 x2 y + +-- Requires x2 >= x1 +efdtWord64Up :: Word64# -> Word64# -> Word64# -> [Word64] +efdtWord64Up x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then [] else [W64# x1] + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subWord64#` x1 -- >= 0 + !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtWord64#` y') = [W64# x] + | otherwise = W64# x : go_up (x `plusWord64#` delta) + in W64# x1 : go_up x2 + +-- Requires x2 >= x1 +{-# INLINE [0] efdtWord64UpFB #-} -- See Note [Inline FB functions] in GHC.List +efdtWord64UpFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r +efdtWord64UpFB c n x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then n else W64# x1 `c` n + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subWord64#` x1 -- >= 0 + !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtWord64#` y') = W64# x `c` n + | otherwise = W64# x `c` go_up (x `plusWord64#` delta) + in W64# x1 `c` go_up x2 + +-- Requires x2 <= x1 +efdtWord64Dn :: Word64# -> Word64# -> Word64# -> [Word64] +efdtWord64Dn x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then [] else [W64# x1] + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subWord64#` x1 -- <= 0 + !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltWord64#` y') = [W64# x] + | otherwise = W64# x : go_dn (x `plusWord64#` delta) + in W64# x1 : go_dn x2 + +-- Requires x2 <= x1 +{-# INLINE [0] efdtWord64DnFB #-} -- See Note [Inline FB functions] in GHC.List +efdtWord64DnFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r +efdtWord64DnFB c n x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then n else W64# x1 `c` n + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subWord64#` x1 -- <= 0 + !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltWord64#` y') = W64# x `c` n + | otherwise = W64# x `c` go_dn (x `plusWord64#` delta) + in W64# x1 `c` go_dn x2 + -- | @since 2.01 instance Integral Word64 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95ddecef92de3d7390ec4ab9d706cc75083831e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95ddecef92de3d7390ec4ab9d706cc75083831e1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 14:23:05 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 28 Jul 2023 10:23:05 -0400 Subject: [Git][ghc/ghc][wip/T23578] Native 32-bit Enum Int64/Word64 instances Message-ID: <64c3cf492aa96_37b561ba0682908be@gitlab.mail> Jaro Reinders pushed to branch wip/T23578 at Glasgow Haskell Compiler / GHC Commits: 5cb851aa by Jaro Reinders at 2023-07-28T14:20:49+00:00 Native 32-bit Enum Int64/Word64 instances This commits adds more performant Enum Int64 and Enum Word64 instances for 32-bit platforms, replacing the Integer-based implementation. These instances are a copy of the Enum Int and Enum Word instances with minimal changes to manipulate Int64 and Word64 instead. On i386 this yields a 1.5x performance increase and for the JavaScript back end it even yields a 5.6x speedup. - - - - - 2 changed files: - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs Changes: ===================================== libraries/base/GHC/Int.hs ===================================== @@ -753,27 +753,153 @@ instance Enum Int64 where | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int) = I# (int64ToInt# x#) | otherwise = fromEnumError "Int64" x -#if WORD_SIZE_IN_BITS < 64 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFrom #-} - enumFrom = integralEnumFrom - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThen #-} - enumFromThen = integralEnumFromThen + enumFrom (I64# x) = eftInt64 x maxInt64# + where !(I64# maxInt64#) = maxBound + -- Blarg: technically I guess enumFrom isn't strict! + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromTo #-} - enumFromTo = integralEnumFromTo - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThenTo #-} - enumFromThenTo = integralEnumFromThenTo -#else - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFrom #-} - enumFrom = boundedEnumFrom + enumFromTo (I64# x) (I64# y) = eftInt64 x y + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThen #-} - enumFromThen = boundedEnumFromThen -#endif + enumFromThen (I64# x1) (I64# x2) = efdInt64 x1 x2 + + -- See Note [Stable Unfolding for list producers] in GHC.Enum + {-# INLINE enumFromThenTo #-} + enumFromThenTo (I64# x1) (I64# x2) (I64# y) = efdtInt64 x1 x2 y + + +----------------------------------------------------- +-- eftInt64 and eftInt64FB deal with [a..b], which is the +-- most common form, so we take a lot of care +-- In particular, we have rules for deforestation + +-- See Note [How the Enum rules work] in GHC.Enum +{-# RULES +"eftInt64" [~1] forall x y. eftInt64 x y = build (\ c n -> eftInt64FB c n x y) +"eftInt64List" [1] eftInt64FB (:) [] = eftInt64 + #-} + +{-# NOINLINE [1] eftInt64 #-} +eftInt64 :: Int64# -> Int64# -> [Int64] +-- [x1..x2] +eftInt64 x0 y | isTrue# (x0 `gtInt64#` y) = [] + | otherwise = go x0 + where + go x = I64# x : if isTrue# (x `eqInt64#` y) + then [] + else go (x `plusInt64#` (intToInt64# 1#)) + +{-# INLINE [0] eftInt64FB #-} -- See Note [Inline FB functions] in GHC.List +eftInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> r +eftInt64FB c n x0 y | isTrue# (x0 `gtInt64#` y) = n + | otherwise = go x0 + where + go x = I64# x `c` if isTrue# (x `eqInt64#` y) + then n + else go (x `plusInt64#` (intToInt64# 1#)) + -- Watch out for y=maxBound; hence ==, not > + -- Be very careful not to have more than one "c" + -- so that when eftInfFB is inlined we can inline + -- whatever is bound to "c" + + +----------------------------------------------------- +-- efdInt64 and efdtInt64 deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Int64 overflow. + +-- See Note [How the Enum rules work] in GHC.Enum +{-# RULES +"efdtInt64" [~1] forall x1 x2 y. + efdtInt64 x1 x2 y = build (\ c n -> efdtInt64FB c n x1 x2 y) +"efdtInt64UpList" [1] efdtInt64FB (:) [] = efdtInt64 + #-} + +efdInt64 :: Int64# -> Int64# -> [Int64] +-- [x1,x2..maxInt64] +efdInt64 x1 x2 + | isTrue# (x2 `geInt64#` x1) = case maxBound of I64# y -> efdtInt64Up x1 x2 y + | otherwise = case minBound of I64# y -> efdtInt64Dn x1 x2 y + +{-# NOINLINE [1] efdtInt64 #-} +efdtInt64 :: Int64# -> Int64# -> Int64# -> [Int64] +-- [x1,x2..y] +efdtInt64 x1 x2 y + | isTrue# (x2 `geInt64#` x1) = efdtInt64Up x1 x2 y + | otherwise = efdtInt64Dn x1 x2 y + +{-# INLINE [0] efdtInt64FB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64FB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64FB c n x1 x2 y + | isTrue# (x2 `geInt64#` x1) = efdtInt64UpFB c n x1 x2 y + | otherwise = efdtInt64DnFB c n x1 x2 y + +-- Requires x2 >= x1 +efdtInt64Up :: Int64# -> Int64# -> Int64# -> [Int64] +efdtInt64Up x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then [] else [I64# x1] + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subInt64#` x1 -- >= 0 + !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtInt64#` y') = [I64# x] + | otherwise = I64# x : go_up (x `plusInt64#` delta) + in I64# x1 : go_up x2 + +-- Requires x2 >= x1 +{-# INLINE [0] efdtInt64UpFB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64UpFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64UpFB c n x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltInt64#` x2) = if isTrue# (y `ltInt64#` x1) then n else I64# x1 `c` n + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subInt64#` x1 -- >= 0 + !y' = y `subInt64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtInt64#` y') = I64# x `c` n + | otherwise = I64# x `c` go_up (x `plusInt64#` delta) + in I64# x1 `c` go_up x2 + +-- Requires x2 <= x1 +efdtInt64Dn :: Int64# -> Int64# -> Int64# -> [Int64] +efdtInt64Dn x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtInt64#` x2) = if isTrue# (y `gtInt64#` x1) then [] else [I64# x1] + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subInt64#` x1 -- <= 0 + !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltInt64#` y') = [I64# x] + | otherwise = I64# x : go_dn (x `plusInt64#` delta) + in I64# x1 : go_dn x2 + +-- Requires x2 <= x1 +{-# INLINE [0] efdtInt64DnFB #-} -- See Note [Inline FB functions] in GHC.List +efdtInt64DnFB :: (Int64 -> r -> r) -> r -> Int64# -> Int64# -> Int64# -> r +efdtInt64DnFB c n x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtInt64#` x2) = if isTrue# (y `gtInt64#` x1) then n else I64# x1 `c` n + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subInt64#` x1 -- <= 0 + !y' = y `subInt64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltInt64#` y') = I64# x `c` n + | otherwise = I64# x `c` go_dn (x `plusInt64#` delta) + in I64# x1 `c` go_dn x2 + -- | @since 2.01 instance Integral Int64 where ===================================== libraries/base/GHC/Word.hs ===================================== @@ -730,37 +730,155 @@ instance Enum Word64 where | x <= fromIntegral (maxBound::Int) = I# (word2Int# (word64ToWord# x#)) | otherwise = fromEnumError "Word64" x -#if WORD_SIZE_IN_BITS < 64 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFrom #-} - enumFrom = integralEnumFrom - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThen #-} - enumFromThen = integralEnumFromThen + enumFrom (W64# x#) = eftWord64 x# maxWord# + where !(W64# maxWord#) = maxBound + -- Blarg: technically I guess enumFrom isn't strict! + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromTo #-} - enumFromTo = integralEnumFromTo - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromThenTo #-} - enumFromThenTo = integralEnumFromThenTo -#else - -- use Word's Enum as it has better support for fusion. We can't use - -- `boundedEnumFrom` and `boundedEnumFromThen` -- which use Int's Enum - -- instance -- because Word64 isn't compatible with Int/Int64's domain. - -- - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFrom #-} - enumFrom x = map fromIntegral (enumFrom (fromIntegral x :: Word)) + enumFromTo (W64# x) (W64# y) = eftWord64 x y + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThen #-} - enumFromThen x y = map fromIntegral (enumFromThen (fromIntegral x :: Word) (fromIntegral y)) - -- See Note [Stable Unfolding for list producers] in GHC.Enum - {-# INLINE enumFromTo #-} - enumFromTo x y = map fromIntegral (enumFromTo (fromIntegral x :: Word) (fromIntegral y)) + enumFromThen (W64# x1) (W64# x2) = efdWord64 x1 x2 + -- See Note [Stable Unfolding for list producers] in GHC.Enum {-# INLINE enumFromThenTo #-} - enumFromThenTo x y z = map fromIntegral (enumFromThenTo (fromIntegral x :: Word) (fromIntegral y) (fromIntegral z)) -#endif + enumFromThenTo (W64# x1) (W64# x2) (W64# y) = efdtWord64 x1 x2 y + + +----------------------------------------------------- +-- eftWord64 and eftWord64FB deal with [a..b], which is the +-- most common form, so we take a lot of care +-- In particular, we have rules for deforestation + +{-# RULES +"eftWord64" [~1] forall x y. eftWord64 x y = build (\ c n -> eftWord64FB c n x y) +"eftWord64List" [1] eftWord64FB (:) [] = eftWord64 + #-} + +-- The Enum rules for Word64 work much the same way that they do for Int. +-- See Note [How the Enum rules work]. + +{-# NOINLINE [1] eftWord64 #-} +eftWord64 :: Word64# -> Word64# -> [Word64] +-- [x1..x2] +eftWord64 x0 y | isTrue# (x0 `gtWord64#` y) = [] + | otherwise = go x0 + where + go x = W64# x : if isTrue# (x `eqWord64#` y) + then [] + else go (x `plusWord64#` (wordToWord64# 1##)) + +{-# INLINE [0] eftWord64FB #-} -- See Note [Inline FB functions] in GHC.List +eftWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> r +eftWord64FB c n x0 y | isTrue# (x0 `gtWord64#` y) = n + | otherwise = go x0 + where + go x = W64# x `c` if isTrue# (x `eqWord64#` y) + then n + else go (x `plusWord64#` (wordToWord64# 1##)) + -- Watch out for y=maxBound; hence ==, not > + -- Be very careful not to have more than one "c" + -- so that when eftInfFB is inlined we can inline + -- whatever is bound to "c" + + +----------------------------------------------------- +-- efdWord64 and efdtWord64 deal with [a,b..] and [a,b..c]. +-- The code is more complicated because of worries about Word64 overflow. + +-- See Note [How the Enum rules work] +{-# RULES +"efdtWord64" [~1] forall x1 x2 y. + efdtWord64 x1 x2 y = build (\ c n -> efdtWord64FB c n x1 x2 y) +"efdtWord64UpList" [1] efdtWord64FB (:) [] = efdtWord64 + #-} + +efdWord64 :: Word64# -> Word64# -> [Word64] +-- [x1,x2..maxWord64] +efdWord64 x1 x2 + | isTrue# (x2 `geWord64#` x1) = case maxBound of W64# y -> efdtWord64Up x1 x2 y + | otherwise = case minBound of W64# y -> efdtWord64Dn x1 x2 y + +{-# NOINLINE [1] efdtWord64 #-} +efdtWord64 :: Word64# -> Word64# -> Word64# -> [Word64] +-- [x1,x2..y] +efdtWord64 x1 x2 y + | isTrue# (x2 `geWord64#` x1) = efdtWord64Up x1 x2 y + | otherwise = efdtWord64Dn x1 x2 y + +{-# INLINE [0] efdtWord64FB #-} -- See Note [Inline FB functions] in GHC.List +efdtWord64FB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r +efdtWord64FB c n x1 x2 y + | isTrue# (x2 `geWord64#` x1) = efdtWord64UpFB c n x1 x2 y + | otherwise = efdtWord64DnFB c n x1 x2 y + +-- Requires x2 >= x1 +efdtWord64Up :: Word64# -> Word64# -> Word64# -> [Word64] +efdtWord64Up x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then [] else [W64# x1] + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subWord64#` x1 -- >= 0 + !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtWord64#` y') = [W64# x] + | otherwise = W64# x : go_up (x `plusWord64#` delta) + in W64# x1 : go_up x2 + +-- Requires x2 >= x1 +{-# INLINE [0] efdtWord64UpFB #-} -- See Note [Inline FB functions] in GHC.List +efdtWord64UpFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r +efdtWord64UpFB c n x1 x2 y -- Be careful about overflow! + | isTrue# (y `ltWord64#` x2) = if isTrue# (y `ltWord64#` x1) then n else W64# x1 `c` n + | otherwise = -- Common case: x1 <= x2 <= y + let !delta = x2 `subWord64#` x1 -- >= 0 + !y' = y `subWord64#` delta -- x1 <= y' <= y; hence y' is representable + + -- Invariant: x <= y + -- Note that: z <= y' => z + delta won't overflow + -- so we are guaranteed not to overflow if/when we recurse + go_up x | isTrue# (x `gtWord64#` y') = W64# x `c` n + | otherwise = W64# x `c` go_up (x `plusWord64#` delta) + in W64# x1 `c` go_up x2 + +-- Requires x2 <= x1 +efdtWord64Dn :: Word64# -> Word64# -> Word64# -> [Word64] +efdtWord64Dn x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then [] else [W64# x1] + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subWord64#` x1 -- <= 0 + !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltWord64#` y') = [W64# x] + | otherwise = W64# x : go_dn (x `plusWord64#` delta) + in W64# x1 : go_dn x2 + +-- Requires x2 <= x1 +{-# INLINE [0] efdtWord64DnFB #-} -- See Note [Inline FB functions] in GHC.List +efdtWord64DnFB :: (Word64 -> r -> r) -> r -> Word64# -> Word64# -> Word64# -> r +efdtWord64DnFB c n x1 x2 y -- Be careful about underflow! + | isTrue# (y `gtWord64#` x2) = if isTrue# (y `gtWord64#` x1) then n else W64# x1 `c` n + | otherwise = -- Common case: x1 >= x2 >= y + let !delta = x2 `subWord64#` x1 -- <= 0 + !y' = y `subWord64#` delta -- y <= y' <= x1; hence y' is representable + + -- Invariant: x >= y + -- Note that: z >= y' => z + delta won't underflow + -- so we are guaranteed not to underflow if/when we recurse + go_dn x | isTrue# (x `ltWord64#` y') = W64# x `c` n + | otherwise = W64# x `c` go_dn (x `plusWord64#` delta) + in W64# x1 `c` go_dn x2 + -- | @since 2.01 instance Integral Word64 where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cb851aa47a6ff14ef983283cc605c342f6d70de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cb851aa47a6ff14ef983283cc605c342f6d70de You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 15:15:53 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 28 Jul 2023 11:15:53 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove unnecessary pragmas Message-ID: <64c3dba911e08_37b561ba0682985c3@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: f249403d by Jaro Reinders at 2023-07-28T17:15:37+02:00 Remove unnecessary pragmas - - - - - 9 changed files: - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - compiler/GHC/Utils/Containers/Internal/StrictPair.hs Changes: ===================================== compiler/GHC/Data/Word64Map.hs ===================================== @@ -1,14 +1,8 @@ {-# LANGUAGE CPP #-} -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} -#endif -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} -#endif - -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -1,21 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} -#endif -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} -#endif {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Map.Internal @@ -313,14 +307,12 @@ import qualified GHC.Data.Word64Set.Internal as Word64Set import GHC.Utils.Containers.Internal.BitUtil import GHC.Utils.Containers.Internal.StrictPair -#ifdef __GLASGOW_HASKELL__ import Data.Coerce import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType, gcast1) import GHC.Exts (build) import qualified GHC.Exts as GHCExts import Text.Read -#endif import qualified Control.Category as Category import Data.Word @@ -491,8 +483,6 @@ instance NFData a => NFData (Word64Map a) where rnf (Tip _ v) = rnf v rnf (Bin _ _ l r) = rnf l `seq` rnf r -#if __GLASGOW_HASKELL__ - {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} @@ -515,8 +505,6 @@ fromListConstr = mkConstr intMapDataType "fromList" [] Prefix intMapDataType :: DataType intMapDataType = mkDataType "Data.Word64Map.Internal.Word64Map" [fromListConstr] -#endif - {-------------------------------------------------------------------- Query --------------------------------------------------------------------} @@ -2404,13 +2392,11 @@ map f = go go (Tip k x) = Tip k (f x) go Nil = Nil -#ifdef __GLASGOW_HASKELL__ {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (f . g) xs "map/coerce" map coerce = coerce #-} -#endif -- | \(O(n)\). Map a function over all values in the map. -- @@ -2424,7 +2410,6 @@ mapWithKey f t Tip k x -> Tip k (f k x) Nil -> Nil -#ifdef __GLASGOW_HASKELL__ {-# NOINLINE [1] mapWithKey #-} {-# RULES "mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) = @@ -2434,7 +2419,6 @@ mapWithKey f t "map/mapWithKey" forall f g xs . map f (mapWithKey g xs) = mapWithKey (\k a -> f (g k a)) xs #-} -#endif -- | \(O(n)\). -- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ @@ -3103,13 +3087,11 @@ fromSet f (Word64Set.Tip kx bm) = buildTree f kx bm (Word64Set.suffixBitMask + 1 Lists --------------------------------------------------------------------} -#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance GHCExts.IsList (Word64Map a) where type Item (Word64Map a) = (Key,a) fromList = fromList toList = toList -#endif -- | \(O(n)\). Convert the map to a list of key\/value pairs. Subject to list -- fusion. @@ -3137,7 +3119,6 @@ toDescList :: Word64Map a -> [(Key,a)] toDescList = foldlWithKey (\xs k x -> (k,x):xs) [] -- List fusion for the list generating functions. -#if __GLASGOW_HASKELL__ -- The foldrFB and foldlFB are fold{r,l}WithKey equivalents, used for list fusion. -- They are important to convert unfused methods back, see mapFB in prelude. foldrFB :: (Key -> a -> b -> b) -> b -> Word64Map a -> b @@ -3169,7 +3150,6 @@ foldlFB = foldlWithKey {-# RULES "Word64Map.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-} {-# RULES "Word64Map.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-} {-# RULES "Word64Map.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-} -#endif -- | \(O(n \min(n,W))\). Create a map from a list of key\/value pairs. @@ -3359,11 +3339,9 @@ instance Ord1 Word64Map where instance Functor Word64Map where fmap = map -#ifdef __GLASGOW_HASKELL__ a <$ Bin p m l r = Bin p m (a <$ l) (a <$ r) a <$ Tip k _ = Tip k a _ <$ Nil = Nil -#endif {-------------------------------------------------------------------- Show @@ -3385,19 +3363,12 @@ instance Show1 Word64Map where Read --------------------------------------------------------------------} instance (Read e) => Read (Word64Map e) where -#ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault -#else - readsPrec p = readParen (p > 10) $ \ r -> do - ("fromList",s) <- lex r - (xs,t) <- reads s - return (fromList xs,t) -#endif -- | @since 0.5.9 instance Read1 Word64Map where ===================================== compiler/GHC/Data/Word64Map/Lazy.hs ===================================== @@ -1,9 +1,5 @@ {-# LANGUAGE CPP #-} -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} -#endif - -#include "containers.h" ----------------------------------------------------------------------------- -- | @@ -67,11 +63,7 @@ module GHC.Data.Word64Map.Lazy ( -- * Map type -#if !defined(TESTING) Word64Map, Key -- instance Eq,Show -#else - Word64Map(..), Key -- instance Eq,Show -#endif -- * Construction , empty ===================================== compiler/GHC/Data/Word64Map/Strict.hs ===================================== @@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} -#endif - -#include "containers.h" ----------------------------------------------------------------------------- -- | @@ -86,11 +82,7 @@ module GHC.Data.Word64Map.Strict ( -- * Map type -#if !defined(TESTING) Word64Map, Key -- instance Eq,Show -#else - Word64Map(..), Key -- instance Eq,Show -#endif -- * Construction , empty ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -4,8 +4,6 @@ {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Map.Strict.Internal @@ -86,11 +84,7 @@ module GHC.Data.Word64Map.Strict.Internal ( -- * Map type -#if !defined(TESTING) Word64Map, Key -- instance Eq,Show -#else - Word64Map(..), Key -- instance Eq,Show -#endif -- * Construction , empty @@ -827,13 +821,11 @@ map f = go go (Tip k x) = Tip k $! f x go Nil = Nil -#ifdef __GLASGOW_HASKELL__ {-# NOINLINE [1] map #-} {-# RULES "map/map" forall f g xs . map f (map g xs) = map (\x -> f $! g x) xs "map/mapL" forall f g xs . map f (L.map g xs) = map (\x -> f (g x)) xs #-} -#endif -- | \(O(n)\). Map a function over all values in the map. -- @@ -847,7 +839,6 @@ mapWithKey f t Tip k x -> Tip k $! f k x Nil -> Nil -#ifdef __GLASGOW_HASKELL__ -- Pay close attention to strictness here. We need to force the -- intermediate result for map f . map g, and we need to refrain -- from forcing it for map f . L.map g, etc. @@ -875,7 +866,6 @@ mapWithKey f t "map/mapWithKeyL" forall f g xs . map f (L.mapWithKey g xs) = mapWithKey (\k a -> f (g k a)) xs #-} -#endif -- | \(O(n)\). -- @'traverseWithKey' f s == 'fromList' <$> 'traverse' (\(k, v) -> (,) k <$> f k v) ('toList' m)@ ===================================== compiler/GHC/Data/Word64Set.hs ===================================== @@ -1,9 +1,5 @@ {-# LANGUAGE CPP #-} -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} -#endif - -#include "containers.h" ----------------------------------------------------------------------------- -- | @@ -65,11 +61,7 @@ module GHC.Data.Word64Set ( -- $strictness -- * Set type -#if !defined(TESTING) Word64Set -- instance Eq,Show -#else - Word64Set(..) -- instance Eq,Show -#endif , Key -- * Construction @@ -155,10 +147,6 @@ module GHC.Data.Word64Set ( , showTree , showTreeWith -#if defined(TESTING) - -- * Internals - , match -#endif ) where import GHC.Data.Word64Set.Internal as WS ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -1,19 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} -#ifdef __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} -#endif -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} -#endif {-# OPTIONS_HADDOCK not-home #-} -#include "containers.h" - ----------------------------------------------------------------------------- -- | -- Module : Data.Word64Set.Internal @@ -205,15 +199,11 @@ import Data.Word ( Word64 ) import GHC.Utils.Containers.Internal.BitUtil import GHC.Utils.Containers.Internal.StrictPair -#if __GLASGOW_HASKELL__ import Data.Data (Data(..), Constr, mkConstr, constrIndex, DataType, mkDataType) import qualified Data.Data import Text.Read -#endif -#if __GLASGOW_HASKELL__ import qualified GHC.Exts -#endif import qualified Data.Foldable as Foldable import Data.Functor.Identity (Identity(..)) @@ -279,8 +269,6 @@ instance Semigroup Word64Set where (<>) = union stimes = stimesIdempotentMonoid -#if __GLASGOW_HASKELL__ - {-------------------------------------------------------------------- A Data instance --------------------------------------------------------------------} @@ -302,8 +290,6 @@ fromListConstr = mkConstr intSetDataType "fromList" [] Data.Data.Prefix intSetDataType :: DataType intSetDataType = mkDataType "Data.Word64Set.Internal.Word64Set" [fromListConstr] -#endif - {-------------------------------------------------------------------- Query --------------------------------------------------------------------} @@ -513,15 +499,11 @@ alterF f k s = fmap choose (f member_) choose True = inserted choose False = deleted -#ifndef __GLASGOW_HASKELL__ -{-# INLINE alterF #-} -#else {-# INLINABLE [2] alterF #-} {-# RULES "alterF/Const" forall k (f :: Bool -> Const a Bool) . alterF f k = \s -> Const . getConst . f $ member k s #-} -#endif {-# SPECIALIZE alterF :: (Bool -> Identity Bool) -> Key -> Word64Set -> Identity Word64Set #-} @@ -1139,13 +1121,11 @@ elems Lists --------------------------------------------------------------------} -#ifdef __GLASGOW_HASKELL__ -- | @since 0.5.6.2 instance GHC.Exts.IsList Word64Set where type Item Word64Set = Key fromList = fromList toList = toList -#endif -- | \(O(n)\). Convert the set to a list of elements. Subject to list fusion. toList :: Word64Set -> [Key] @@ -1163,7 +1143,6 @@ toDescList :: Word64Set -> [Key] toDescList = foldl (flip (:)) [] -- List fusion for the list generating functions. -#if __GLASGOW_HASKELL__ -- The foldrFB and foldlFB are foldr and foldl equivalents, used for list fusion. -- They are important to convert unfused to{Asc,Desc}List back, see mapFB in prelude. foldrFB :: (Key -> b -> b) -> b -> Word64Set -> b @@ -1189,7 +1168,6 @@ foldlFB = foldl {-# RULES "Word64Set.toAscListBack" [1] foldrFB (:) [] = toAscList #-} {-# RULES "Word64Set.toDescList" [~1] forall s . toDescList s = GHC.Exts.build (\c n -> foldlFB (\xs x -> c x xs) n s) #-} {-# RULES "Word64Set.toDescListBack" [1] foldlFB (\xs x -> x : xs) [] = toDescList #-} -#endif -- | \(O(n \min(n,W))\). Create a set from a list of integers. @@ -1313,19 +1291,12 @@ instance Show Word64Set where Read --------------------------------------------------------------------} instance Read Word64Set where -#ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP xs <- readPrec return (fromList xs) readListPrec = readListPrecDefault -#else - readsPrec p = readParen (p > 10) $ \ r -> do - ("fromList",s) <- lex r - (xs,t) <- reads s - return (fromList xs,t) -#endif {-------------------------------------------------------------------- NFData @@ -1547,7 +1518,6 @@ takeWhileAntitoneBits :: Word64 -> (Word64 -> Bool) -> Nat -> Nat {-# INLINE foldr'Bits #-} {-# INLINE takeWhileAntitoneBits #-} -#if defined(__GLASGOW_HASKELL__) indexOfTheOnlyBit :: Nat -> Word64 {-# INLINE indexOfTheOnlyBit #-} indexOfTheOnlyBit bitmask = fromIntegral $ countTrailingZeros bitmask @@ -1614,64 +1584,6 @@ takeWhileAntitoneBits prefix predicate bitmap = else ((1 `shiftLL` b) - 1) in bitmap .&. m -#else -{---------------------------------------------------------------------- - In general case we use logarithmic implementation of - lowestBitSet and highestBitSet, which works up to bit sizes of 64. - - Folds are linear scans. -----------------------------------------------------------------------} - -lowestBitSet n0 = - let (n1,b1) = if n0 .&. 0xFFFFFFFF /= 0 then (n0,0) else (n0 `shiftRL` 32, 32) - (n2,b2) = if n1 .&. 0xFFFF /= 0 then (n1,b1) else (n1 `shiftRL` 16, 16+b1) - (n3,b3) = if n2 .&. 0xFF /= 0 then (n2,b2) else (n2 `shiftRL` 8, 8+b2) - (n4,b4) = if n3 .&. 0xF /= 0 then (n3,b3) else (n3 `shiftRL` 4, 4+b3) - (n5,b5) = if n4 .&. 0x3 /= 0 then (n4,b4) else (n4 `shiftRL` 2, 2+b4) - b6 = if n5 .&. 0x1 /= 0 then b5 else 1+b5 - in b6 - -highestBitSet n0 = - let (n1,b1) = if n0 .&. 0xFFFFFFFF00000000 /= 0 then (n0 `shiftRL` 32, 32) else (n0,0) - (n2,b2) = if n1 .&. 0xFFFF0000 /= 0 then (n1 `shiftRL` 16, 16+b1) else (n1,b1) - (n3,b3) = if n2 .&. 0xFF00 /= 0 then (n2 `shiftRL` 8, 8+b2) else (n2,b2) - (n4,b4) = if n3 .&. 0xF0 /= 0 then (n3 `shiftRL` 4, 4+b3) else (n3,b3) - (n5,b5) = if n4 .&. 0xC /= 0 then (n4 `shiftRL` 2, 2+b4) else (n4,b4) - b6 = if n5 .&. 0x2 /= 0 then 1+b5 else b5 - in b6 - -foldlBits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) z (bm `shiftRL` lb) - where go !_ acc 0 = acc - go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1) - | otherwise = go (bi + 1) acc (n `shiftRL` 1) - -foldl'Bits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) z (bm `shiftRL` lb) - where go !_ !acc 0 = acc - go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1) - | otherwise = go (bi + 1) acc (n `shiftRL` 1) - -foldrBits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) (bm `shiftRL` lb) - where go !_ 0 = z - go bi n | n `testBit` 0 = f bi (go (bi + 1) (n `shiftRL` 1)) - | otherwise = go (bi + 1) (n `shiftRL` 1) - -foldr'Bits prefix f z bm = let lb = lowestBitSet bm - in go (prefix+lb) (bm `shiftRL` lb) - where - go !_ 0 = z - go bi n | n `testBit` 0 = f bi $! go (bi + 1) (n `shiftRL` 1) - | otherwise = go (bi + 1) (n `shiftRL` 1) - -takeWhileAntitoneBits prefix predicate = foldl'Bits prefix f 0 -- Does not use antitone property - where - f acc bi | predicate bi = acc .|. bitmapOf bi - | otherwise = acc - -#endif - {-------------------------------------------------------------------- Utilities ===================================== compiler/GHC/Utils/Containers/Internal/BitUtil.hs ===================================== @@ -1,12 +1,6 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash #-} -#endif -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} -#endif - -#include "containers.h" ----------------------------------------------------------------------------- -- | ===================================== compiler/GHC/Utils/Containers/Internal/StrictPair.hs ===================================== @@ -1,9 +1,5 @@ {-# LANGUAGE CPP #-} -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} -#endif - -#include "containers.h" -- | A strict pair View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f249403d15c48533f25a9f9dce5b6af7b8fe6832 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f249403d15c48533f25a9f9dce5b6af7b8fe6832 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 15:50:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 28 Jul 2023 11:50:21 -0400 Subject: [Git][ghc/ghc][ghc-9.8] ghc-prim: Bump version to 0.11 Message-ID: <64c3e3bdc428e_37b561b9fc8310978@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 62cb821e by Ben Gamari at 2023-07-27T13:43:13-04:00 ghc-prim: Bump version to 0.11 - - - - - 9 changed files: - ghc/ghc-bin.cabal.in - libraries/base/base.cabal - libraries/ghc-bignum/ghc-bignum.cabal - libraries/ghc-compact/ghc-compact.cabal - libraries/ghc-heap/ghc-heap.cabal.in - libraries/ghc-prim/ghc-prim.cabal - libraries/ghci/ghci.cabal.in - libraries/text - testsuite/tests/backpack/should_compile/bkp16.stderr Changes: ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -57,7 +57,7 @@ Executable ghc -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: deepseq >= 1.4 && < 1.6, - ghc-prim >= 0.5.0 && < 0.11, + ghc-prim >= 0.5.0 && < 0.12, ghci == @ProjectVersionMunged@, haskeline == 0.8.*, exceptions == 0.10.*, ===================================== libraries/base/base.cabal ===================================== @@ -86,7 +86,7 @@ Library build-depends: rts == 1.0.*, - ghc-prim >= 0.5.1.0 && < 0.11, + ghc-prim >= 0.5.1.0 && < 0.12, ghc-bignum >= 1.0 && < 2.0 exposed-modules: ===================================== libraries/ghc-bignum/ghc-bignum.cabal ===================================== @@ -77,7 +77,7 @@ library ForeignFunctionInterface build-depends: - ghc-prim >= 0.5.1.0 && < 0.11 + ghc-prim >= 0.5.1.0 && < 0.12 hs-source-dirs: src/ include-dirs: include/ ===================================== libraries/ghc-compact/ghc-compact.cabal ===================================== @@ -39,7 +39,7 @@ library UnboxedTuples CPP - build-depends: ghc-prim >= 0.5.3 && < 0.11, + build-depends: ghc-prim >= 0.5.3 && < 0.12, base >= 4.9.0 && < 4.20, bytestring >= 0.10.6.0 && <0.12 ghc-options: -Wall ===================================== libraries/ghc-heap/ghc-heap.cabal.in ===================================== @@ -23,7 +23,7 @@ library default-language: Haskell2010 build-depends: base >= 4.9.0 && < 5.0 - , ghc-prim > 0.2 && < 0.11 + , ghc-prim > 0.2 && < 0.12 , rts == 1.0.* , containers >= 0.6.2.1 && < 0.7 ===================================== libraries/ghc-prim/ghc-prim.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 2.2 name: ghc-prim -version: 0.10.0 +version: 0.11.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause license-file: LICENSE ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -76,7 +76,7 @@ library rts, array == 0.5.*, base >= 4.8 && < 4.20, - ghc-prim >= 0.5.0 && < 0.11, + ghc-prim >= 0.5.0 && < 0.12, binary == 0.8.*, bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit deaaef6216d3df524f8b998c54b317478094473c +Subproject commit fe14df3f578cd49cb72555f25c49843a8671dfd2 ===================================== testsuite/tests/backpack/should_compile/bkp16.stderr ===================================== @@ -2,8 +2,8 @@ [1 of 1] Compiling Int[sig] ( p/Int.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[Int=base-4.17.0.0:GHC.Exts] - Instantiating p[Int=base-4.17.0.0:GHC.Exts] - [1 of 1] Including ghc-prim-0.10.0 + [1 of 1] Including p[Int=base-4.19.0.0:GHC.Exts] + Instantiating p[Int=base-4.19.0.0:GHC.Exts] + [1 of 1] Including ghc-prim-0.11.0 [1 of 1] Compiling Int[sig] ( p/Int.hsig, bkp16.out/p/p-97PZnzqiJmd2hTwUNGdjod/Int.o ) [1 of 1] Instantiating p View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62cb821ef2ef0d47c4cf88a6f2aeb7f75106d361 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62cb821ef2ef0d47c4cf88a6f2aeb7f75106d361 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 15:50:52 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 28 Jul 2023 11:50:52 -0400 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.8.1-alpha1 Message-ID: <64c3e3dc9d239_37b561c5bcb403111cf@gitlab.mail> Ben Gamari pushed new tag ghc-9.8.1-alpha1 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.8.1-alpha1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 16:52:33 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 28 Jul 2023 12:52:33 -0400 Subject: [Git][ghc/ghc][wip/T22404] Define JoinPointHood and use it Message-ID: <64c3f2518eaa6_37b561ba068324794@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 68e92a9a by Simon Peyton Jones at 2023-07-28T17:51:50+01:00 Define JoinPointHood and use it - - - - - 26 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -604,10 +604,10 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty -- Check that a join-point binder has a valid type -- NB: lintIdBinder has checked that it is not top-level bound - ; case isJoinId_maybe binder of - Nothing -> return () - Just arity -> checkL (isValidJoinPointType arity binder_ty) - (mkInvalidJoinPointMsg binder binder_ty) + ; case idJoinPointHood binder of + NotJoinPoint -> return () + JoinPoint arity -> checkL (isValidJoinPointType arity binder_ty) + (mkInvalidJoinPointMsg binder binder_ty) ; when (lf_check_inline_loop_breakers flags && isStableUnfolding (realIdUnfolding binder) @@ -662,7 +662,7 @@ lintRhs :: Id -> CoreExpr -> LintM (LintedType, UsageEnv) -- NB: the Id can be Linted or not -- it's only used for -- its OccInfo and join-pointer-hood lintRhs bndr rhs - | Just arity <- isJoinId_maybe bndr + | JoinPoint arity <- idJoinPointHood bndr = lintJoinLams arity (Just bndr) rhs | AlwaysTailCalled arity <- tailCallInfo (idOccInfo bndr) = lintJoinLams arity Nothing rhs @@ -1085,7 +1085,7 @@ lintJoinBndrType :: LintedType -- Type of the body -- E.g. join j x = rhs in body -- The type of 'rhs' must be the same as the type of 'body' lintJoinBndrType body_ty bndr - | Just arity <- isJoinId_maybe bndr + | JoinPoint arity <- idJoinPointHood bndr , let bndr_ty = idType bndr , (bndrs, res) <- splitPiTys bndr_ty = checkL (length bndrs >= arity @@ -1101,15 +1101,14 @@ checkJoinOcc :: Id -> JoinArity -> LintM () -- Check that if the occurrence is a JoinId, then so is the -- binding site, and it's a valid join Id checkJoinOcc var n_args - | Just join_arity_occ <- isJoinId_maybe var + | JoinPoint join_arity_occ <- idJoinPointHood var = do { mb_join_arity_bndr <- lookupJoinId var ; case mb_join_arity_bndr of { - Nothing -> -- Binder is not a join point - do { join_set <- getValidJoins - ; addErrL (text "join set " <+> ppr join_set $$ - invalidJoinOcc var) } ; + NotJoinPoint -> do { join_set <- getValidJoins + ; addErrL (text "join set " <+> ppr join_set $$ + invalidJoinOcc var) } ; - Just join_arity_bndr -> + JoinPoint join_arity_bndr -> do { checkL (join_arity_bndr == join_arity_occ) $ -- Arity differs at binding site and occurrence @@ -2109,8 +2108,8 @@ lintCoreRule fun fun_ty rule@(Rule { ru_name = name, ru_bndrs = bndrs , ru_args = args, ru_rhs = rhs }) = lintBinders LambdaBind bndrs $ \ _ -> do { (lhs_ty, _) <- lintCoreArgs (fun_ty, zeroUE) args - ; (rhs_ty, _) <- case isJoinId_maybe fun of - Just join_arity + ; (rhs_ty, _) <- case idJoinPointHood fun of + JoinPoint join_arity -> do { checkL (args `lengthIs` join_arity) $ mkBadJoinPointRuleMsg fun join_arity rule -- See Note [Rules for join points] @@ -3373,14 +3372,14 @@ lookupIdInScope id_occ -- wired-in Ids after worker/wrapper -- So we simply disable the test in this case -lookupJoinId :: Id -> LintM (Maybe JoinArity) +lookupJoinId :: Id -> LintM JoinPointHood -- Look up an Id which should be a join point, valid here -- If so, return its arity, if not return Nothing lookupJoinId id = do { join_set <- getValidJoins ; case lookupVarSet join_set id of - Just id' -> return (isJoinId_maybe id') - Nothing -> return Nothing } + Just id' -> return (idJoinPointHood id') + Nothing -> return NotJoinPoint } addAliasUE :: Id -> UsageEnv -> LintM a -> LintM a addAliasUE id ue thing_inside = LintM $ \ env errs -> ===================================== compiler/GHC/Core/Opt/CSE.hs ===================================== @@ -14,7 +14,7 @@ import GHC.Types.Var.Env ( mkInScopeSet ) import GHC.Types.Id ( Id, idType, idHasRules, zapStableUnfolding , idInlineActivation, setInlineActivation , zapIdOccInfo, zapIdUsageInfo, idInlinePragma - , isJoinId, isJoinId_maybe, idUnfolding ) + , isJoinId, idJoinPointHood, idUnfolding ) import GHC.Core.Utils ( mkAltExpr , exprIsTickedString , stripTicksE, stripTicksT, mkTicks ) @@ -436,7 +436,7 @@ cse_bind toplevel env_rhs env_body (in_id, in_rhs) out_id -- See Note [Take care with literal strings] = (env_body', (out_id', in_rhs)) - | Just arity <- isJoinId_maybe out_id + | JoinPoint arity <- idJoinPointHood out_id -- See Note [Look inside join-point binders] = let (params, in_body) = collectNBinders arity in_rhs (env', params') = addBinders env_rhs params ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -1130,9 +1130,9 @@ splitWeakDmds (DE fvs div) = (DE sig_fvs div, weak_fvs) thresholdArity :: Id -> CoreExpr -> Arity -- See Note [Demand signatures are computed for a threshold arity based on idArity] thresholdArity fn rhs - = case isJoinId_maybe fn of - Just join_arity -> count isId $ fst $ collectNBinders join_arity rhs - Nothing -> idArity fn + = case idJoinPointHood fn of + JoinPoint join_arity -> count isId $ fst $ collectNBinders join_arity rhs + NotJoinPoint -> idArity fn -- | The result type after applying 'idArity' many arguments. Returns 'Nothing' -- when the type doesn't have exactly 'idArity' many arrows. ===================================== compiler/GHC/Core/Opt/Exitify.hs ===================================== @@ -36,20 +36,24 @@ Now `t` is no longer in a recursive function, and good things happen! -} import GHC.Prelude +import GHC.Builtin.Uniques +import GHC.Core +import GHC.Core.Utils +import GHC.Core.FVs +import GHC.Core.Type + import GHC.Types.Var import GHC.Types.Id import GHC.Types.Id.Info -import GHC.Core -import GHC.Core.Utils -import GHC.Utils.Monad.State.Strict -import GHC.Builtin.Uniques import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Core.FVs -import GHC.Data.FastString -import GHC.Core.Type +import GHC.Types.Basic( JoinPointHood(..) ) + +import GHC.Utils.Monad.State.Strict import GHC.Utils.Misc( mapSnd ) +import GHC.Data.FastString + import Data.Bifunctor import Control.Monad @@ -160,7 +164,7 @@ exitifyRec in_scope pairs go captured (_, AnnLet ann_bind body) -- join point, RHS and body are in tail-call position | AnnNonRec j rhs <- ann_bind - , Just join_arity <- isJoinId_maybe j + , JoinPoint join_arity <- idJoinPointHood j = do let (params, join_body) = collectNAnnBndrs join_arity rhs join_body' <- go (captured ++ params) join_body let rhs' = mkLams params join_body' ===================================== compiler/GHC/Core/Opt/FloatIn.hs ===================================== @@ -29,7 +29,7 @@ import GHC.Core.FVs import GHC.Core.Type import GHC.Types.Basic ( RecFlag(..), isRec ) -import GHC.Types.Id ( idType, isJoinId, isJoinId_maybe ) +import GHC.Types.Id ( idType, isJoinId, idJoinPointHood ) import GHC.Types.Tickish import GHC.Types.Var import GHC.Types.Var.Set @@ -599,7 +599,7 @@ fiBind platform to_drop (AnnRec bindings) body_fvs ------------------ fiRhs :: Platform -> RevFloatInBinds -> CoreBndr -> CoreExprWithFVs -> CoreExpr fiRhs platform to_drop bndr rhs - | Just join_arity <- isJoinId_maybe bndr + | JoinPoint join_arity <- idJoinPointHood bndr , let (bndrs, body) = collectNAnnBndrs join_arity rhs = mkLams bndrs (fiExpr platform to_drop body) | otherwise ===================================== compiler/GHC/Core/Opt/FloatOut.hs ===================================== @@ -22,7 +22,7 @@ import GHC.Driver.Flags ( DumpFlag (..) ) import GHC.Utils.Logger import GHC.Types.Id ( Id, idType, -- idArity, isDeadEndId, - isJoinId, isJoinId_maybe ) + isJoinId, idJoinPointHood ) import GHC.Types.Tickish import GHC.Core.Opt.SetLevels import GHC.Types.Unique.Supply ( UniqSupply ) @@ -487,7 +487,7 @@ floatRhs :: CoreBndr -> LevelledExpr -> (FloatStats, FloatBinds, CoreExpr) floatRhs bndr rhs - | Just join_arity <- isJoinId_maybe bndr + | JoinPoint join_arity <- idJoinPointHood bndr , Just (bndrs, body) <- try_collect join_arity rhs [] = case bndrs of [] -> floatExpr rhs ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) -import GHC.Data.Maybe( isJust, orElse ) +import GHC.Data.Maybe( orElse ) import GHC.Data.Graph.Directed ( SCC(..), Node(..) , stronglyConnCompFromEdgedVerticesUniq , stronglyConnCompFromEdgedVerticesUniqR ) @@ -982,7 +982,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- /Existing/ non-recursive join points -- See Note [Occurrence analysis for join points] - | mb_join@(Just {}) <- isJoinId_maybe bndr + | mb_join@(JoinPoint {}) <- idJoinPointHood bndr = -- Analyse the RHS and /then/ the body let -- Analyse the rhs first, generating rhs_uds !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs @@ -997,7 +997,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine if isDeadOcc occ -- Drop dead code; see Note [Dead code] then WUD body_uds body else WUD (rhs_uds `orUDs` body_uds) -- Note `orUDs` - (combine [NonRec (tagNonRecBinder lvl occ bndr') rhs'] + (combine [NonRec (fst (tagNonRecBinder lvl occ bndr')) rhs'] body) -- The normal case, including newly-discovered join points @@ -1009,10 +1009,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine -- Get the join info from the *new* decision; NB: bndr is not already a JoinId -- See Note [Join points and unfoldings/rules] -- => join arity O of Note [Join arity prediction based on joinRhsArity] - tagged_bndr = tagNonRecBinder lvl occ bndr - mb_join = case tailCallInfo occ of - AlwaysTailCalled arity -> Just arity - _ -> Nothing + (tagged_bndr, mb_join) = tagNonRecBinder lvl occ bndr !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs` @@ -1029,7 +1026,7 @@ occAnalNonRecBody env bndr thing_inside in WUD inner_uds (occ, res) ----------------- -occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> Maybe JoinArity +occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> JoinPointHood -> Id -> CoreExpr -> ([UsageDetails], Id, CoreExpr) occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs @@ -1040,7 +1037,7 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs | otherwise = (adj_rhs_uds : adj_unf_uds : adj_rule_uds, final_bndr_with_rules, final_rhs ) where - is_join_point = isJust mb_join + is_join_point = isJoinPoint mb_join --------- Right hand side --------- -- For join points, set occ_encl to OccVanilla, via setTailCtxt. If we have @@ -1147,10 +1144,9 @@ occAnalRec !_ lvl | isDeadOcc occ -- Check for dead code: see Note [Dead code] = WUD body_uds binds | otherwise - = let tagged_bndr = tagNonRecBinder lvl occ bndr - mb_join_arity = willBeJoinId_maybe tagged_bndr - !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join_arity wtuds - !unf' = markNonRecUnfoldingOneShots mb_join_arity (idUnfolding tagged_bndr) + = let (tagged_bndr, mb_join) = tagNonRecBinder lvl occ bndr + !(WUD rhs_uds' rhs') = adjustNonRecRhs mb_join wtuds + !unf' = markNonRecUnfoldingOneShots mb_join (idUnfolding tagged_bndr) !bndr' = tagged_bndr `setIdUnfolding` unf' in WUD (body_uds `andUDs` rhs_uds') (NonRec bndr' rhs' : binds) @@ -1768,7 +1764,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness -- here because that is what we are setting! WTUD unf_tuds unf' = occAnalUnfolding rhs_env unf - adj_unf_uds = adjustTailArity (Just rhs_ja) unf_tuds + adj_unf_uds = adjustTailArity (JoinPoint rhs_ja) unf_tuds -- `rhs_ja` is `joinRhsArity rhs` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] @@ -1783,7 +1779,7 @@ makeNode !env imp_rule_edges bndr_set (bndr, rhs) -- `rhs_ja` is `joinRhsArity rhs'` and is the prediction for source M -- of Note [Join arity prediction based on joinRhsArity] rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] - rules_w_uds = [ (r,l,adjustTailArity (Just rhs_ja) rhs_wuds) + rules_w_uds = [ (r,l,adjustTailArity (JoinPoint rhs_ja) rhs_wuds) | rule <- idCoreRules bndr , let (r,l,rhs_wuds) = occAnalRule rhs_env rule ] rules' = map fstOf3 rules_w_uds @@ -2537,7 +2533,7 @@ occAnal env app@(App _ _) = occAnalApp env (collectArgsTicks tickishFloatable app) occAnal env expr@(Lam {}) - = adjustNonRecRhs Nothing $ -- Nothing <=> markAllManyNonTail + = adjustNonRecRhs NotJoinPoint $ -- NotJoinPoint <=> markAllManyNonTail occAnalLamTail env expr occAnal env (Case scrut bndr ty alts) @@ -2630,7 +2626,7 @@ occAnalApp !env (Var fun, args, ticks) -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , WUD usage arg' <- adjustNonRecRhs (Just 1) $ occAnalLamTail env arg + , WUD usage arg' <- adjustNonRecRhs (JoinPoint 1) $ occAnalLamTail env arg = WUD usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun_id, args, ticks) @@ -3704,7 +3700,7 @@ lookupOccInfoByUnique (UD { ud_env = env ------------------- -- See Note [Adjusting right-hand sides] -adjustNonRecRhs :: Maybe JoinArity +adjustNonRecRhs :: JoinPointHood -> WithTailUsageDetails CoreExpr -> WithUsageDetails CoreExpr -- ^ This function concentrates shared logic between occAnalNonRecBind and the @@ -3715,13 +3711,13 @@ adjustNonRecRhs mb_join_arity rhs_wuds@(WTUD _ rhs) = WUD rhs_uds' rhs' where --------- Marking (non-rec) join binders one-shot --------- - !rhs' | Just ja <- mb_join_arity = markNonRecJoinOneShots ja rhs - | otherwise = rhs + !rhs' | JoinPoint ja <- mb_join_arity = markNonRecJoinOneShots ja rhs + | otherwise = rhs --------- Adjusting right-hand side usage --------- rhs_uds' = adjustTailUsage mb_join_arity rhs_wuds -adjustTailUsage :: Maybe JoinArity +adjustTailUsage :: JoinPointHood -> WithTailUsageDetails CoreExpr -- Rhs usage, AFTER occAnalLamTail -> UsageDetails adjustTailUsage mb_join_arity (WTUD (TUD rhs_ja uds) rhs) @@ -3731,11 +3727,11 @@ adjustTailUsage mb_join_arity (WTUD (TUD rhs_ja uds) rhs) uds where one_shot = isOneShotFun rhs - exact_join = mb_join_arity == Just rhs_ja + exact_join = mb_join_arity == JoinPoint rhs_ja -adjustTailArity :: Maybe JoinArity -> TailUsageDetails -> UsageDetails +adjustTailArity :: JoinPointHood -> TailUsageDetails -> UsageDetails adjustTailArity mb_rhs_ja (TUD ja usage) - = markAllNonTailIf (mb_rhs_ja /= Just ja) usage + = markAllNonTailIf (mb_rhs_ja /= JoinPoint ja) usage markNonRecJoinOneShots :: JoinArity -> CoreExpr -> CoreExpr -- For a /non-recursive/ join point we can mark all @@ -3753,10 +3749,10 @@ markNonRecJoinOneShots join_arity rhs -- enough lambdas /yet/. (Lint checks that JoinIds do -- have enough lambdas.) -markNonRecUnfoldingOneShots :: Maybe JoinArity -> Unfolding -> Unfolding +markNonRecUnfoldingOneShots :: JoinPointHood -> Unfolding -> Unfolding -- ^ Apply 'markNonRecJoinOneShots' to a stable unfolding markNonRecUnfoldingOneShots mb_join_arity unf - | Just ja <- mb_join_arity + | JoinPoint ja <- mb_join_arity , CoreUnfolding{uf_src=src,uf_tmpl=tmpl} <- unf , isStableSource src , let !tmpl' = markNonRecJoinOneShots ja tmpl @@ -3787,17 +3783,18 @@ tagLamBinder usage bndr tagNonRecBinder :: TopLevelFlag -- At top level? -> OccInfo -- Of scope -> CoreBndr -- Binder - -> IdWithOccInfo -- Tagged binder + -> (IdWithOccInfo, JoinPointHood) -- Tagged binder -- No-op on TyVars -- Precondition: OccInfo is not IAmDead tagNonRecBinder lvl occ bndr - = setBinderOcc occ' bndr + | okForJoinPoint lvl bndr tail_call_info + , AlwaysTailCalled ar <- tail_call_info + = (setBinderOcc occ bndr, JoinPoint ar) + | otherwise + = (setBinderOcc zapped_occ bndr, NotJoinPoint) where - will_be_join = okForJoinPoint lvl bndr (tailCallInfo occ) - occ' | will_be_join = -- Must already be marked AlwaysTailCalled, unless - -- it was a join point before but is now dead - warnPprTrace (not (isAlwaysTailCalled occ)) "tagNonRecBinder" (ppr bndr <+> ppr occ) occ - | otherwise = markNonTail occ + tail_call_info = tailCallInfo occ + zapped_occ = markNonTail occ tagRecBinders :: TopLevelFlag -- At top level? -> UsageDetails -- Of body of let ONLY @@ -3817,11 +3814,11 @@ tagRecBinders lvl body_uds details_s -- This (re-)asserts that makeNode had made tuds for that same arity M! unadj_uds = foldr (andUDs . test_manifest_arity) body_uds details_s test_manifest_arity ND{nd_rhs = WTUD tuds rhs} - = adjustTailArity (Just (joinRhsArity rhs)) tuds + = adjustTailArity (JoinPoint (joinRhsArity rhs)) tuds will_be_joins = decideRecJoinPointHood lvl unadj_uds bndrs - mb_join_arity :: Id -> Maybe JoinArity + mb_join_arity :: Id -> JoinPointHood -- mb_join_arity: See Note [Join arity prediction based on joinRhsArity] -- This is the source O mb_join_arity bndr @@ -3829,10 +3826,10 @@ tagRecBinders lvl body_uds details_s -- the binder yet (the tag depends on these adjustments!) | will_be_joins , AlwaysTailCalled arity <- lookupTailCallInfo unadj_uds bndr - = Just arity + = JoinPoint arity | otherwise = assert (not will_be_joins) -- Should be AlwaysTailCalled if - Nothing -- we are making join points! + NotJoinPoint -- we are making join points! -- 2. Adjust usage details of each RHS, taking into account the -- join-point-hood decision @@ -3903,7 +3900,7 @@ okForJoinPoint lvl bndr tail_call_info | otherwise = False - lost_join | Just ja <- isJoinId_maybe bndr + lost_join | JoinPoint ja <- idJoinPointHood bndr = not valid_join || (case tail_call_info of -- Valid join but arity differs AlwaysTailCalled ja' -> ja /= ja' @@ -3934,15 +3931,6 @@ okForJoinPoint lvl bndr tail_call_info , text "ok_type:" <+> ppr (isValidJoinPointType arity (idType bndr)) ] _ -> empty ] -willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity -willBeJoinId_maybe bndr - | isId bndr - , AlwaysTailCalled arity <- tailCallInfo (idOccInfo bndr) - = Just arity - | otherwise - = isJoinId_maybe bndr - - {- Note [Join points and INLINE pragmas] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -322,7 +322,7 @@ lvl_top :: LevelEnv -> RecFlag -> Id -> CoreExpr -- there is no need call substAndLvlBndrs here lvl_top env is_rec bndr rhs = do { rhs' <- lvlRhs env is_rec (isDeadEndId bndr) - Nothing -- Not a join point + NotJoinPoint (freeVars rhs) ; return (stayPut tOP_LEVEL bndr, rhs') } @@ -666,9 +666,9 @@ lvlMFE env strict_ctxt ann_expr -- No wrapping needed if the type is lifted, or is a literal string -- or if we are wrapping it in one or more value lambdas = do { expr1 <- lvlFloatRhs abs_vars dest_lvl rhs_env NonRecursive - is_bot_lam join_arity_maybe ann_expr + is_bot_lam NotJoinPoint ann_expr -- Treat the expr just like a right-hand side - ; var <- newLvlVar expr1 join_arity_maybe is_mk_static + ; var <- newLvlVar expr1 NotJoinPoint is_mk_static ; let var2 = annotateBotStr var float_n_lams mb_bot_str ; return (Let (NonRec (TB var2 (FloatMe dest_lvl)) expr1) (mkVarApps (Var var2) abs_vars)) } @@ -689,7 +689,7 @@ lvlMFE env strict_ctxt ann_expr Case expr1 (stayPut l1r ubx_bndr) box_ty [Alt DEFAULT [] (App boxing_expr (Var ubx_bndr))] - ; var <- newLvlVar float_rhs Nothing is_mk_static + ; var <- newLvlVar float_rhs NotJoinPoint is_mk_static ; let l1u = incMinorLvlFrom env use_expr = Case (mkVarApps (Var var) abs_vars) (stayPut l1u bx_bndr) expr_ty @@ -726,8 +726,6 @@ lvlMFE env strict_ctxt ann_expr (rhs_env, abs_vars_w_lvls) = lvlLamBndrs env dest_lvl abs_vars - join_arity_maybe = Nothing - is_mk_static = isJust (collectMakeStaticArgs expr) -- Yuk: See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable @@ -1177,8 +1175,8 @@ lvlBind env (AnnNonRec bndr rhs) -- NB: not isBottomThunk! See Note [Bottoming floats] point (3) n_extra = count isId abs_vars - mb_join_arity = isJoinId_maybe bndr - is_join = isJust mb_join_arity + mb_join_arity = idJoinPointHood bndr + is_join = isJoinPoint mb_join_arity lvlBind env (AnnRec pairs) | floatTopLvlOnly env && not (isTopLvl dest_lvl) @@ -1193,7 +1191,7 @@ lvlBind env (AnnRec pairs) = -- No float do { let bind_lvl = incMinorLvl (le_ctxt_lvl env) (env', bndrs') = substAndLvlBndrs Recursive env bind_lvl bndrs - lvl_rhs (b,r) = lvlRhs env' Recursive is_bot (isJoinId_maybe b) r + lvl_rhs (b,r) = lvlRhs env' Recursive is_bot (idJoinPointHood b) r ; rhss' <- mapM lvl_rhs pairs ; return (Rec (bndrs' `zip` rhss'), env') } @@ -1256,8 +1254,8 @@ lvlBind env (AnnRec pairs) is_bot (get_join bndr) rhs - get_join bndr | need_zap = Nothing - | otherwise = isJoinId_maybe bndr + get_join bndr | need_zap = NotJoinPoint + | otherwise = idJoinPointHood bndr need_zap = dest_lvl `ltLvl` joinCeilingLevel env -- Finding the free vars of the binding group is annoying @@ -1284,7 +1282,7 @@ profitableFloat env dest_lvl lvlRhs :: LevelEnv -> RecFlag -> Bool -- Is this a bottoming function - -> Maybe JoinArity + -> JoinPointHood -> CoreExprWithFVs -> LvlM LevelledExpr lvlRhs env rec_flag is_bot mb_join_arity expr @@ -1293,7 +1291,7 @@ lvlRhs env rec_flag is_bot mb_join_arity expr lvlFloatRhs :: [OutVar] -> Level -> LevelEnv -> RecFlag -> Bool -- Binding is for a bottoming function - -> Maybe JoinArity + -> JoinPointHood -> CoreExprWithFVs -> LvlM (Expr LevelledBndr) -- Ignores the le_ctxt_lvl in env; treats dest_lvl as the baseline @@ -1304,13 +1302,13 @@ lvlFloatRhs abs_vars dest_lvl env rec is_bot mb_join_arity rhs else lvlExpr body_env body ; return (mkLams bndrs' body') } where - (bndrs, body) | Just join_arity <- mb_join_arity + (bndrs, body) | JoinPoint join_arity <- mb_join_arity = collectNAnnBndrs join_arity rhs | otherwise = collectAnnBndrs rhs (env1, bndrs1) = substBndrsSL NonRecursive env bndrs all_bndrs = abs_vars ++ bndrs1 - (body_env, bndrs') | Just _ <- mb_join_arity + (body_env, bndrs') | JoinPoint {} <- mb_join_arity = lvlJoinBndrs env1 dest_lvl rec all_bndrs | otherwise = case lvlLamBndrs env1 dest_lvl all_bndrs of @@ -1741,14 +1739,14 @@ newPolyBndrs dest_lvl -- but we may need to adjust its arity dest_is_top = isTopLvl dest_lvl transfer_join_info bndr new_bndr - | Just join_arity <- isJoinId_maybe bndr + | JoinPoint join_arity <- idJoinPointHood bndr , not dest_is_top = new_bndr `asJoinId` join_arity + length abs_vars | otherwise = new_bndr newLvlVar :: LevelledExpr -- The RHS of the new binding - -> Maybe JoinArity -- Its join arity, if it is a join point + -> JoinPointHood -- Its join arity, if it is a join point -> Bool -- True <=> the RHS looks like (makeStatic ...) -> LvlM Id newLvlVar lvld_rhs join_arity_maybe is_mk_static ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -373,7 +373,7 @@ type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr -- | A substitution result. data SimplSR - = DoneEx OutExpr (Maybe JoinArity) + = DoneEx OutExpr JoinPointHood -- If x :-> DoneEx e ja is in the SimplIdSubst -- then replace occurrences of x by e -- and ja = Just a <=> x is a join-point of arity a @@ -398,8 +398,8 @@ instance Outputable SimplSR where ppr (DoneEx e mj) = text "DoneEx" <> pp_mj <+> ppr e where pp_mj = case mj of - Nothing -> empty - Just n -> parens (int n) + NotJoinPoint -> empty + JoinPoint n -> parens (int n) ppr (ContEx _tv _cv _id e) = vcat [text "ContEx" <+> ppr e {-, ppr (filter_env tv), ppr (filter_env id) -}] ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -425,7 +425,7 @@ simplAuxBind env bndr new_rhs = return ( emptyFloats env , case new_rhs of Coercion co -> extendCvSubst env bndr co - _ -> extendIdSubst env bndr (DoneEx new_rhs Nothing) ) + _ -> extendIdSubst env bndr (DoneEx new_rhs NotJoinPoint) ) | otherwise = do { -- ANF-ise the RHS @@ -625,7 +625,7 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co) then do { tick (PostInlineUnconditionally bndr) ; return ( floats , extendIdSubst (setInScopeFromF env floats) old_bndr $ - DoneEx triv_rhs Nothing ) } + DoneEx triv_rhs NotJoinPoint ) } else do { wrap_unf <- mkLetUnfolding uf_opts top_lvl VanillaSrc bndr triv_rhs ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr) @@ -961,7 +961,7 @@ completeBind env bind_cxt old_bndr new_bndr new_rhs ; simplTrace "PostInlineUnconditionally" (ppr new_bndr <+> ppr unf_rhs) $ return ( emptyFloats env , extendIdSubst env old_bndr $ - DoneEx unf_rhs (isJoinId_maybe new_bndr)) } + DoneEx unf_rhs (idJoinPointHood new_bndr)) } -- Use the substitution to make quite, quite sure that the -- substitution will happen, since we are going to discard the binding @@ -1303,7 +1303,7 @@ work. T5631 is a good example of this. simplJoinRhs :: SimplEnv -> InId -> InExpr -> SimplCont -> SimplM OutExpr simplJoinRhs env bndr expr cont - | Just arity <- isJoinId_maybe bndr + | JoinPoint arity <- idJoinPointHood bndr = do { let (join_bndrs, join_body) = collectNBinders arity expr mult = contHoleScaling cont ; (env', join_bndrs') <- simplLamBndrs env (map (scaleVarBy mult) join_bndrs) @@ -1985,14 +1985,14 @@ wrapJoinCont env cont thing_inside -------------------- trimJoinCont :: Id -- Used only in error message - -> Maybe JoinArity + -> JoinPointHood -> SimplCont -> SimplCont -- Drop outer context from join point invocation (jump) -- See Note [Join points and case-of-case] -trimJoinCont _ Nothing cont +trimJoinCont _ NotJoinPoint cont = cont -- Not a jump -trimJoinCont var (Just arity) cont +trimJoinCont var (JoinPoint arity) cont = trim arity cont where trim 0 cont@(Stop {}) @@ -2139,7 +2139,7 @@ simplIdF env var cont DoneId var1 -> do { rule_base <- getSimplRules - ; let cont' = trimJoinCont var1 (isJoinId_maybe var1) cont + ; let cont' = trimJoinCont var1 (idJoinPointHood var1) cont info = mkArgInfo env rule_base var1 cont' ; rebuildCall env info cont' } @@ -3260,7 +3260,7 @@ improveSeq :: (FamInstEnv, FamInstEnv) -> SimplEnv improveSeq fam_envs env scrut case_bndr case_bndr1 [Alt DEFAULT _ _] | Just (Reduction co ty2) <- topNormaliseType_maybe fam_envs (idType case_bndr1) = do { case_bndr2 <- newId (fsLit "nt") ManyTy ty2 - ; let rhs = DoneEx (Var case_bndr2 `Cast` mkSymCo co) Nothing + ; let rhs = DoneEx (Var case_bndr2 `Cast` mkSymCo co) NotJoinPoint env2 = extendIdSubst env case_bndr rhs ; return (env2, scrut `Cast` co, case_bndr2) } @@ -3549,7 +3549,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont bind_case_bndr env | isDeadBinder bndr = return (emptyFloats env, env) | exprIsTrivial scrut = return (emptyFloats env - , extendIdSubst env bndr (DoneEx scrut Nothing)) + , extendIdSubst env bndr (DoneEx scrut NotJoinPoint)) -- See Note [Do not duplicate constructor applications] | otherwise = do { dc_args <- mapM (simplVar env) bs -- dc_ty_args are already OutTypes, @@ -4463,11 +4463,11 @@ simplRules env mb_new_id rules bind_cxt -- binder matches that of the rule, so that pushing the -- continuation into the RHS makes sense join_ok = case mb_new_id of - Just id | Just join_arity <- isJoinId_maybe id + Just id | JoinPoint join_arity <- idJoinPointHood id -> length args == join_arity _ -> False bad_join_msg = vcat [ ppr mb_new_id, ppr rule - , ppr (fmap isJoinId_maybe mb_new_id) ] + , ppr (fmap idJoinPointHood mb_new_id) ] ; args' <- mapM (simplExpr lhs_env) args ; rhs' <- simplExprC rhs_env rhs rhs_cont ===================================== compiler/GHC/Core/Opt/SpecConstr.hs ===================================== @@ -1941,8 +1941,8 @@ spec_one env fn arg_bndrs body (call_pat, rule_number) = calcSpecInfo fn arg_bndrs call_pat extra_bndrs spec_arity = count isId spec_lam_args - spec_join_arity | isJoinId fn = Just (length spec_call_args) - | otherwise = Nothing + spec_join_arity | isJoinId fn = JoinPoint (length spec_call_args) + | otherwise = NotJoinPoint spec_id = asWorkerLikeId $ mkLocalId spec_name ManyTy (mkLamTypes spec_lam_args spec_body_ty) ===================================== compiler/GHC/Core/Opt/WorkWrap.hs ===================================== @@ -830,8 +830,8 @@ mkWWBindPair ww_opts fn_id fn_info fn_args fn_body work_uniq div -- inl_act: see Note [Worker activation] -- inl_rule: it does not make sense for workers to be constructorlike. - work_join_arity | isJoinId fn_id = Just join_arity - | otherwise = Nothing + work_join_arity | isJoinId fn_id = JoinPoint join_arity + | otherwise = NotJoinPoint -- worker is join point iff wrapper is join point -- (see Note [Don't w/w join points for CPR]) ===================================== compiler/GHC/Core/Ppr.hs ===================================== @@ -44,7 +44,6 @@ import GHC.Core.TyCon import GHC.Core.TyCo.Ppr import GHC.Core.Coercion import GHC.Types.Basic -import GHC.Data.Maybe import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Types.SrcLoc ( pprUserRealSpan ) @@ -140,8 +139,8 @@ ppr_binding ann (val_bdr, expr) pp_val_bdr = pprPrefixOcc val_bdr pp_bind = case bndrIsJoin_maybe val_bdr of - Nothing -> pp_normal_bind - Just ar -> pp_join_bind ar + NotJoinPoint -> pp_normal_bind + JoinPoint ar -> pp_join_bind ar pp_normal_bind = hang pp_val_bdr 2 (equals <+> pprCoreExpr expr) @@ -306,12 +305,12 @@ ppr_expr add_par (Let bind expr) pprCoreExpr expr] where keyword (NonRec b _) - | isJust (bndrIsJoin_maybe b) = text "join" - | otherwise = text "let" + | isJoinPoint (bndrIsJoin_maybe b) = text "join" + | otherwise = text "let" keyword (Rec pairs) | ((b,_):_) <- pairs - , isJust (bndrIsJoin_maybe b) = text "joinrec" - | otherwise = text "letrec" + , isJoinPoint (bndrIsJoin_maybe b) = text "joinrec" + | otherwise = text "letrec" ppr_expr add_par (Tick tickish expr) = sdocOption sdocSuppressTicks $ \case @@ -382,13 +381,13 @@ instance OutputableBndr Var where pprBndr = pprCoreBinder pprInfixOcc = pprInfixName . varName pprPrefixOcc = pprPrefixName . varName - bndrIsJoin_maybe = isJoinId_maybe + bndrIsJoin_maybe = idJoinPointHood instance Outputable b => OutputableBndr (TaggedBndr b) where pprBndr _ b = ppr b -- Simple pprInfixOcc b = ppr b pprPrefixOcc b = ppr b - bndrIsJoin_maybe (TB b _) = isJoinId_maybe b + bndrIsJoin_maybe (TB b _) = idJoinPointHood b pprOcc :: OutputableBndr a => LexicalFixity -> a -> SDoc pprOcc Infix = pprInfixOcc @@ -429,7 +428,7 @@ pprTypedLamBinder bind_site debug_on var _ | not debug_on -- Show case-bound wild binders only if debug is on , CaseBind <- bind_site - , isDeadBinder var -> empty + , isDeadBinder var -> ppr var -- empty | not debug_on -- Even dead binders can be one-shot , isDeadBinder var -> char '_' <+> ppWhen (isId var) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -220,9 +220,9 @@ mkSpecRule :: DynFlags -> Module -> Bool -> Activation -> SDoc -> Id -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule -- Make a specialisation rule, for Specialise or SpecConstr mkSpecRule dflags this_mod is_auto inl_act herald fn bndrs args rhs - = case isJoinId_maybe fn of - Just join_arity -> etaExpandToJoinPointRule join_arity rule - Nothing -> rule + = case idJoinPointHood fn of + JoinPoint join_arity -> etaExpandToJoinPointRule join_arity rule + NotJoinPoint -> rule where rule = mkRule this_mod is_auto is_local rule_name ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -475,7 +475,7 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst }) occ = idOccInfo in_bndr in_scope = getSubstInScope subst - out_rhs | Just join_arity <- isJoinId_maybe in_bndr + out_rhs | JoinPoint join_arity <- idJoinPointHood in_bndr = simple_join_rhs join_arity | otherwise = simple_opt_clo in_scope clo ===================================== compiler/GHC/Core/Tidy.hs ===================================== @@ -132,7 +132,7 @@ computeCbvInfo :: HasCallStack -> Id -- computeCbvInfo fun_id rhs = fun_id computeCbvInfo fun_id rhs - | is_wkr_like || isJust mb_join_id + | is_wkr_like || isJoinPoint mb_join_id , valid_unlifted_worker val_args = -- pprTrace "computeCbvInfo" -- (text "fun" <+> ppr fun_id $$ @@ -147,14 +147,14 @@ computeCbvInfo fun_id rhs | otherwise = fun_id where - mb_join_id = isJoinId_maybe fun_id + mb_join_id = idJoinPointHood fun_id is_wkr_like = isWorkerLikeId fun_id val_args = filter isId lam_bndrs -- When computing CbvMarks, we limit the arity of join points to -- the JoinArity, because that's the arity we are going to use -- when calling it. There may be more lambdas than that on the RHS. - lam_bndrs | Just join_arity <- mb_join_id + lam_bndrs | JoinPoint join_arity <- mb_join_id = fst $ collectNBinders join_arity rhs | otherwise = fst $ collectBinders rhs ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -545,7 +545,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr = False size_up_rhs (bndr, rhs) - | Just join_arity <- isJoinId_maybe bndr + | JoinPoint join_arity <- idJoinPointHood bndr -- Skip arguments to join point , (_bndrs, body) <- collectNBinders join_arity rhs = size_up body ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -438,7 +438,7 @@ toIfaceLetBndr :: Id -> IfaceLetBndr toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id)) (toIfaceType (idType id)) (toIfaceIdInfo (idInfo id)) - (toIfaceJoinInfo (isJoinId_maybe id)) + (idJoinPointHood id) -- Put into the interface file any IdInfo that GHC.Core.Tidy.tidyLetBndr -- has left on the Id. See Note [IdInfo on nested let-bindings] in GHC.Iface.Syntax @@ -505,10 +505,6 @@ toIfaceIdInfo id_info inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing | otherwise = Just (HsInline inline_prag) -toIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo -toIfaceJoinInfo (Just ar) = IfaceJoinPoint ar -toIfaceJoinInfo Nothing = IfaceNotJoinPoint - -------------------------- toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -740,8 +740,8 @@ cpeJoinPair :: CorePrepEnv -> JoinId -> CoreExpr -- No eta-expansion: see Note [Do not eta-expand join points] in GHC.Core.Opt.Simplify.Utils cpeJoinPair env bndr rhs = assert (isJoinId bndr) $ - do { let Just join_arity = isJoinId_maybe bndr - (bndrs, body) = collectNBinders join_arity rhs + do { let JoinPoint join_arity = idJoinPointHood bndr + (bndrs, body) = collectNBinders join_arity rhs ; (env', bndrs') <- cpCloneBndrs env bndrs @@ -1541,7 +1541,7 @@ maybeSaturate fn expr n_args unsat_ticks ( not (isJoinId fn)) -- See Note [Do not eta-expand join points] ( ppr fn $$ text "expr:" <+> ppr expr $$ text "n_args:" <+> ppr n_args $$ text "marks:" <+> ppr (idCbvMarks_maybe fn) $$ - text "join_arity" <+> ppr (isJoinId_maybe fn) $$ + text "join_arity" <+> ppr (idJoinPointHood fn) $$ text "fn_arity" <+> ppr fn_arity ) $ -- pprTrace "maybeSat" ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -12,7 +12,7 @@ module GHC.Iface.Syntax ( IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..), IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec, - IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceJoinInfo(..), IfaceBinding, + IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceBinding, IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, @@ -651,7 +651,7 @@ data IfaceBindingX r b -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too -- It's used for *non-top-level* let/rec binders -- See Note [IdInfo on nested let-bindings] -data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo +data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo JoinPointHood data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDetails | IfGblTopBndr IfaceTopBndr @@ -659,9 +659,6 @@ data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDeta -- See Note [Interface File with Core: Sharing RHSs] data IfaceMaybeRhs = IfUseUnfoldingRhs | IfRhs IfaceExpr -data IfaceJoinInfo = IfaceNotJoinPoint - | IfaceJoinPoint JoinArity - {- Note [Empty case alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1574,10 +1571,6 @@ instance Outputable IfaceInfoItem where ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info ppr (HsTagSig tag_sig) = text "TagSig:" <+> ppr tag_sig -instance Outputable IfaceJoinInfo where - ppr IfaceNotJoinPoint = empty - ppr (IfaceJoinPoint ar) = angleBrackets (text "join" <+> ppr ar) - instance Outputable IfaceUnfolding where ppr (IfCoreUnfold src _ guide e) = sep [ text "Core:" <+> ppr src <+> ppr guide, ppr e ] @@ -2689,19 +2682,6 @@ instance Binary IfaceMaybeRhs where 1 -> IfRhs <$> get bh _ -> pprPanic "IfaceMaybeRhs" (intWithCommas b) - - -instance Binary IfaceJoinInfo where - put_ bh IfaceNotJoinPoint = putByte bh 0 - put_ bh (IfaceJoinPoint ar) = do - putByte bh 1 - put_ bh ar - get bh = do - h <- getByte bh - case h of - 0 -> return IfaceNotJoinPoint - _ -> liftM IfaceJoinPoint $ get bh - instance Binary IfaceTyConParent where put_ bh IfNoParent = putByte bh 0 put_ bh (IfDataInstance ax pr ty) = do @@ -2881,9 +2861,6 @@ instance NFData IfaceFamTyConFlav where IfaceAbstractClosedSynFamilyTyCon -> () IfaceBuiltInSynFamTyCon -> () -instance NFData IfaceJoinInfo where - rnf x = x `seq` () - instance NFData IfaceTickish where rnf = \case IfaceHpcTick m i -> rnf m `seq` rnf i ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1586,7 +1586,7 @@ tcIfaceExpr (IfaceLet (IfaceNonRec (IfLetBndr fs ty info ji) rhs) body) ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} NotTopLevel name ty' info ; let id = mkLocalIdWithInfo name ManyTy ty' id_info - `asJoinId_maybe` tcJoinInfo ji + `asJoinId_maybe` ji ; rhs' <- tcIfaceExpr rhs ; body' <- extendIfaceIdEnv [id] (tcIfaceExpr body) ; return (Let (NonRec id rhs') body') } @@ -1601,7 +1601,7 @@ tcIfaceExpr (IfaceLet (IfaceRec pairs) body) tc_rec_bndr (IfLetBndr fs ty _ ji) = do { name <- newIfaceName (mkVarOccFS fs) ; ty' <- tcIfaceType ty - ; return (mkLocalId name ManyTy ty' `asJoinId_maybe` tcJoinInfo ji) } + ; return (mkLocalId name ManyTy ty' `asJoinId_maybe` ji) } tc_pair (IfLetBndr _ _ info _, rhs) id = do { rhs' <- tcIfaceExpr rhs ; id_info <- tcIdInfo False {- Don't ignore prags; we are inside one! -} @@ -1744,10 +1744,6 @@ tcIdInfo ignore_prags toplvl name ty info = do | otherwise = info ; return (info1 `setUnfoldingInfo` unf) } -tcJoinInfo :: IfaceJoinInfo -> Maybe JoinArity -tcJoinInfo (IfaceJoinPoint ar) = Just ar -tcJoinInfo IfaceNotJoinPoint = Nothing - tcLFInfo :: IfaceLFInfo -> IfL LambdaFormInfo tcLFInfo lfi = case lfi of IfLFReEntrant rep_arity -> ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -415,7 +415,7 @@ lintAppCbvMarks e@(StgApp fun args) = do (text "marks" <> ppr marks $$ text "args" <> ppr args $$ text "arity" <> ppr (idArity fun) $$ - text "join_arity" <> ppr (isJoinId_maybe fun)) + text "join_arity" <> ppr (idJoinPointHood fun)) lintAppCbvMarks _ = panic "impossible - lintAppCbvMarks" {- ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Types.Basic ( ConTag, ConTagZ, fIRST_TAG, Arity, RepArity, JoinArity, FullArgCount, + JoinPointHood(..), isJoinPoint, Alignment, mkAlignment, alignmentOf, alignmentBytes, @@ -1205,7 +1206,7 @@ The AlwaysTailCalled marker actually means slightly more than simply that the function is always tail-called. See Note [Invariants on join points]. This info is quite fragile and should not be relied upon unless the occurrence -analyser has *just* run. Use 'Id.isJoinId_maybe' for the permanent state of +analyser has *just* run. Use 'Id.idJoinPointHood' for the permanent state of the join-point-hood of a binder; a join id itself will not be marked AlwaysTailCalled. ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -78,7 +78,8 @@ module GHC.Types.Id ( hasNoBinding, -- ** Join variables - JoinId, isJoinId, isJoinId_maybe, idJoinArity, + JoinId, JoinPointHood, + isJoinId, idJoinPointHood, idJoinArity, asJoinId, asJoinId_maybe, zapJoinId, -- ** Inline pragma stuff @@ -560,13 +561,13 @@ isJoinId id | otherwise = False -- | Doesn't return strictness marks -isJoinId_maybe :: Var -> Maybe JoinArity -isJoinId_maybe id +idJoinPointHood :: Var -> JoinPointHood +idJoinPointHood id | isId id = assertPpr (isId id) (ppr id) $ case Var.idDetails id of - JoinId arity _marks -> Just arity - _ -> Nothing - | otherwise = Nothing + JoinId arity _marks -> JoinPoint arity + _ -> NotJoinPoint + | otherwise = NotJoinPoint idDataCon :: Id -> DataCon -- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer. @@ -639,7 +640,9 @@ isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr) -} idJoinArity :: JoinId -> JoinArity -idJoinArity id = isJoinId_maybe id `orElse` pprPanic "idJoinArity" (ppr id) +idJoinArity id = case idJoinPointHood id of + JoinPoint ar -> ar + NotJoinPoint -> pprPanic "idJoinArity" (ppr id) asJoinId :: Id -> JoinArity -> JoinId asJoinId id arity = warnPprTrace (not (isLocalId id)) @@ -671,9 +674,9 @@ zapJoinId jid | isJoinId jid = zapIdTailCallInfo (newIdDetails `seq` jid `setIdD _ -> panic "zapJoinId: newIdDetails can only be used if Id was a join Id." -asJoinId_maybe :: Id -> Maybe JoinArity -> Id -asJoinId_maybe id (Just arity) = asJoinId id arity -asJoinId_maybe id Nothing = zapJoinId id +asJoinId_maybe :: Id -> JoinPointHood -> Id +asJoinId_maybe id (JoinPoint arity) = asJoinId id arity +asJoinId_maybe id NotJoinPoint = zapJoinId id {- ************************************************************************ ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -97,6 +97,7 @@ import GHC.Utils.Fingerprint import GHC.Types.SrcLoc import GHC.Types.Unique import qualified GHC.Data.Strict as Strict +import GHC.Utils.Outputable( JoinPointHood(..) ) import Control.DeepSeq import Foreign hiding (shiftL, shiftR, void) @@ -809,6 +810,17 @@ instance Binary DiffTime where get bh = do r <- get bh return $ fromRational r +instance Binary JoinPointHood where + put_ bh NotJoinPoint = putByte bh 0 + put_ bh (JoinPoint ar) = do + putByte bh 1 + put_ bh ar + get bh = do + h <- getByte bh + case h of + 0 -> return NotJoinPoint + _ -> do { ar <- get bh; return (JoinPoint ar) } + {- Finally - a reasonable portable Integer instance. ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -23,6 +23,7 @@ module GHC.Utils.Outputable ( -- * Type classes Outputable(..), OutputableBndr(..), OutputableP(..), + BindingSite(..), JoinPointHood(..), isJoinPoint, IsOutput(..), IsLine(..), IsDoc(..), HLine, HDoc, @@ -86,8 +87,6 @@ module GHC.Utils.Outputable ( pprModuleName, -- * Controlling the style in which output is printed - BindingSite(..), - PprStyle(..), NamePprCtx(..), QueryQualifyName, QueryQualifyModule, QueryQualifyPackage, QueryPromotionTick, PromotedItem(..), IsEmptyOrSingleton(..), isListEmptyOrSingleton, @@ -156,6 +155,7 @@ import qualified Data.List.NonEmpty as NEL import Data.Time ( UTCTime ) import Data.Time.Format.ISO8601 import Data.Void +import Control.DeepSeq (NFData(rnf)) import GHC.Fingerprint import GHC.Show ( showMultiLineString ) @@ -1220,16 +1220,6 @@ instance OutputableP env Void where ************************************************************************ -} --- | 'BindingSite' is used to tell the thing that prints binder what --- language construct is binding the identifier. This can be used --- to decide how much info to print. --- Also see Note [Binding-site specific printing] in "GHC.Core.Ppr" -data BindingSite - = LambdaBind -- ^ The x in (\x. e) - | CaseBind -- ^ The x in case scrut of x { (y,z) -> ... } - | CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... } - | LetBind -- ^ The x in (let x = rhs in e) - deriving Eq -- | When we print a binder, we often want to print its type too. -- The @OutputableBndr@ class encapsulates this idea. class Outputable a => OutputableBndr a where @@ -1241,13 +1231,40 @@ class Outputable a => OutputableBndr a where -- prefix position of an application, thus (f a b) or ((+) x) -- or infix position, thus (a `f` b) or (x + y) - bndrIsJoin_maybe :: a -> Maybe Int - bndrIsJoin_maybe _ = Nothing + bndrIsJoin_maybe :: a -> JoinPointHood + bndrIsJoin_maybe _ = NotJoinPoint -- When pretty-printing we sometimes want to find -- whether the binder is a join point. You might think -- we could have a function of type (a->Var), but Var -- isn't available yet, alas +-- | 'BindingSite' is used to tell the thing that prints binder what +-- language construct is binding the identifier. This can be used +-- to decide how much info to print. +-- Also see Note [Binding-site specific printing] in "GHC.Core.Ppr" +data BindingSite + = LambdaBind -- ^ The x in (\x. e) + | CaseBind -- ^ The x in case scrut of x { (y,z) -> ... } + | CasePatBind -- ^ The y,z in case scrut of x { (y,z) -> ... } + | LetBind -- ^ The x in (let x = rhs in e) + deriving Eq + +data JoinPointHood + = JoinPoint {-# UNPACK #-} !Int -- The JoinArity (but an Int here because + | NotJoinPoint -- synonym JoinArity is defined in Types.Basic + deriving( Eq ) + +isJoinPoint :: JoinPointHood -> Bool +isJoinPoint (JoinPoint {}) = True +isJoinPoint NotJoinPoint = False + +instance Outputable JoinPointHood where + ppr NotJoinPoint = text "NotJoinPoint" + ppr (JoinPoint arity) = text "JoinPoint" <> parens (ppr arity) + +instance NFData JoinPointHood where + rnf x = x `seq` () + {- ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68e92a9acb53114cb4498134ac2728a507bc96df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68e92a9acb53114cb4498134ac2728a507bc96df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 17:13:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 13:13:47 -0400 Subject: [Git][ghc/ghc][master] Update Match Datatype Message-ID: <64c3f74bc38c4_37b561c5bcb4033154b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 6 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -206,11 +206,8 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss -- ==> case rhs of C x# y# -> body do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas - ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } - ; var <- selectMatchVar ManyTy upat + ; let eqn = EqnMatch { eqn_pat = pat, eqn_rest = EqnDone (cantFailMatchResult body) } + ; var <- selectMatchVar ManyTy (unLoc pat) -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -29,8 +29,12 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated, requiresPMC ) +import GHC.Types.Basic ( Origin(..), requiresPMC ) import GHC.Types.SourceText + ( FractionalLit, + IntegralLit(il_value), + negateFractionalLit, + integralFractionalLit ) import GHC.Driver.DynFlags import GHC.Hs import GHC.Hs.Syn.Type @@ -193,13 +197,9 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineEqnRhss (NEL.fromList eqns) -match (v:vs) ty eqns -- Eqns *can* be empty +match (v:vs) ty eqns -- Eqns can be empty, but each equation is nonempty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ do { dflags <- getDynFlags ; let platform = targetPlatform dflags @@ -222,12 +222,11 @@ match (v:vs) ty eqns -- Eqns *can* be empty dropGroup :: Functor f => f (PatGroup,EquationInfo) -> f EquationInfo dropGroup = fmap snd - match_groups :: [NonEmpty (PatGroup,EquationInfo)] -> DsM (NonEmpty (MatchResult CoreExpr)) - -- Result list of [MatchResult CoreExpr] is always non-empty + match_groups :: [NonEmpty (PatGroup,EquationInfoNE)] -> DsM (NonEmpty (MatchResult CoreExpr)) match_groups [] = matchEmpty v ty match_groups (g:gs) = mapM match_group $ g :| gs - match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr) + match_group :: NonEmpty (PatGroup,EquationInfoNE) -> DsM (MatchResult CoreExpr) match_group eqns@((group,_) :| _) = case group of PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns']) @@ -267,20 +266,20 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] -matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns -matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchBangs (var :| vars) ty eqns = do { match_result <- match (var:vars) ty $ NEL.toList $ decomposeFirstPat getBangPat <$> eqns ; return (mkEvalMatchResult var ty match_result) } -matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Apply the coercion to the match variable and then match that -matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) +matchCoercion (var :| vars) ty eqns@(eqn1 :| _) = do { let XPat (CoPat co pat _) = firstPat eqn1 ; let pat_ty' = hsPatType pat ; var' <- newUniqueId var (idMult var) pat_ty' @@ -290,9 +289,9 @@ matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) { let bind = NonRec var' (core_wrap (Var var)) ; return (mkCoLetMatchResult bind match_result) } } -matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Apply the view function to the match variable and then match that -matchView (var :| vars) ty (eqns@(eqn1 :| _)) +matchView (var :| vars) ty eqns@(eqn1 :| _) = do { -- we could pass in the expr from the PgView, -- but this needs to extract the pat anyway -- to figure out the type of the fresh variable @@ -309,10 +308,9 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _)) match_result) } -- decompose the first pattern and leave the rest alone -decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} -decomposeFirstPat _ _ = panic "decomposeFirstPat" +decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfoNE -> EquationInfoNE +decomposeFirstPat extract eqn@(EqnMatch { eqn_pat = pat }) = eqn{eqn_pat = fmap extract pat} +decomposeFirstPat _ (EqnDone {}) = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc getCoPat (XPat (CoPat _ pat _)) = pat @@ -405,15 +403,14 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ eqn@(EqnDone {}) = return (idDsWrapper, eqn) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v eqn@(EqnMatch { eqn_pat = (L loc pat) }) = do + (wrap, pat') <- tidy1 v (not . isGoodSrcSpan . locA $ loc) pat + return (wrap, eqn{eqn_pat = L loc pat' }) tidy1 :: Id -- The Id being scrutinised - -> Origin -- Was this a pattern the user wrote? + -> Bool -- `True` if the pattern was generated, `False` if it was user-written -> Pat GhcTc -- The pattern against which it is to be matched -> DsM (DsWrapper, -- Extra bindings to do before the match Pat GhcTc) -- Equivalent pattern @@ -424,10 +421,10 @@ tidy1 :: Id -- The Id being scrutinised -- It eliminates many pattern forms (as-patterns, variable patterns, -- list patterns, etc) and returns any created bindings in the wrapper. -tidy1 v o (ParPat _ _ pat _) = tidy1 v o (unLoc pat) -tidy1 v o (SigPat _ pat _) = tidy1 v o (unLoc pat) +tidy1 v g (ParPat _ _ pat _) = tidy1 v g (unLoc pat) +tidy1 v g (SigPat _ pat _) = tidy1 v g (unLoc pat) tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty) -tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p +tidy1 v g (BangPat _ (L l p)) = tidy_bang_pat v g l p -- case v of { x -> mr[] } -- = case v of { _ -> let x=v in mr[] } @@ -436,8 +433,8 @@ tidy1 v _ (VarPat _ (L _ var)) -- case v of { x at p -> mr[] } -- = case v of { p -> let x=v in mr[] } -tidy1 v o (AsPat _ (L _ var) _ pat) - = do { (wrap, pat') <- tidy1 v o (unLoc pat) +tidy1 v g (AsPat _ (L _ var) _ pat) + = do { (wrap, pat') <- tidy1 v g (unLoc pat) ; return (wrapBind var v . wrap, pat') } {- now, here we handle lazy patterns: @@ -489,22 +486,22 @@ tidy1 _ _ (SumPat tys pat alt arity) -- See Note [Unboxed tuple RuntimeRep vars] in TyCon -- LitPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (LitPat _ lit) - = do { unless (isGenerated o) $ +tidy1 _ g (LitPat _ lit) + = do { unless g $ warnAboutOverflowedLit lit ; return (idDsWrapper, tidyLitPat lit) } -- NPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) - = do { unless (isGenerated o) $ +tidy1 _ g (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) + = do { unless g $ let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v } | otherwise = lit in warnAboutOverflowedOverLit lit' ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) } -- NPlusKPat: we may want to warn about the literals -tidy1 _ o n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) - = do { unless (isGenerated o) $ do +tidy1 _ g n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) + = do { unless g $ do warnAboutOverflowedOverLit lit1 warnAboutOverflowedOverLit lit2 ; return (idDsWrapper, n) } @@ -514,28 +511,28 @@ tidy1 _ _ non_interesting_pat = return (idDsWrapper, non_interesting_pat) -------------------- -tidy_bang_pat :: Id -> Origin -> SrcSpanAnnA -> Pat GhcTc +tidy_bang_pat :: Id -> Bool -> SrcSpanAnnA -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc) -- Discard par/sig under a bang -tidy_bang_pat v o _ (ParPat _ _ (L l p) _) = tidy_bang_pat v o l p -tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p +tidy_bang_pat v g _ (ParPat _ _ (L l p) _) = tidy_bang_pat v g l p +tidy_bang_pat v g _ (SigPat _ (L l p) _) = tidy_bang_pat v g l p -- Push the bang-pattern inwards, in the hope that -- it may disappear next time -tidy_bang_pat v o l (AsPat x v' at p) - = tidy1 v o (AsPat x v' at (L l (BangPat noExtField p))) -tidy_bang_pat v o l (XPat (CoPat w p t)) - = tidy1 v o (XPat $ CoPat w (BangPat noExtField (L l p)) t) +tidy_bang_pat v g l (AsPat x v' at p) + = tidy1 v g (AsPat x v' at (L l (BangPat noExtField p))) +tidy_bang_pat v g l (XPat (CoPat w p t)) + = tidy1 v g (XPat $ CoPat w (BangPat noExtField (L l p)) t) -- Discard bang around strict pattern -tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(ListPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(TuplePat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p +tidy_bang_pat v g _ p@(LitPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(ListPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(TuplePat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(SumPat {}) = tidy1 v g p -- Data/newtype constructors -tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) +tidy_bang_pat v g l p@(ConPat { pat_con = L _ (RealDataCon dc) , pat_args = args , pat_con_ext = ConPatTc { cpt_arg_tys = arg_tys @@ -544,8 +541,8 @@ tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) -- Newtypes: push bang inwards (#9844) = if isNewTyCon (dataConTyCon dc) - then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) - else tidy1 v o p -- Data types: discard the bang + then tidy1 v g (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) + else tidy1 v g p -- Data types: discard the bang where (ty:_) = dataConInstArgTys dc arg_tys @@ -808,16 +805,14 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags - ; let upats = map (unLoc . decideBangHood dflags) pats + ; let upats = map (decideBangHood dflags) pats -- pat_nablas is the covered set *after* matching the pattern, but -- before any of the GRHSs. We extend the environment with pat_nablas -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats match_result } discard_warnings_if_skip_pmc orig = if requiresPMC orig @@ -958,10 +953,9 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) else getLdiNablas - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = - updPmNablasMatchResult ldi_nablas match_result } + ; let eqn_info = EqnMatch { eqn_pat = decideBangHood dflags pat + , eqn_rest = + EqnDone $ updPmNablasMatchResult ldi_nablas match_result } -- See Note [Long-distance information in do notation] -- in GHC.HsToCore.Expr. @@ -999,6 +993,13 @@ data PatGroup -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors @@ -1019,7 +1020,7 @@ the PgN constructor as a FractionalLit if numeric, and add a PgOverStr construct for overloaded strings. -} -groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInfo)] +groupEquations :: Platform -> [EquationInfoNE] -> [NonEmpty (PatGroup, EquationInfoNE)] -- If the result is of form [g1, g2, g3], -- (a) all the (pg,eq) pairs in g1 have the same pg -- (b) none of the gi are empty @@ -1163,8 +1164,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2' -- the fixities have been straightened out by now, so it's safe -- to ignore them? - exp (OpApp _ l o ri) (OpApp _ l' o' ri') = - lexp l l' && lexp o o' && lexp ri ri' + exp (OpApp _ l g ri) (OpApp _ l' o' ri') = + lexp l l' && lexp g o' && lexp ri ri' exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n' exp (SectionL _ e1 e2) (SectionL _ e1' e2') = lexp e1 e1' && lexp e2 e2' ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -21,7 +21,6 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( match ) import GHC.Hs import GHC.HsToCore.Binds import GHC.Core.ConLike -import GHC.Types.Basic import GHC.Tc.Utils.TcType import GHC.Core.Multiplicity import GHC.HsToCore.Monad @@ -95,7 +94,7 @@ have-we-used-all-the-constructors? question; the local function matchConFamily :: NonEmpty Id -> Type - -> NonEmpty (NonEmpty EquationInfo) + -> NonEmpty (NonEmpty EquationInfoNE) -> DsM (MatchResult CoreExpr) -- Each group of eqns is for a single constructor matchConFamily (var :| vars) ty groups @@ -114,7 +113,7 @@ matchConFamily (var :| vars) ty groups matchPatSyn :: NonEmpty Id -> Type - -> NonEmpty EquationInfo + -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchPatSyn (var :| vars) ty eqns = do let mult = idMult var @@ -130,7 +129,7 @@ type ConArgPats = HsConPatDetails GhcTc matchOneConLike :: [Id] -> Type -> Mult - -> NonEmpty EquationInfo + -> NonEmpty EquationInfoNE -> DsM (CaseAlt ConLike) matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single constructor = do { let inst_tys = assert (all tcIsTcTyVar ex_tvs) $ @@ -144,7 +143,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- and returns the types of the *value* args, which is what we want match_group :: [Id] - -> NonEmpty (ConArgPats, EquationInfo) + -> NonEmpty (ConArgPats, EquationInfoNE) -> DsM (MatchResult CoreExpr) -- All members of the group have compatible ConArgPats match_group arg_vars arg_eqn_prs @@ -154,24 +153,21 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, EqnMatch { + eqn_pat = L _ (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind }}) + , eqn_rest = rest }) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated SkipPmc - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , prependPats (conArgPats val_arg_tys args) rest ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we @@ -185,7 +181,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- suggestions for the new variables -- Divide into sub-groups; see Note [Record patterns] - ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfo)) + ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfoNE)) groups = NE.groupBy1 compatible_pats $ fmap (\eqn -> (pat_args (firstPat eqn), eqn)) (eqn1 :| eqns) @@ -257,14 +253,14 @@ conArgPats :: [Scaled Type]-- Instantiated argument types -- Used only to fill in the types of WildPats, which -- are probably never looked at anyway -> ConArgPats - -> [Pat GhcTc] -conArgPats _arg_tys (PrefixCon _ ps) = map unLoc ps -conArgPats _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2] + -> [LPat GhcTc] +conArgPats _arg_tys (PrefixCon _ ps) = ps +conArgPats _arg_tys (InfixCon p1 p2) = [p1, p2] conArgPats arg_tys (RecCon (HsRecFields { rec_flds = rpats })) - | null rpats = map WildPat (map scaledThing arg_tys) + | null rpats = map (noLocA . WildPat . scaledThing) arg_tys -- Important special case for C {}, which can be used for a -- datacon that isn't declared to have fields at all - | otherwise = map (unLoc . hfbRHS . unLoc) rpats + | otherwise = map (hfbRHS . unLoc) rpats {- Note [Record patterns] ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -607,7 +607,7 @@ tidyNPat over_lit mb_neg eq outer_ty matchLiterals :: NonEmpty Id -> Type -- ^ Type of the whole case expression - -> NonEmpty (NonEmpty EquationInfo) -- ^ All PgLits + -> NonEmpty (NonEmpty EquationInfoNE) -- ^ All PgLits -> DsM (MatchResult CoreExpr) matchLiterals (var :| vars) ty sub_groups @@ -625,11 +625,11 @@ matchLiterals (var :| vars) ty sub_groups return (mkCoPrimCaseMatchResult var ty $ NEL.toList alts) } where - match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group :: NonEmpty EquationInfoNE -> DsM (Literal, MatchResult CoreExpr) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let EqnMatch { eqn_pat = L _ (LitPat _ hs_lit) } = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -682,7 +682,7 @@ hsLitKey _ l = pprPanic "hsLitKey" (ppr l) ************************************************************************ -} -matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchNPats (var :| vars) ty (eqn1 :| eqns) -- All for the same literal = do { let NPat _ (L _ lit) mb_neg eq_chk = firstPat eqn1 ; lit_expr <- dsOverLit lit @@ -711,7 +711,7 @@ We generate: \end{verbatim} -} -matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- All NPlusKPats, for the *same* literal k matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) = do { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus @@ -727,7 +727,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 (EqnMatch { eqn_pat = L _ (NPlusKPat _ (L _ n) _ _ _ _), eqn_rest = rest }) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -49,7 +49,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), EquationInfoNE, prependPats, mkEqnInfo, eqnMatchResult, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -92,7 +93,6 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) @@ -132,27 +132,42 @@ instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match data EquationInfo - = EqnInfo { eqn_pats :: [Pat GhcTc] - -- ^ The patterns for an equation - -- - -- NB: We have /already/ applied 'decideBangHood' to - -- these patterns. See Note [decideBangHood] in "GHC.HsToCore.Utils" - - , eqn_orig :: Origin - -- ^ Was this equation present in the user source? - -- - -- This helps us avoid warnings on patterns that GHC elaborated. - -- - -- For instance, the pattern @-1 :: Word@ gets desugared into - -- @W# -1## :: Word@, but we shouldn't warn about an overflowed - -- literal for /both/ of these cases. - - , eqn_rhs :: MatchResult CoreExpr - -- ^ What to do after match - } + = EqnMatch { eqn_pat :: LPat GhcTc + -- ^ The first pattern of the equation + -- + -- NB: The location info is used to determine whether the + -- pattern is generated or not. + -- This helps us avoid warnings on patterns that GHC elaborated. + -- + -- NB: We have /already/ applied 'decideBangHood' to this + -- pattern. See Note [decideBangHood] in "GHC.HsToCore.Utils" + + , eqn_rest :: EquationInfo } + -- ^ The rest of the equation after its first pattern + + | EqnDone + -- The empty tail of an equation having no more patterns + (MatchResult CoreExpr) + -- ^ What to do after match + +type EquationInfoNE = EquationInfo +-- An EquationInfo which has at least one pattern + +prependPats :: [LPat GhcTc] -> EquationInfo -> EquationInfo +prependPats [] eqn = eqn +prependPats (pat:pats) eqn = EqnMatch { eqn_pat = pat, eqn_rest = prependPats pats eqn } + +mkEqnInfo :: [LPat GhcTc] -> MatchResult CoreExpr -> EquationInfo +mkEqnInfo pats = prependPats pats . EqnDone + +eqnMatchResult :: EquationInfo -> MatchResult CoreExpr +eqnMatchResult (EqnDone rhs) = rhs +eqnMatchResult (EqnMatch { eqn_rest = eq }) = eqnMatchResult eq instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . allEqnPats where + allEqnPats (EqnDone {}) = [] + allEqnPats (EqnMatch { eqn_pat = pat, eqn_rest = eq }) = unLoc pat : allEqnPats eq type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, shiftEqns, combineEqnRhss, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -194,12 +194,16 @@ The ``equation info'' used by @match@ is relatively complicated and worthy of a type synonym and a few handy functions. -} -firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat :: EquationInfoNE -> Pat GhcTc +firstPat (EqnMatch { eqn_pat = pat }) = unLoc pat +firstPat (EqnDone {}) = error "firstPat: no patterns" -shiftEqns :: Functor f => f EquationInfo -> f EquationInfo +shiftEqns :: Functor f => f EquationInfoNE -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap eqn_rest + +combineEqnRhss :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineEqnRhss eqns = return $ foldr1 combineMatchResults $ map eqnMatchResult (NEL.toList eqns) -- Functions on MatchResult CoreExprs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a53193589ac5bd9973711733a7ccd66080dca794 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a53193589ac5bd9973711733a7ccd66080dca794 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 17:14:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 13:14:46 -0400 Subject: [Git][ghc/ghc][master] Improve documentation for Data.Fixed Message-ID: <64c3f7866ba06_37b561ba004335013@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - 1 changed file: - libraries/base/Data/Fixed.hs Changes: ===================================== libraries/base/Data/Fixed.hs ===================================== @@ -13,10 +13,19 @@ -- Stability : stable -- Portability : portable -- --- This module defines a \"Fixed\" type for fixed-precision arithmetic. --- The parameter to 'Fixed' is any type that's an instance of 'HasResolution'. --- 'HasResolution' has a single method that gives the resolution of the 'Fixed' --- type. +-- This module defines a 'Fixed' type for working with fixed-point arithmetic. +-- Fixed-point arithmetic represents fractional numbers with a fixed number of +-- digits for their fractional part. This is different to the behaviour of the floating-point +-- number types 'Float' and 'Double', because the number of digits of the +-- fractional part of 'Float' and 'Double' numbers depends on the size of the number. +-- Fixed point arithmetic is frequently used in financial mathematics, where they +-- are used for representing decimal currencies. +-- +-- The type 'Fixed' is used for fixed-point fractional numbers, which are internally +-- represented as an 'Integer'. The type 'Fixed' takes one parameter, which should implement +-- the typeclass 'HasResolution', to specify the number of digits of the fractional part. +-- This module provides instances of the `HasResolution` typeclass for arbitrary typelevel +-- natural numbers, and for some canonical important fixed-point representations. -- -- This module also contains generalisations of 'div', 'mod', and 'divMod' to -- work with any 'Real' instance. @@ -31,18 +40,49 @@ ----------------------------------------------------------------------------- module Data.Fixed -( - div',mod',divMod', - +( -- * The Fixed Type Fixed(..), HasResolution(..), showFixed, + -- * Resolution \/ Scaling Factors + -- | The resolution or scaling factor determines the number of digits in the fractional part. + -- + -- +------------+----------------------+--------------------------+--------------------------+ + -- | Resolution | Scaling Factor | Synonym for \"Fixed EX\" | show (12345 :: Fixed EX) | + -- +============+======================+==========================+==========================+ + -- | E0 | 1\/1 | Uni | 12345.0 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E1 | 1\/10 | Deci | 1234.5 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E2 | 1\/100 | Centi | 123.45 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E3 | 1\/1 000 | Milli | 12.345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E6 | 1\/1 000 000 | Micro | 0.012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E9 | 1\/1 000 000 000 | Nano | 0.000012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E12 | 1\/1 000 000 000 000 | Pico | 0.000000012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- + + -- ** 1\/1 E0,Uni, + -- ** 1\/10 E1,Deci, + -- ** 1\/100 E2,Centi, + -- ** 1\/1 000 E3,Milli, + -- ** 1\/1 000 000 E6,Micro, + -- ** 1\/1 000 000 000 E9,Nano, - E12,Pico + -- ** 1\/1 000 000 000 000 + E12,Pico, + -- * Generalized Functions on Real's + div', + mod', + divMod' ) where import Data.Data @@ -67,7 +107,14 @@ mod' :: (Real a) => a -> a -> a mod' n d = n - (fromInteger f) * d where f = div' n d --- | The type parameter should be an instance of 'HasResolution'. +-- | The type of fixed-point fractional numbers. +-- The type parameter specifies the number of digits of the fractional part and should be an instance of the 'HasResolution' typeclass. +-- +-- === __Examples__ +-- +-- @ +-- MkFixed 12345 :: Fixed E3 +-- @ newtype Fixed (a :: k) = MkFixed Integer deriving ( Eq -- ^ @since 2.01 , Ord -- ^ @since 2.01 @@ -77,6 +124,7 @@ newtype Fixed (a :: k) = MkFixed Integer -- Our manual instance has the more general (Typeable a) context. tyFixed :: DataType tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed] + conMkFixed :: Constr conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix @@ -87,7 +135,9 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where dataTypeOf _ = tyFixed toConstr _ = conMkFixed +-- | Types which can be used as a resolution argument to the 'Fixed' type constructor must implement the 'HasResolution' typeclass. class HasResolution (a :: k) where + -- | Provide the resolution for a fixed-point fractional number. resolution :: p a -> Integer -- | For example, @Fixed 1000@ will give you a 'Fixed' with a resolution of 1000. @@ -109,33 +159,26 @@ withResolution foo = withType (foo . resolution) -- resolution of the 'Fixed' value. For example, when enumerating values of -- resolution @10^-3@ of @type Milli = Fixed E3@, -- --- @ --- succ (0.000 :: Milli) == 0.001 --- @ --- +-- >>> succ (0.000 :: Milli) +-- 0.001 -- -- and likewise -- --- @ --- pred (0.000 :: Milli) == -0.001 --- @ --- +-- >>> pred (0.000 :: Milli) +-- -0.001 -- -- In other words, 'succ' and 'pred' increment and decrement a fixed-precision -- value by the least amount such that the value's resolution is unchanged. -- For example, @10^-12@ is the smallest (positive) amount that can be added to -- a value of @type Pico = Fixed E12@ without changing its resolution, and so -- --- @ --- succ (0.000000000000 :: Pico) == 0.000000000001 --- @ --- +-- >>> succ (0.000000000000 :: Pico) +-- 0.000000000001 -- -- and similarly -- --- @ --- pred (0.000000000000 :: Pico) == -0.000000000001 --- @ +-- >>> pred (0.000000000000 :: Pico) +-- -0.000000000001 -- -- -- This is worth bearing in mind when defining 'Fixed' arithmetic sequences. In @@ -175,6 +218,7 @@ instance Enum (Fixed a) where -- -- >>> (0.2 * 0.6 :: Deci) * 0.9 == 0.2 * (0.6 * 0.9) -- False +-- -- >>> (0.1 + 0.1 :: Deci) * 0.5 == 0.1 * 0.5 + 0.1 * 0.5 -- False instance (HasResolution a) => Num (Fixed a) where @@ -223,6 +267,15 @@ withDot "" = "" withDot s = '.':s -- | First arg is whether to chop off trailing zeros +-- +-- === __Examples__ +-- +-- >>> showFixed True (MkFixed 10000 :: Fixed E3) +-- "10" +-- +-- >>> showFixed False (MkFixed 10000 :: Fixed E3) +-- "10.000" +-- showFixed :: (HasResolution a) => Bool -> Fixed a -> String showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa)) showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where @@ -256,58 +309,135 @@ convertFixed (Number n) e = ceiling (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail +-- | Resolution of 1, this works the same as Integer. data E0 -- | @since 4.1.0.0 instance HasResolution E0 where resolution _ = 1 --- | resolution of 1, this works the same as Integer + +-- | Resolution of 1, this works the same as Integer. +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E0) +-- "12345.0" +-- +-- >>> show (MkFixed 12345 :: Uni) +-- "12345.0" +-- type Uni = Fixed E0 +-- | Resolution of 10^-1 = .1 data E1 -- | @since 4.1.0.0 instance HasResolution E1 where resolution _ = 10 --- | resolution of 10^-1 = .1 + +-- | Resolution of 10^-1 = .1 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E1) +-- "1234.5" +-- +-- >>> show (MkFixed 12345 :: Deci) +-- "1234.5" +-- type Deci = Fixed E1 +-- | Resolution of 10^-2 = .01, useful for many monetary currencies data E2 -- | @since 4.1.0.0 instance HasResolution E2 where resolution _ = 100 --- | resolution of 10^-2 = .01, useful for many monetary currencies + +-- | Resolution of 10^-2 = .01, useful for many monetary currencies +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E2) +-- "123.45" +-- +-- >>> show (MkFixed 12345 :: Centi) +-- "123.45" +-- type Centi = Fixed E2 +-- | Resolution of 10^-3 = .001 data E3 -- | @since 4.1.0.0 instance HasResolution E3 where resolution _ = 1000 --- | resolution of 10^-3 = .001 + +-- | Resolution of 10^-3 = .001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E3) +-- "12.345" +-- +-- >>> show (MkFixed 12345 :: Milli) +-- "12.345" +-- type Milli = Fixed E3 +-- | Resolution of 10^-6 = .000001 data E6 -- | @since 2.01 instance HasResolution E6 where resolution _ = 1000000 --- | resolution of 10^-6 = .000001 + +-- | Resolution of 10^-6 = .000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E6) +-- "0.012345" +-- +-- >>> show (MkFixed 12345 :: Micro) +-- "0.012345" +-- type Micro = Fixed E6 +-- | Resolution of 10^-9 = .000000001 data E9 -- | @since 4.1.0.0 instance HasResolution E9 where resolution _ = 1000000000 --- | resolution of 10^-9 = .000000001 + +-- | Resolution of 10^-9 = .000000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E9) +-- "0.000012345" +-- +-- >>> show (MkFixed 12345 :: Nano) +-- "0.000012345" +-- type Nano = Fixed E9 +-- | Resolution of 10^-12 = .000000000001 data E12 -- | @since 2.01 instance HasResolution E12 where resolution _ = 1000000000000 --- | resolution of 10^-12 = .000000000001 + +-- | Resolution of 10^-12 = .000000000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E12) +-- "0.000000012345" +-- +-- >>> show (MkFixed 12345 :: Pico) +-- "0.000000012345" +-- type Pico = Fixed E12 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86ad1af987747645b600bf9606509f27e4f3e45c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86ad1af987747645b600bf9606509f27e4f3e45c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 17:15:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 13:15:39 -0400 Subject: [Git][ghc/ghc][master] ghc-prim: Use C11 atomics Message-ID: <64c3f7bbbfb44_37b561ba0683393ae@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 1 changed file: - libraries/ghc-prim/cbits/atomic.c Changes: ===================================== libraries/ghc-prim/cbits/atomic.c ===================================== @@ -279,28 +279,36 @@ extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord8 *) x, (StgWord8) old, (StgWord8) new); + StgWord8 expected = (StgWord8) old; + __atomic_compare_exchange_n((StgWord8 *) x, &expected, (StgWord8) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord16 *) x, (StgWord16) old, (StgWord16) new); + StgWord16 expected = (StgWord16) old; + __atomic_compare_exchange_n((StgWord16 *) x, &expected, (StgWord16) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new); + StgWord32 expected = (StgWord32) old; + __atomic_compare_exchange_n((StgWord32 *) x, &expected, (StgWord32) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new); StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) { - return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new); + StgWord64 expected = (StgWord64) old; + __atomic_compare_exchange_n((StgWord64 *) x, &expected, (StgWord64) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } // Atomic exchange operations View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8fa1d08d7cbfef508bab355bda80f495e928f98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8fa1d08d7cbfef508bab355bda80f495e928f98 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 17:46:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 13:46:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Update Match Datatype Message-ID: <64c3fefe316f9_1cc350b9fc8586b5@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - bc040950 by Finley McIlwaine at 2023-07-28T13:46:05-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 8f30aa3f by Andreas Klebinger at 2023-07-28T13:46:06-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 01a6254e by Bodigrim at 2023-07-28T13:46:11-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - 7eceeb0c by Bodigrim at 2023-07-28T13:46:13-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - 15 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs - libraries/base/Data/Fixed.hs - libraries/base/GHC/IO/Handle/FD.hs - libraries/filepath - libraries/ghc-prim/cbits/atomic.c Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -372,6 +372,97 @@ getSomeReg expr = do Fixed rep reg code -> return (reg, rep, code) +{- Note [Aarch64 immediates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Aarch64 with it's fixed width instruction encoding uses leftover space for +immediates. +If you want the full rundown consult the arch reference document: +"Arm® Architecture Reference Manual" - "C3.4 Data processing - immediate" + +The gist of it is that different instructions allow for different immediate encodings. +The ones we care about for better code generation are: + +* Simple but potentially repeated bit-patterns for logic instructions. +* 16bit numbers shifted by multiples of 16. +* 12 bit numbers optionally shifted by 12 bits. + +It might seem like the ISA allows for 64bit immediates but this isn't the case. +Rather there are some instruction aliases which allow for large unencoded immediates +which will then be transalted to one of the immediate encodings implicitly. + +For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, lsl #16 +-} + +-- | Move (wide immediate) +-- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. +-- Used with MOVZ,MOVN, MOVK +-- See Note [Aarch64 immediates] +getMovWideImm :: Integer -> Width -> Maybe Operand +getMovWideImm n w + -- TODO: Handle sign extension/negatives + | n <= 0 + = Nothing + -- Fits in 16 bits + | sized_n < 2^(16 :: Int) + = Just $ OpImm (ImmInteger truncated) + + -- 0x0000 0000 xxxx 0000 + | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 16) SLSL 16 + + -- 0x 0000 xxxx 0000 0000 + | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 32) SLSL 32 + + -- 0x xxxx 0000 0000 0000 + | trailing_zeros >= 48 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 48) SLSL 48 + + | otherwise + = Nothing + where + truncated = narrowU w n + sized_n = fromIntegral truncated :: Word64 + trailing_zeros = countTrailingZeros sized_n + +-- | Arithmetic(immediate) +-- Allows for 12bit immediates which can be shifted by 0 or 12 bits. +-- Used with ADD, ADDS, SUB, SUBS, CMP, CMN +-- See Note [Aarch64 immediates] +getArithImm :: Integer -> Width -> Maybe Operand +getArithImm n w + -- TODO: Handle sign extension + | n <= 0 + = Nothing + -- Fits in 16 bits + -- Fits in 12 bits + | sized_n < 2^(12::Int) + = Just $ OpImm (ImmInteger truncated) + + -- 12 bits shifted by 12 places. + | trailing_zeros >= 12 && sized_n < 2^(24::Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 12) SLSL 12 + + | otherwise + = Nothing + where + sized_n = fromIntegral truncated :: Word64 + truncated = narrowU w n + trailing_zeros = countTrailingZeros sized_n + +-- | Logical (immediate) +-- Allows encoding of some repeated bitpatterns +-- Used with AND, ANDS, EOR, ORR, TST +-- and their aliases which includes at least MOV (bitmask immediate) +-- See Note [Aarch64 immediates] +getBitmaskImm :: Integer -> Width -> Maybe Operand +getBitmaskImm n w + | isAArch64Bitmask truncated = Just $ OpImm (ImmInteger truncated) + | otherwise = Nothing + where + truncated = narrowU w n + + -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) @@ -494,8 +585,14 @@ getRegister' config plat expr CmmLit lit -> case lit of - -- TODO handle CmmInt 0 specially, use wzr or xzr. - + -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move. + -- TODO: Reenable after https://gitlab.haskell.org/ghc/ghc/-/issues/23632 is fixed. + -- CmmInt 0 W32 -> do + -- let format = intFormat W32 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) + -- CmmInt 0 W64 -> do + -- let format = intFormat W64 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) CmmInt i W16 | i >= 0 -> do @@ -510,8 +607,13 @@ getRegister' config plat expr -- Those need the upper bits set. We'd either have to explicitly sign -- or figure out something smarter. Lowered to -- `MOV dst XZR` + CmmInt i w | i >= 0 + , Just imm_op <- getMovWideImm i w -> do + return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op))) + CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger i))))) + CmmInt i w | isNbitEncodeable 32 i, i >= 0 -> do let half0 = fromIntegral (fromIntegral i :: Word16) half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16) @@ -586,7 +688,6 @@ getRegister' config plat expr (op, imm_code) <- litToImm' lit let rep = cmmLitType plat lit format = cmmTypeFormat rep - -- width = typeWidth rep return (Any format (\dst -> imm_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op)) CmmLabelOff lbl off -> do @@ -791,17 +892,51 @@ getRegister' config plat expr -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op -- A "plain" operation. - bitOp w op = do + bitOpImm w op encode_imm = do -- compute x <- x -- compute x <- y -- x, x, x (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, format_y, code_y) <- getSomeReg y - massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOp: incompatible" + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n w + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOpImm: incompatible" return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` - op (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) + op (OpReg w dst) (OpReg w reg_x) op_y) + + -- A (potentially signed) integer operation. + -- In the case of 8- and 16-bit signed arithmetic we must first + -- sign-extend both arguments to 32-bits. + -- See Note [Signed arithmetic on AArch64]. + intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) + intOpImm {- is signed -} True w op _encode_imm = intOp True w op + intOpImm False w op encode_imm = do + -- compute x <- x + -- compute x <- y + -- x, x, x + (reg_x, format_x, code_x) <- getSomeReg x + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n w + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" + -- This is the width of the registers on which the operation + -- should be performed. + let w' = opRegWidth w + return $ Any (intFormat w) $ \dst -> + code_x `appOL` + code_y `appOL` + op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL` + truncateReg w' w dst -- truncate back to the operand's original width -- A (potentially signed) integer operation. -- In the case of 8- and 16-bit signed arithmetic we must first @@ -847,9 +982,9 @@ getRegister' config plat expr case op of -- Integer operations -- Add/Sub should only be Integer Options. - MO_Add w -> intOp False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) + MO_Add w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) getArithImm -- TODO: Handle sub-word case - MO_Sub w -> intOp False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) + MO_Sub w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) getArithImm -- Note [CSET] -- ~~~~~~~~~~~ @@ -891,8 +1026,8 @@ getRegister' config plat expr -- N.B. We needn't sign-extend sub-word size (in)equality comparisons -- since we don't care about ordering. - MO_Eq w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d EQ ]) - MO_Ne w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d NE ]) + MO_Eq w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d EQ ]) getArithImm + MO_Ne w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d NE ]) getArithImm -- Signed multiply/divide MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) @@ -921,10 +1056,10 @@ getRegister' config plat expr MO_S_Lt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLT ]) -- Unsigned comparisons - MO_U_Ge w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) - MO_U_Le w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) - MO_U_Gt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) - MO_U_Lt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) + MO_U_Ge w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm + MO_U_Le w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm + MO_U_Gt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm + MO_U_Lt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm -- Floating point arithmetic MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) @@ -947,9 +1082,9 @@ getRegister' config plat expr MO_F_Lt w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OLT ]) -- x < y <=> y >= x -- Bitwise operations - MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) + MO_And w -> bitOpImm w (\d x y -> unitOL $ AND d x y) getBitmaskImm + MO_Or w -> bitOpImm w (\d x y -> unitOL $ ORR d x y) getBitmaskImm + MO_Xor w -> bitOpImm w (\d x y -> unitOL $ EOR d x y) getBitmaskImm MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) @@ -999,7 +1134,7 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool - isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) + isNbitEncodeable n_bits i = let shift = n_bits - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -110,6 +110,7 @@ regUsageOfInstr platform instr = case instr of LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) + MOVZ dst src -> usage (regOp src, regOp dst) MVN dst src -> usage (regOp src, regOp dst) ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -251,6 +252,7 @@ patchRegsOfInstr instr env = case instr of LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) + MOVZ o1 o2 -> MOVZ (patchOp o1) (patchOp o2) MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) @@ -381,9 +383,8 @@ mkSpillInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) + mkIp0SpillAddr imm = ANN (text "Spill: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkStrSp imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) mkStrIp0 imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) @@ -408,9 +409,7 @@ mkLoadInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) mkIp0SpillAddr imm = ANN (text "Reload: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkLdrSp imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) @@ -619,7 +618,7 @@ data Instr | MOV Operand Operand -- rd = rn or rd = #i | MOVK Operand Operand -- | MOVN Operand Operand - -- | MOVZ Operand Operand + | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 | ORR Operand Operand Operand -- rd = rn | op2 @@ -708,6 +707,7 @@ instrCon i = LSR{} -> "LSR" MOV{} -> "MOV" MOVK{} -> "MOVK" + MOVZ{} -> "MOVZ" MVN{} -> "MVN" ORN{} -> "ORN" ORR{} -> "ORR" @@ -782,6 +782,9 @@ wzr = OpReg W32 (RegReal (RealRegSingle (-1))) sp = OpReg W64 (RegReal (RealRegSingle 31)) ip0 = OpReg W64 (RegReal (RealRegSingle 16)) +reg_zero :: Reg +reg_zero = RegReal (RealRegSingle (-1)) + _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) x0, x1, x2, x3, x4, x5, x6, x7 :: Operand ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -417,6 +417,7 @@ pprInstr platform instr = case instr of | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 | otherwise -> op2 (text "\tmov") o1 o2 MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 + MOVZ o1 o2 -> op2 (text "\tmovz") o1 o2 MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3 ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -77,6 +77,8 @@ litToImm (CmmInt i w) = ImmInteger (narrowS w i) -- narrow to the width: a CmmInt might be out of -- range, but we assume that ImmInteger only contains -- in-range values. A signed value should be fine here. + -- AK: We do call this with out of range values, however + -- it just truncates as we would expect. litToImm (CmmFloat f W32) = ImmFloat f litToImm (CmmFloat f W64) = ImmDouble f litToImm (CmmLabel l) = ImmCLbl l @@ -147,6 +149,13 @@ classOfRealReg (RealRegSingle i) | i < 32 = RcInteger | otherwise = RcDouble +fmtOfRealReg :: RealReg -> Format +fmtOfRealReg real_reg = + case classOfRealReg real_reg of + RcInteger -> II64 + RcDouble -> FF64 + RcFloat -> panic "No float regs on arm" + regDotColor :: RealReg -> SDoc regDotColor reg = case classOfRealReg reg of ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -568,6 +568,7 @@ codeGenFlags = EnumSet.fromList -- Flags that affect generated code , Opt_ExposeAllUnfoldings , Opt_NoTypeableBinds + , Opt_Haddock -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -206,11 +206,8 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss -- ==> case rhs of C x# y# -> body do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas - ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } - ; var <- selectMatchVar ManyTy upat + ; let eqn = EqnMatch { eqn_pat = pat, eqn_rest = EqnDone (cantFailMatchResult body) } + ; var <- selectMatchVar ManyTy (unLoc pat) -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body) ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -29,8 +29,12 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated, requiresPMC ) +import GHC.Types.Basic ( Origin(..), requiresPMC ) import GHC.Types.SourceText + ( FractionalLit, + IntegralLit(il_value), + negateFractionalLit, + integralFractionalLit ) import GHC.Driver.DynFlags import GHC.Hs import GHC.Hs.Syn.Type @@ -193,13 +197,9 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineEqnRhss (NEL.fromList eqns) -match (v:vs) ty eqns -- Eqns *can* be empty +match (v:vs) ty eqns -- Eqns can be empty, but each equation is nonempty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ do { dflags <- getDynFlags ; let platform = targetPlatform dflags @@ -222,12 +222,11 @@ match (v:vs) ty eqns -- Eqns *can* be empty dropGroup :: Functor f => f (PatGroup,EquationInfo) -> f EquationInfo dropGroup = fmap snd - match_groups :: [NonEmpty (PatGroup,EquationInfo)] -> DsM (NonEmpty (MatchResult CoreExpr)) - -- Result list of [MatchResult CoreExpr] is always non-empty + match_groups :: [NonEmpty (PatGroup,EquationInfoNE)] -> DsM (NonEmpty (MatchResult CoreExpr)) match_groups [] = matchEmpty v ty match_groups (g:gs) = mapM match_group $ g :| gs - match_group :: NonEmpty (PatGroup,EquationInfo) -> DsM (MatchResult CoreExpr) + match_group :: NonEmpty (PatGroup,EquationInfoNE) -> DsM (MatchResult CoreExpr) match_group eqns@((group,_) :| _) = case group of PgCon {} -> matchConFamily vars ty (ne $ subGroupUniq [(c,e) | (PgCon c, e) <- eqns']) @@ -267,20 +266,20 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] -matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns -matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchBangs (var :| vars) ty eqns = do { match_result <- match (var:vars) ty $ NEL.toList $ decomposeFirstPat getBangPat <$> eqns ; return (mkEvalMatchResult var ty match_result) } -matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Apply the coercion to the match variable and then match that -matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) +matchCoercion (var :| vars) ty eqns@(eqn1 :| _) = do { let XPat (CoPat co pat _) = firstPat eqn1 ; let pat_ty' = hsPatType pat ; var' <- newUniqueId var (idMult var) pat_ty' @@ -290,9 +289,9 @@ matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) { let bind = NonRec var' (core_wrap (Var var)) ; return (mkCoLetMatchResult bind match_result) } } -matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchView :: NonEmpty MatchId -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- Apply the view function to the match variable and then match that -matchView (var :| vars) ty (eqns@(eqn1 :| _)) +matchView (var :| vars) ty eqns@(eqn1 :| _) = do { -- we could pass in the expr from the PgView, -- but this needs to extract the pat anyway -- to figure out the type of the fresh variable @@ -309,10 +308,9 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _)) match_result) } -- decompose the first pattern and leave the rest alone -decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} -decomposeFirstPat _ _ = panic "decomposeFirstPat" +decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfoNE -> EquationInfoNE +decomposeFirstPat extract eqn@(EqnMatch { eqn_pat = pat }) = eqn{eqn_pat = fmap extract pat} +decomposeFirstPat _ (EqnDone {}) = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc getCoPat (XPat (CoPat _ pat _)) = pat @@ -405,15 +403,14 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ eqn@(EqnDone {}) = return (idDsWrapper, eqn) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v eqn@(EqnMatch { eqn_pat = (L loc pat) }) = do + (wrap, pat') <- tidy1 v (not . isGoodSrcSpan . locA $ loc) pat + return (wrap, eqn{eqn_pat = L loc pat' }) tidy1 :: Id -- The Id being scrutinised - -> Origin -- Was this a pattern the user wrote? + -> Bool -- `True` if the pattern was generated, `False` if it was user-written -> Pat GhcTc -- The pattern against which it is to be matched -> DsM (DsWrapper, -- Extra bindings to do before the match Pat GhcTc) -- Equivalent pattern @@ -424,10 +421,10 @@ tidy1 :: Id -- The Id being scrutinised -- It eliminates many pattern forms (as-patterns, variable patterns, -- list patterns, etc) and returns any created bindings in the wrapper. -tidy1 v o (ParPat _ _ pat _) = tidy1 v o (unLoc pat) -tidy1 v o (SigPat _ pat _) = tidy1 v o (unLoc pat) +tidy1 v g (ParPat _ _ pat _) = tidy1 v g (unLoc pat) +tidy1 v g (SigPat _ pat _) = tidy1 v g (unLoc pat) tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty) -tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p +tidy1 v g (BangPat _ (L l p)) = tidy_bang_pat v g l p -- case v of { x -> mr[] } -- = case v of { _ -> let x=v in mr[] } @@ -436,8 +433,8 @@ tidy1 v _ (VarPat _ (L _ var)) -- case v of { x at p -> mr[] } -- = case v of { p -> let x=v in mr[] } -tidy1 v o (AsPat _ (L _ var) _ pat) - = do { (wrap, pat') <- tidy1 v o (unLoc pat) +tidy1 v g (AsPat _ (L _ var) _ pat) + = do { (wrap, pat') <- tidy1 v g (unLoc pat) ; return (wrapBind var v . wrap, pat') } {- now, here we handle lazy patterns: @@ -489,22 +486,22 @@ tidy1 _ _ (SumPat tys pat alt arity) -- See Note [Unboxed tuple RuntimeRep vars] in TyCon -- LitPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (LitPat _ lit) - = do { unless (isGenerated o) $ +tidy1 _ g (LitPat _ lit) + = do { unless g $ warnAboutOverflowedLit lit ; return (idDsWrapper, tidyLitPat lit) } -- NPats: we *might* be able to replace these w/ a simpler form -tidy1 _ o (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) - = do { unless (isGenerated o) $ +tidy1 _ g (NPat ty (L _ lit at OverLit { ol_val = v }) mb_neg eq) + = do { unless g $ let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v } | otherwise = lit in warnAboutOverflowedOverLit lit' ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) } -- NPlusKPat: we may want to warn about the literals -tidy1 _ o n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) - = do { unless (isGenerated o) $ do +tidy1 _ g n@(NPlusKPat _ _ (L _ lit1) lit2 _ _) + = do { unless g $ do warnAboutOverflowedOverLit lit1 warnAboutOverflowedOverLit lit2 ; return (idDsWrapper, n) } @@ -514,28 +511,28 @@ tidy1 _ _ non_interesting_pat = return (idDsWrapper, non_interesting_pat) -------------------- -tidy_bang_pat :: Id -> Origin -> SrcSpanAnnA -> Pat GhcTc +tidy_bang_pat :: Id -> Bool -> SrcSpanAnnA -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc) -- Discard par/sig under a bang -tidy_bang_pat v o _ (ParPat _ _ (L l p) _) = tidy_bang_pat v o l p -tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p +tidy_bang_pat v g _ (ParPat _ _ (L l p) _) = tidy_bang_pat v g l p +tidy_bang_pat v g _ (SigPat _ (L l p) _) = tidy_bang_pat v g l p -- Push the bang-pattern inwards, in the hope that -- it may disappear next time -tidy_bang_pat v o l (AsPat x v' at p) - = tidy1 v o (AsPat x v' at (L l (BangPat noExtField p))) -tidy_bang_pat v o l (XPat (CoPat w p t)) - = tidy1 v o (XPat $ CoPat w (BangPat noExtField (L l p)) t) +tidy_bang_pat v g l (AsPat x v' at p) + = tidy1 v g (AsPat x v' at (L l (BangPat noExtField p))) +tidy_bang_pat v g l (XPat (CoPat w p t)) + = tidy1 v g (XPat $ CoPat w (BangPat noExtField (L l p)) t) -- Discard bang around strict pattern -tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(ListPat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(TuplePat {}) = tidy1 v o p -tidy_bang_pat v o _ p@(SumPat {}) = tidy1 v o p +tidy_bang_pat v g _ p@(LitPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(ListPat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(TuplePat {}) = tidy1 v g p +tidy_bang_pat v g _ p@(SumPat {}) = tidy1 v g p -- Data/newtype constructors -tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) +tidy_bang_pat v g l p@(ConPat { pat_con = L _ (RealDataCon dc) , pat_args = args , pat_con_ext = ConPatTc { cpt_arg_tys = arg_tys @@ -544,8 +541,8 @@ tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc) -- Newtypes: push bang inwards (#9844) = if isNewTyCon (dataConTyCon dc) - then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) - else tidy1 v o p -- Data types: discard the bang + then tidy1 v g (p { pat_args = push_bang_into_newtype_arg l (scaledThing ty) args }) + else tidy1 v g p -- Data types: discard the bang where (ty:_) = dataConInstArgTys dc arg_tys @@ -808,16 +805,14 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags - ; let upats = map (unLoc . decideBangHood dflags) pats + ; let upats = map (decideBangHood dflags) pats -- pat_nablas is the covered set *after* matching the pattern, but -- before any of the GRHSs. We extend the environment with pat_nablas -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats match_result } discard_warnings_if_skip_pmc orig = if requiresPMC orig @@ -958,10 +953,9 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) else getLdiNablas - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = - updPmNablasMatchResult ldi_nablas match_result } + ; let eqn_info = EqnMatch { eqn_pat = decideBangHood dflags pat + , eqn_rest = + EqnDone $ updPmNablasMatchResult ldi_nablas match_result } -- See Note [Long-distance information in do notation] -- in GHC.HsToCore.Expr. @@ -999,6 +993,13 @@ data PatGroup -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors @@ -1019,7 +1020,7 @@ the PgN constructor as a FractionalLit if numeric, and add a PgOverStr construct for overloaded strings. -} -groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInfo)] +groupEquations :: Platform -> [EquationInfoNE] -> [NonEmpty (PatGroup, EquationInfoNE)] -- If the result is of form [g1, g2, g3], -- (a) all the (pg,eq) pairs in g1 have the same pg -- (b) none of the gi are empty @@ -1163,8 +1164,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 exp (HsApp _ e1 e2) (HsApp _ e1' e2') = lexp e1 e1' && lexp e2 e2' -- the fixities have been straightened out by now, so it's safe -- to ignore them? - exp (OpApp _ l o ri) (OpApp _ l' o' ri') = - lexp l l' && lexp o o' && lexp ri ri' + exp (OpApp _ l g ri) (OpApp _ l' o' ri') = + lexp l l' && lexp g o' && lexp ri ri' exp (NegApp _ e n) (NegApp _ e' n') = lexp e e' && syn_exp n n' exp (SectionL _ e1 e2) (SectionL _ e1' e2') = lexp e1 e1' && lexp e2 e2' ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -21,7 +21,6 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( match ) import GHC.Hs import GHC.HsToCore.Binds import GHC.Core.ConLike -import GHC.Types.Basic import GHC.Tc.Utils.TcType import GHC.Core.Multiplicity import GHC.HsToCore.Monad @@ -95,7 +94,7 @@ have-we-used-all-the-constructors? question; the local function matchConFamily :: NonEmpty Id -> Type - -> NonEmpty (NonEmpty EquationInfo) + -> NonEmpty (NonEmpty EquationInfoNE) -> DsM (MatchResult CoreExpr) -- Each group of eqns is for a single constructor matchConFamily (var :| vars) ty groups @@ -114,7 +113,7 @@ matchConFamily (var :| vars) ty groups matchPatSyn :: NonEmpty Id -> Type - -> NonEmpty EquationInfo + -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchPatSyn (var :| vars) ty eqns = do let mult = idMult var @@ -130,7 +129,7 @@ type ConArgPats = HsConPatDetails GhcTc matchOneConLike :: [Id] -> Type -> Mult - -> NonEmpty EquationInfo + -> NonEmpty EquationInfoNE -> DsM (CaseAlt ConLike) matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single constructor = do { let inst_tys = assert (all tcIsTcTyVar ex_tvs) $ @@ -144,7 +143,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- and returns the types of the *value* args, which is what we want match_group :: [Id] - -> NonEmpty (ConArgPats, EquationInfo) + -> NonEmpty (ConArgPats, EquationInfoNE) -> DsM (MatchResult CoreExpr) -- All members of the group have compatible ConArgPats match_group arg_vars arg_eqn_prs @@ -154,24 +153,21 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, EqnMatch { + eqn_pat = L _ (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind }}) + , eqn_rest = rest }) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated SkipPmc - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , prependPats (conArgPats val_arg_tys args) rest ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we @@ -185,7 +181,7 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct -- suggestions for the new variables -- Divide into sub-groups; see Note [Record patterns] - ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfo)) + ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfoNE)) groups = NE.groupBy1 compatible_pats $ fmap (\eqn -> (pat_args (firstPat eqn), eqn)) (eqn1 :| eqns) @@ -257,14 +253,14 @@ conArgPats :: [Scaled Type]-- Instantiated argument types -- Used only to fill in the types of WildPats, which -- are probably never looked at anyway -> ConArgPats - -> [Pat GhcTc] -conArgPats _arg_tys (PrefixCon _ ps) = map unLoc ps -conArgPats _arg_tys (InfixCon p1 p2) = [unLoc p1, unLoc p2] + -> [LPat GhcTc] +conArgPats _arg_tys (PrefixCon _ ps) = ps +conArgPats _arg_tys (InfixCon p1 p2) = [p1, p2] conArgPats arg_tys (RecCon (HsRecFields { rec_flds = rpats })) - | null rpats = map WildPat (map scaledThing arg_tys) + | null rpats = map (noLocA . WildPat . scaledThing) arg_tys -- Important special case for C {}, which can be used for a -- datacon that isn't declared to have fields at all - | otherwise = map (unLoc . hfbRHS . unLoc) rpats + | otherwise = map (hfbRHS . unLoc) rpats {- Note [Record patterns] ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -607,7 +607,7 @@ tidyNPat over_lit mb_neg eq outer_ty matchLiterals :: NonEmpty Id -> Type -- ^ Type of the whole case expression - -> NonEmpty (NonEmpty EquationInfo) -- ^ All PgLits + -> NonEmpty (NonEmpty EquationInfoNE) -- ^ All PgLits -> DsM (MatchResult CoreExpr) matchLiterals (var :| vars) ty sub_groups @@ -625,11 +625,11 @@ matchLiterals (var :| vars) ty sub_groups return (mkCoPrimCaseMatchResult var ty $ NEL.toList alts) } where - match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group :: NonEmpty EquationInfoNE -> DsM (Literal, MatchResult CoreExpr) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let EqnMatch { eqn_pat = L _ (LitPat _ hs_lit) } = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -682,7 +682,7 @@ hsLitKey _ l = pprPanic "hsLitKey" (ppr l) ************************************************************************ -} -matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchNPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) matchNPats (var :| vars) ty (eqn1 :| eqns) -- All for the same literal = do { let NPat _ (L _ lit) mb_neg eq_chk = firstPat eqn1 ; lit_expr <- dsOverLit lit @@ -711,7 +711,7 @@ We generate: \end{verbatim} -} -matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +matchNPlusKPats :: NonEmpty Id -> Type -> NonEmpty EquationInfoNE -> DsM (MatchResult CoreExpr) -- All NPlusKPats, for the *same* literal k matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) = do { let NPlusKPat _ (L _ n1) (L _ lit1) lit2 ge minus @@ -727,7 +727,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 (EqnMatch { eqn_pat = L _ (NPlusKPat _ (L _ n) _ _ _ _), eqn_rest = rest }) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -49,7 +49,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), EquationInfoNE, prependPats, mkEqnInfo, eqnMatchResult, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -92,7 +93,6 @@ import GHC.Unit.Module import GHC.Unit.Module.ModGuts import GHC.Types.Name.Reader -import GHC.Types.Basic ( Origin ) import GHC.Types.SourceFile import GHC.Types.Id import GHC.Types.Var (EvId) @@ -132,27 +132,42 @@ instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match data EquationInfo - = EqnInfo { eqn_pats :: [Pat GhcTc] - -- ^ The patterns for an equation - -- - -- NB: We have /already/ applied 'decideBangHood' to - -- these patterns. See Note [decideBangHood] in "GHC.HsToCore.Utils" - - , eqn_orig :: Origin - -- ^ Was this equation present in the user source? - -- - -- This helps us avoid warnings on patterns that GHC elaborated. - -- - -- For instance, the pattern @-1 :: Word@ gets desugared into - -- @W# -1## :: Word@, but we shouldn't warn about an overflowed - -- literal for /both/ of these cases. - - , eqn_rhs :: MatchResult CoreExpr - -- ^ What to do after match - } + = EqnMatch { eqn_pat :: LPat GhcTc + -- ^ The first pattern of the equation + -- + -- NB: The location info is used to determine whether the + -- pattern is generated or not. + -- This helps us avoid warnings on patterns that GHC elaborated. + -- + -- NB: We have /already/ applied 'decideBangHood' to this + -- pattern. See Note [decideBangHood] in "GHC.HsToCore.Utils" + + , eqn_rest :: EquationInfo } + -- ^ The rest of the equation after its first pattern + + | EqnDone + -- The empty tail of an equation having no more patterns + (MatchResult CoreExpr) + -- ^ What to do after match + +type EquationInfoNE = EquationInfo +-- An EquationInfo which has at least one pattern + +prependPats :: [LPat GhcTc] -> EquationInfo -> EquationInfo +prependPats [] eqn = eqn +prependPats (pat:pats) eqn = EqnMatch { eqn_pat = pat, eqn_rest = prependPats pats eqn } + +mkEqnInfo :: [LPat GhcTc] -> MatchResult CoreExpr -> EquationInfo +mkEqnInfo pats = prependPats pats . EqnDone + +eqnMatchResult :: EquationInfo -> MatchResult CoreExpr +eqnMatchResult (EqnDone rhs) = rhs +eqnMatchResult (EqnMatch { eqn_rest = eq }) = eqnMatchResult eq instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . allEqnPats where + allEqnPats (EqnDone {}) = [] + allEqnPats (EqnMatch { eqn_pat = pat, eqn_rest = eq }) = unLoc pat : allEqnPats eq type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, shiftEqns, combineEqnRhss, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -194,12 +194,16 @@ The ``equation info'' used by @match@ is relatively complicated and worthy of a type synonym and a few handy functions. -} -firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat :: EquationInfoNE -> Pat GhcTc +firstPat (EqnMatch { eqn_pat = pat }) = unLoc pat +firstPat (EqnDone {}) = error "firstPat: no patterns" -shiftEqns :: Functor f => f EquationInfo -> f EquationInfo +shiftEqns :: Functor f => f EquationInfoNE -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap eqn_rest + +combineEqnRhss :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineEqnRhss eqns = return $ foldr1 combineMatchResults $ map eqnMatchResult (NEL.toList eqns) -- Functions on MatchResult CoreExprs ===================================== libraries/base/Data/Fixed.hs ===================================== @@ -13,10 +13,19 @@ -- Stability : stable -- Portability : portable -- --- This module defines a \"Fixed\" type for fixed-precision arithmetic. --- The parameter to 'Fixed' is any type that's an instance of 'HasResolution'. --- 'HasResolution' has a single method that gives the resolution of the 'Fixed' --- type. +-- This module defines a 'Fixed' type for working with fixed-point arithmetic. +-- Fixed-point arithmetic represents fractional numbers with a fixed number of +-- digits for their fractional part. This is different to the behaviour of the floating-point +-- number types 'Float' and 'Double', because the number of digits of the +-- fractional part of 'Float' and 'Double' numbers depends on the size of the number. +-- Fixed point arithmetic is frequently used in financial mathematics, where they +-- are used for representing decimal currencies. +-- +-- The type 'Fixed' is used for fixed-point fractional numbers, which are internally +-- represented as an 'Integer'. The type 'Fixed' takes one parameter, which should implement +-- the typeclass 'HasResolution', to specify the number of digits of the fractional part. +-- This module provides instances of the `HasResolution` typeclass for arbitrary typelevel +-- natural numbers, and for some canonical important fixed-point representations. -- -- This module also contains generalisations of 'div', 'mod', and 'divMod' to -- work with any 'Real' instance. @@ -31,18 +40,49 @@ ----------------------------------------------------------------------------- module Data.Fixed -( - div',mod',divMod', - +( -- * The Fixed Type Fixed(..), HasResolution(..), showFixed, + -- * Resolution \/ Scaling Factors + -- | The resolution or scaling factor determines the number of digits in the fractional part. + -- + -- +------------+----------------------+--------------------------+--------------------------+ + -- | Resolution | Scaling Factor | Synonym for \"Fixed EX\" | show (12345 :: Fixed EX) | + -- +============+======================+==========================+==========================+ + -- | E0 | 1\/1 | Uni | 12345.0 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E1 | 1\/10 | Deci | 1234.5 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E2 | 1\/100 | Centi | 123.45 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E3 | 1\/1 000 | Milli | 12.345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E6 | 1\/1 000 000 | Micro | 0.012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E9 | 1\/1 000 000 000 | Nano | 0.000012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- | E12 | 1\/1 000 000 000 000 | Pico | 0.000000012345 | + -- +------------+----------------------+--------------------------+--------------------------+ + -- + + -- ** 1\/1 E0,Uni, + -- ** 1\/10 E1,Deci, + -- ** 1\/100 E2,Centi, + -- ** 1\/1 000 E3,Milli, + -- ** 1\/1 000 000 E6,Micro, + -- ** 1\/1 000 000 000 E9,Nano, - E12,Pico + -- ** 1\/1 000 000 000 000 + E12,Pico, + -- * Generalized Functions on Real's + div', + mod', + divMod' ) where import Data.Data @@ -67,7 +107,14 @@ mod' :: (Real a) => a -> a -> a mod' n d = n - (fromInteger f) * d where f = div' n d --- | The type parameter should be an instance of 'HasResolution'. +-- | The type of fixed-point fractional numbers. +-- The type parameter specifies the number of digits of the fractional part and should be an instance of the 'HasResolution' typeclass. +-- +-- === __Examples__ +-- +-- @ +-- MkFixed 12345 :: Fixed E3 +-- @ newtype Fixed (a :: k) = MkFixed Integer deriving ( Eq -- ^ @since 2.01 , Ord -- ^ @since 2.01 @@ -77,6 +124,7 @@ newtype Fixed (a :: k) = MkFixed Integer -- Our manual instance has the more general (Typeable a) context. tyFixed :: DataType tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed] + conMkFixed :: Constr conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix @@ -87,7 +135,9 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where dataTypeOf _ = tyFixed toConstr _ = conMkFixed +-- | Types which can be used as a resolution argument to the 'Fixed' type constructor must implement the 'HasResolution' typeclass. class HasResolution (a :: k) where + -- | Provide the resolution for a fixed-point fractional number. resolution :: p a -> Integer -- | For example, @Fixed 1000@ will give you a 'Fixed' with a resolution of 1000. @@ -109,33 +159,26 @@ withResolution foo = withType (foo . resolution) -- resolution of the 'Fixed' value. For example, when enumerating values of -- resolution @10^-3@ of @type Milli = Fixed E3@, -- --- @ --- succ (0.000 :: Milli) == 0.001 --- @ --- +-- >>> succ (0.000 :: Milli) +-- 0.001 -- -- and likewise -- --- @ --- pred (0.000 :: Milli) == -0.001 --- @ --- +-- >>> pred (0.000 :: Milli) +-- -0.001 -- -- In other words, 'succ' and 'pred' increment and decrement a fixed-precision -- value by the least amount such that the value's resolution is unchanged. -- For example, @10^-12@ is the smallest (positive) amount that can be added to -- a value of @type Pico = Fixed E12@ without changing its resolution, and so -- --- @ --- succ (0.000000000000 :: Pico) == 0.000000000001 --- @ --- +-- >>> succ (0.000000000000 :: Pico) +-- 0.000000000001 -- -- and similarly -- --- @ --- pred (0.000000000000 :: Pico) == -0.000000000001 --- @ +-- >>> pred (0.000000000000 :: Pico) +-- -0.000000000001 -- -- -- This is worth bearing in mind when defining 'Fixed' arithmetic sequences. In @@ -175,6 +218,7 @@ instance Enum (Fixed a) where -- -- >>> (0.2 * 0.6 :: Deci) * 0.9 == 0.2 * (0.6 * 0.9) -- False +-- -- >>> (0.1 + 0.1 :: Deci) * 0.5 == 0.1 * 0.5 + 0.1 * 0.5 -- False instance (HasResolution a) => Num (Fixed a) where @@ -223,6 +267,15 @@ withDot "" = "" withDot s = '.':s -- | First arg is whether to chop off trailing zeros +-- +-- === __Examples__ +-- +-- >>> showFixed True (MkFixed 10000 :: Fixed E3) +-- "10" +-- +-- >>> showFixed False (MkFixed 10000 :: Fixed E3) +-- "10.000" +-- showFixed :: (HasResolution a) => Bool -> Fixed a -> String showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa)) showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where @@ -256,58 +309,135 @@ convertFixed (Number n) e = ceiling (logBase 10 (fromInteger r) :: Double) convertFixed _ = pfail +-- | Resolution of 1, this works the same as Integer. data E0 -- | @since 4.1.0.0 instance HasResolution E0 where resolution _ = 1 --- | resolution of 1, this works the same as Integer + +-- | Resolution of 1, this works the same as Integer. +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E0) +-- "12345.0" +-- +-- >>> show (MkFixed 12345 :: Uni) +-- "12345.0" +-- type Uni = Fixed E0 +-- | Resolution of 10^-1 = .1 data E1 -- | @since 4.1.0.0 instance HasResolution E1 where resolution _ = 10 --- | resolution of 10^-1 = .1 + +-- | Resolution of 10^-1 = .1 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E1) +-- "1234.5" +-- +-- >>> show (MkFixed 12345 :: Deci) +-- "1234.5" +-- type Deci = Fixed E1 +-- | Resolution of 10^-2 = .01, useful for many monetary currencies data E2 -- | @since 4.1.0.0 instance HasResolution E2 where resolution _ = 100 --- | resolution of 10^-2 = .01, useful for many monetary currencies + +-- | Resolution of 10^-2 = .01, useful for many monetary currencies +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E2) +-- "123.45" +-- +-- >>> show (MkFixed 12345 :: Centi) +-- "123.45" +-- type Centi = Fixed E2 +-- | Resolution of 10^-3 = .001 data E3 -- | @since 4.1.0.0 instance HasResolution E3 where resolution _ = 1000 --- | resolution of 10^-3 = .001 + +-- | Resolution of 10^-3 = .001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E3) +-- "12.345" +-- +-- >>> show (MkFixed 12345 :: Milli) +-- "12.345" +-- type Milli = Fixed E3 +-- | Resolution of 10^-6 = .000001 data E6 -- | @since 2.01 instance HasResolution E6 where resolution _ = 1000000 --- | resolution of 10^-6 = .000001 + +-- | Resolution of 10^-6 = .000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E6) +-- "0.012345" +-- +-- >>> show (MkFixed 12345 :: Micro) +-- "0.012345" +-- type Micro = Fixed E6 +-- | Resolution of 10^-9 = .000000001 data E9 -- | @since 4.1.0.0 instance HasResolution E9 where resolution _ = 1000000000 --- | resolution of 10^-9 = .000000001 + +-- | Resolution of 10^-9 = .000000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E9) +-- "0.000012345" +-- +-- >>> show (MkFixed 12345 :: Nano) +-- "0.000012345" +-- type Nano = Fixed E9 +-- | Resolution of 10^-12 = .000000000001 data E12 -- | @since 2.01 instance HasResolution E12 where resolution _ = 1000000000000 --- | resolution of 10^-12 = .000000000001 + +-- | Resolution of 10^-12 = .000000000001 +-- +-- === __Examples__ +-- +-- >>> show (MkFixed 12345 :: Fixed E12) +-- "0.000000012345" +-- +-- >>> show (MkFixed 12345 :: Pico) +-- "0.000000012345" +-- type Pico = Fixed E12 ===================================== libraries/base/GHC/IO/Handle/FD.hs ===================================== @@ -13,6 +13,8 @@ -- -- Handle operations implemented by file descriptors (FDs) -- +-- @since 4.2.0.0 +-- ----------------------------------------------------------------------------- module GHC.IO.Handle.FD ( @@ -157,6 +159,8 @@ openFile fp im = -- raising an exception. If closing the handle raises an exception, then -- this exception will be raised by 'withFile' rather than any exception -- raised by @act at . +-- +-- @since 4.16.0.0 withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r withFile fp im act = catchException @@ -189,6 +193,8 @@ openFileBlocking fp im = -- by raising an exception. If closing the handle raises an exception, then -- this exception will be raised by 'withFile' rather than any exception raised -- by @act at . +-- +-- @since 4.16.0.0 withFileBlocking :: FilePath -> IOMode -> (Handle -> IO r) -> IO r withFileBlocking fp im act = catchException @@ -217,6 +223,8 @@ openBinaryFile fp m = -- the file will be closed automatically. The action /should/ -- close the file when finished with it so the file does not remain -- open until the garbage collector collects the handle. +-- +-- @since 4.16.0.0 withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r withBinaryFile fp im act = catchException @@ -366,6 +374,8 @@ fdToHandle fdint = do -- | Turn an existing Handle into a file descriptor. This function throws an -- IOError if the Handle does not reference a file descriptor. +-- +-- @since 4.10.0.0 handleToFd :: Handle -> IO FD.FD handleToFd h = case h of FileHandle _ mv -> do ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit bb0e5cd49655b41bd3209b100f7a5a74698cbe83 +Subproject commit 367f6bffc158ef1a9055fb876e23447636853aa4 ===================================== libraries/ghc-prim/cbits/atomic.c ===================================== @@ -279,28 +279,36 @@ extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord8 *) x, (StgWord8) old, (StgWord8) new); + StgWord8 expected = (StgWord8) old; + __atomic_compare_exchange_n((StgWord8 *) x, &expected, (StgWord8) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord16 *) x, (StgWord16) old, (StgWord16) new); + StgWord16 expected = (StgWord16) old; + __atomic_compare_exchange_n((StgWord16 *) x, &expected, (StgWord16) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new); StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new) { - return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new); + StgWord32 expected = (StgWord32) old; + __atomic_compare_exchange_n((StgWord32 *) x, &expected, (StgWord32) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } extern StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new); StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new) { - return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new); + StgWord64 expected = (StgWord64) old; + __atomic_compare_exchange_n((StgWord64 *) x, &expected, (StgWord64) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST); + return expected; } // Atomic exchange operations View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be96d684d0e6bfa6ae0e9425f34048fab2e744d8...7eceeb0cd202af25d296759d5605b00c08f1c658 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be96d684d0e6bfa6ae0e9425f34048fab2e744d8...7eceeb0cd202af25d296759d5605b00c08f1c658 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 21:13:44 2023 From: gitlab at gitlab.haskell.org (Richard Eisenberg (@rae)) Date: Fri, 28 Jul 2023 17:13:44 -0400 Subject: [Git][ghc/ghc][wip/T23162] 610 commits: ci: make lint-ci-config job fast again Message-ID: <64c42f88754b4_1cc350ba018729af@gitlab.mail> Richard Eisenberg pushed to branch wip/T23162 at Glasgow Haskell Compiler / GHC Commits: 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 A bunch of changes related to eta reduction This is a large collection of changes all relating to eta reduction, originally triggered by #18993, but there followed a long saga. Specifics: ...lots of lines omitted... Other incidental changes * Fix a fairly long-standing outright bug in the ApplyToVal case of GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the tail of 'dmds' in the recursive call, which meant the demands were All Wrong. I have no idea why this has not caused problems before now. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04:00 driver: Use hooks from plugin_hsc_env This fixes a bug in oneshot mode where hooks modified in a plugin wouldn't be used in oneshot mode because we neglected to use the right hsc_env. This was observed by @csabahruska. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04:00 Rework plugin initialisation points In general this patch pushes plugin initialisation points to earlier in the pipeline. As plugins can modify the `HscEnv`, it's imperative that the plugins are initialised as soon as possible and used thereafter. For example, there are some new tests which modify hsc_logger and other hooks which failed to fire before (and now do) One consequence of this change is that the error for specifying the usage of a HPT plugin from the command line has changed, because it's now attempted to be loaded at initialisation rather than causing a cyclic module import. Closes #21279 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+00:00 rts: Fix data-race in hs_init_ghc As noticed by @Terrorjack, `hs_init_ghc` previously used non-atomic increment/decrement on the RTS's initialization count. This may go wrong in a multithreaded program which initializes the runtime multiple times. Closes #22756. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Restructure IPE buffer layout Reference ticket #21766 This commit restructures IPE buffer list entries to not contain references to their corresponding info tables. IPE buffer list nodes now point to two lists of equal length, one holding the list of info table pointers and one holding the corresponding entries for each info table. This will allow the entry data to be compressed without losing the references to the info tables. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE compression to configure Reference ticket #21766 Adds an `--enable-ipe-data-compreesion` flag to the configure script which will check for libzstd and set the appropriate flags to allow for IPE data compression in the compiler - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04:00 IPE data compression Reference ticket #21766 When IPE data compression is enabled, compress the emitted IPE buffer entries and decompress them in the RTS. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix libzstd detection in configure and RTS Ensure that `HAVE_LIBZSTD` gets defined to either 0 or 1 in all cases and properly check that before IPE data decompression in the RTS. See ticket #21766. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix byte order of IPE data, fix IPE tests Make sure byte order of written IPE buffer entries matches target. Make sure the IPE-related tests properly access the fields of IPE buffer entry nodes with the new IPE layout. This commit also introduces checks to avoid importing modules if IPE compression is not enabled. See ticket #21766. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Fix IPE data decompression buffer allocation Capacity of buffers allocated for decompressed IPE data was incorrect due to a misuse of the `ZSTD_findFrameCompressedSize` function. Fix by always storing decompressed size of IPE data in IPE buffer list nodes and using `ZSTD_findFrameCompressedSize` to determine the size of the compressed data. See ticket #21766 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add optional dependencies to ./configure output Changes the configure script to indicate whether libnuma, libzstd, or libdw are being used as dependencies due to their optional features being enabled. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add IPE-enabled builds to CI - Adds an IPE job to the CI pipeline which is triggered by the ~IPE label - Introduces CI logic to enable IPE data compression - Enables uncompressed IPE data on debug CI job - Regenerates jobs.yaml MR https://gitlab.haskell.org/ghc/ci-images/-/merge_requests/112 on the images repository is meant to ensure that the proper images have libzstd-dev installed. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes Add mention of IPE data compression to user's guide and the release notes for 9.8.1. Also note the impact compression has on binary size in both places. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02:00 Invisible binders in type declarations (#22560) This patch implements @k-binders introduced in GHC Proposal #425 and guarded behind the TypeAbstractions extension: type D :: forall k j. k -> j -> Type data D @k @j a b = ... ^^ ^^ To represent the new syntax, we modify LHsQTyVars as follows: - hsq_explicit :: [LHsTyVarBndr () pass] + hsq_explicit :: [LHsTyVarBndr (HsBndrVis pass) pass] HsBndrVis is a new data type that records the distinction between type variable binders written with and without the @ sign: data HsBndrVis pass = HsBndrRequired | HsBndrInvisible (LHsToken "@" pass) The rest of the patch updates GHC, template-haskell, and haddock to handle the new syntax. Parser: The PsErrUnexpectedTypeAppInDecl error message is removed. The syntax it used to reject is now permitted. Renamer: The @ sign does not affect the scope of a binder, so the changes to the renamer are minimal. See rnLHsTyVarBndrVisFlag. Type checker: There are three code paths that were updated to deal with the newly introduced invisible type variable binders: 1. checking SAKS: see kcCheckDeclHeader_sig, matchUpSigWithDecl 2. checking CUSK: see kcCheckDeclHeader_cusk 3. inference: see kcInferDeclHeader, rejectInvisibleBinders Helper functions bindExplicitTKBndrs_Q_Skol and bindExplicitTKBndrs_Q_Tv are generalized to work with HsBndrVis. Updates the haddock submodule. Metric Increase: MultiLayerModulesTH_OneShot Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04:00 hadrian: Ensure that -Werror is passed when compiling the RTS. Previously the `+werror` transformer would only pass `-Werror` to GHC, which does not ensure that the same is passed to the C compiler when building the RTS. Arguably this is itself a bug but for now we will just work around this by passing `-optc-Werror` to GHC. I tried to enable `-Werror` in all C compilations but the boot libraries are something of a portability nightmare. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: implement TH support - Add ghc-interp.js bootstrap script for the JS interpreter - Interactively link and execute iserv code from the ghci package - Incrementally load and run JS code for splices into the running iserv Co-authored-by: Luite Stegeman <stegeman at gmail.com> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 083794b1 by Torsten Schmits at 2023-07-03T03:27:27-04:00 Add -fbreak-points to control breakpoint insertion Rather than statically enabling breakpoints only for the interpreter, this adds a new flag. Tracking ticket: #23057 MR: !10466 - - - - - fd8c5769 by Ben Gamari at 2023-07-03T03:28:04-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - 98185d52 by Ben Gamari at 2023-07-03T03:28:05-04:00 testsuite: Add test for #23400 - - - - - 4aac0540 by Ben Gamari at 2023-07-03T03:28:42-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 03f941f4 by Ben Bellick at 2023-07-03T03:29:29-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - 6074cc3c by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Add failing test case for #23492 - - - - - 356a2692 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Use generated src span for catch-all case of record selector functions This fixes #23492. The problem was that we used the real source span of the field declaration for the generated catch-all case in the selector function, in particular in the generated call to `recSelError`, which meant it was included in the HIE output. Using `generatedSrcSpan` instead means that it is not included. - - - - - 3efe7f39 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Introduce genLHsApp and genLHsLit helpers in GHC.Rename.Utils - - - - - dd782343 by Moisés Ackerman at 2023-07-03T03:30:13-04:00 Construct catch-all default case using helpers GHC.Rename.Utils concrete helpers instead of wrapGenSpan + HS AST constructors - - - - - 0e09c38e by Ryan Hendrickson at 2023-07-03T03:30:56-04:00 Add regression test for #23549 - - - - - 32741743 by Alexis King at 2023-07-03T03:31:36-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 82ac6bf1 by Bryan Richter at 2023-07-03T03:32:15-04:00 Add missing void prototypes to rts functions See #23561. - - - - - 6078b429 by Ben Gamari at 2023-07-03T03:32:51-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - aa2db0ae by Ben Gamari at 2023-07-03T03:33:29-04:00 testsuite: Update documentation - - - - - 924a2362 by Gregory Gerasev at 2023-07-03T03:34:10-04:00 Better error for data deriving of type synonym/family. Closes #23522 - - - - - 4457da2a by Dave Barton at 2023-07-03T03:34:51-04:00 Fix some broken links and typos - - - - - de5830d0 by Ben Gamari at 2023-07-04T22:03:59-04:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 59c5fe1d by doyougnu at 2023-07-04T22:04:56-04:00 CI: add JS release and debug builds, regen CI jobs - - - - - 679bbc97 by Vladislav Zavialov at 2023-07-04T22:05:32-04:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 945d3599 by Ben Gamari at 2023-07-04T22:06:08-04:00 gitlab: Drop backport-for-8.8 MR template Its usefulness has long passed. - - - - - 66c721d3 by Alan Zimmerman at 2023-07-04T22:06:44-04:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 2be99b7e by Matthew Pickering at 2023-07-04T22:07:21-04:00 Fix deprecation warning when deprecated identifier is from another module A stray 'Just' was being printed in the deprecation message. Fixes #23573 - - - - - 46c9bcd6 by Ben Gamari at 2023-07-04T22:07:58-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - ec55035f by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 3a09b789 by Ben Gamari at 2023-07-04T22:07:58-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is only understood by Clang and consequently throws warnings on platforms using gcc. Sadly, there is no good way to treat such warnings as non-fatal with `-Werror` so for now we simply make this flag specific to platforms known to use Clang and case-insensitive filesystems (Darwin and Windows). See #23577. - - - - - 4af7eac2 by Mario Blažević at 2023-07-04T22:08:38-04:00 Fixed ticket #23571, TH.Ppr.pprLit hanging on large numeric literals - - - - - 2304c697 by Ben Gamari at 2023-07-04T22:09:15-04:00 compiler: Make OccSet opaque - - - - - cf735db8 by Andrei Borzenkov at 2023-07-04T22:09:51-04:00 Add Note about why we need forall in Code to be on the right - - - - - fb140f82 by Hécate Moonlight at 2023-07-04T22:10:34-04:00 Relax the constraint about the foreign function's calling convention of FinalizerPtr to capi as well as ccall. - - - - - 9ce44336 by meooow25 at 2023-07-05T11:42:37-04:00 Improve the situation with the stimes cycle Currently the Semigroup stimes cycle is resolved in GHC.Base by importing stimes implementations from a hs-boot file. Resolve the cycle using hs-boot files for required classes (Num, Integral) instead. Now stimes can be defined directly in GHC.Base, making inlining and specialization possible. This leads to some new boot files for `GHC.Num` and `GHC.Real`, the methods for those are only used to implement `stimes` so it doesn't appear that these boot files will introduce any new performance traps. Metric Decrease: T13386 T8095 Metric Increase: T13253 T13386 T18698a T18698b T19695 T8095 - - - - - 9edcb1fb by Jaro Reinders at 2023-07-05T11:43:24-04:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiComponentModulesRecomp MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14697 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 6b9db7d4 by Brandon Chinn at 2023-07-05T11:44:03-04:00 Fix docs for __GLASGOW_HASKELL_FULL_VERSION__ macro - - - - - 40f4ef7c by Torsten Schmits at 2023-07-05T18:06:19-04:00 Substitute free variables captured by breakpoints in SpecConstr Fixes #23267 - - - - - 2b55cb5f by sheaf at 2023-07-05T18:07:07-04:00 Reinstate untouchable variable error messages This extra bit of information was accidentally being discarded after a refactoring of the way we reported problems when unifying a type variable with another type. This patch rectifies that. - - - - - 53ed21c5 by Rodrigo Mesquita at 2023-07-05T18:07:47-04:00 configure: Drop Clang command from settings Due to 01542cb7227614a93508b97ecad5b16dddeb6486 we no longer use the `runClang` function, and no longer need to configure into settings the Clang command. We used to determine options at runtime to pass clang when it was used as an assembler, but now that we configure at configure time we no longer need to. - - - - - 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - e06e42f2 by Richard Eisenberg at 2023-07-23T20:52:19-04:00 Initial attempt - - - - - 17 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - − .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c16c16b59de3416d054ff11d57258b916e60303a...e06e42f25f23303e959e5f80b08336fdd1d947fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c16c16b59de3416d054ff11d57258b916e60303a...e06e42f25f23303e959e5f80b08336fdd1d947fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 21:54:52 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 28 Jul 2023 17:54:52 -0400 Subject: [Git][ghc/ghc][wip/T22404] 4 commits: Update Match Datatype Message-ID: <64c4392c9c4f7_1cc350b9ff076983@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - af04ebee by Simon Peyton Jones at 2023-07-28T22:54:13+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. But the geom mean stay solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 30 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Types/Basic.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68e92a9acb53114cb4498134ac2728a507bc96df...af04ebee389800f4350d22b7bb0e919604baf2eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68e92a9acb53114cb4498134ac2728a507bc96df...af04ebee389800f4350d22b7bb0e919604baf2eb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 22:35:59 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Fri, 28 Jul 2023 18:35:59 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 9 commits: EPA: remove AnnEofComment Message-ID: <64c442cf2d6ac_1cc350ba004776a9@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: 99d37567 by Alan Zimmerman at 2023-07-27T21:04:28+01:00 EPA: remove AnnEofComment It is no longer used - - - - - 998c418d by Alan Zimmerman at 2023-07-28T19:40:53+01:00 EPA: make locA a function, not a field name - - - - - 124a27e7 by Alan Zimmerman at 2023-07-28T20:21:33+01:00 EPA: generalise reLoc - - - - - 5a5fbaf4 by Alan Zimmerman at 2023-07-28T23:31:17+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 98dc8476 by Alan Zimmerman at 2023-07-28T23:31:21+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 3d2586a1 by Alan Zimmerman at 2023-07-28T23:31:21+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - f8fd74d1 by Alan Zimmerman at 2023-07-28T23:31:21+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 0e95b0af by Alan Zimmerman at 2023-07-28T23:31:21+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 663d596c by Alan Zimmerman at 2023-07-28T23:31:21+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 30 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6320a706f4fbc12a02d0249aa13e0643c1efb4bf...663d596cd3c214cb63af96b11bdc31e1d3856492 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6320a706f4fbc12a02d0249aa13e0643c1efb4bf...663d596cd3c214cb63af96b11bdc31e1d3856492 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 22:46:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 18:46:42 -0400 Subject: [Git][ghc/ghc][master] Include -haddock in DynFlags fingerprint Message-ID: <64c44552e7202_1cc350ba054882a7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 1 changed file: - compiler/GHC/Driver/Flags.hs Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -568,6 +568,7 @@ codeGenFlags = EnumSet.fromList -- Flags that affect generated code , Opt_ExposeAllUnfoldings , Opt_NoTypeableBinds + , Opt_Haddock -- Flags that affect catching of runtime errors , Opt_CatchNonexhaustiveCases View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bfc89087964083336e8dca0d44b6f1884c19cd8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0bfc89087964083336e8dca0d44b6f1884c19cd8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 22:48:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 18:48:09 -0400 Subject: [Git][ghc/ghc][master] Aarch64 NCG: Use encoded immediates for literals. Message-ID: <64c445a848e85_1cc350ba01897990@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 4 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -372,6 +372,97 @@ getSomeReg expr = do Fixed rep reg code -> return (reg, rep, code) +{- Note [Aarch64 immediates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Aarch64 with it's fixed width instruction encoding uses leftover space for +immediates. +If you want the full rundown consult the arch reference document: +"Arm® Architecture Reference Manual" - "C3.4 Data processing - immediate" + +The gist of it is that different instructions allow for different immediate encodings. +The ones we care about for better code generation are: + +* Simple but potentially repeated bit-patterns for logic instructions. +* 16bit numbers shifted by multiples of 16. +* 12 bit numbers optionally shifted by 12 bits. + +It might seem like the ISA allows for 64bit immediates but this isn't the case. +Rather there are some instruction aliases which allow for large unencoded immediates +which will then be transalted to one of the immediate encodings implicitly. + +For example mov x1, #0x10000 is allowed but will be assembled to movz x1, #0x1, lsl #16 +-} + +-- | Move (wide immediate) +-- Allows for 16bit immediate which can be shifted by 0/16/32/48 bits. +-- Used with MOVZ,MOVN, MOVK +-- See Note [Aarch64 immediates] +getMovWideImm :: Integer -> Width -> Maybe Operand +getMovWideImm n w + -- TODO: Handle sign extension/negatives + | n <= 0 + = Nothing + -- Fits in 16 bits + | sized_n < 2^(16 :: Int) + = Just $ OpImm (ImmInteger truncated) + + -- 0x0000 0000 xxxx 0000 + | trailing_zeros >= 16 && sized_n < 2^(32 :: Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 16) SLSL 16 + + -- 0x 0000 xxxx 0000 0000 + | trailing_zeros >= 32 && sized_n < 2^(48 :: Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 32) SLSL 32 + + -- 0x xxxx 0000 0000 0000 + | trailing_zeros >= 48 + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 48) SLSL 48 + + | otherwise + = Nothing + where + truncated = narrowU w n + sized_n = fromIntegral truncated :: Word64 + trailing_zeros = countTrailingZeros sized_n + +-- | Arithmetic(immediate) +-- Allows for 12bit immediates which can be shifted by 0 or 12 bits. +-- Used with ADD, ADDS, SUB, SUBS, CMP, CMN +-- See Note [Aarch64 immediates] +getArithImm :: Integer -> Width -> Maybe Operand +getArithImm n w + -- TODO: Handle sign extension + | n <= 0 + = Nothing + -- Fits in 16 bits + -- Fits in 12 bits + | sized_n < 2^(12::Int) + = Just $ OpImm (ImmInteger truncated) + + -- 12 bits shifted by 12 places. + | trailing_zeros >= 12 && sized_n < 2^(24::Int) + = Just $ OpImmShift (ImmInteger $ truncated `shiftR` 12) SLSL 12 + + | otherwise + = Nothing + where + sized_n = fromIntegral truncated :: Word64 + truncated = narrowU w n + trailing_zeros = countTrailingZeros sized_n + +-- | Logical (immediate) +-- Allows encoding of some repeated bitpatterns +-- Used with AND, ANDS, EOR, ORR, TST +-- and their aliases which includes at least MOV (bitmask immediate) +-- See Note [Aarch64 immediates] +getBitmaskImm :: Integer -> Width -> Maybe Operand +getBitmaskImm n w + | isAArch64Bitmask truncated = Just $ OpImm (ImmInteger truncated) + | otherwise = Nothing + where + truncated = narrowU w n + + -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. getFloatReg :: HasCallStack => CmmExpr -> NatM (Reg, Format, InstrBlock) @@ -494,8 +585,14 @@ getRegister' config plat expr CmmLit lit -> case lit of - -- TODO handle CmmInt 0 specially, use wzr or xzr. - + -- Use wzr xzr for CmmInt 0 if the width matches up, otherwise do a move. + -- TODO: Reenable after https://gitlab.haskell.org/ghc/ghc/-/issues/23632 is fixed. + -- CmmInt 0 W32 -> do + -- let format = intFormat W32 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) + -- CmmInt 0 W64 -> do + -- let format = intFormat W64 + -- return (Fixed format reg_zero (unitOL $ (COMMENT ((text . show $ expr))) )) CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) CmmInt i W16 | i >= 0 -> do @@ -510,8 +607,13 @@ getRegister' config plat expr -- Those need the upper bits set. We'd either have to explicitly sign -- or figure out something smarter. Lowered to -- `MOV dst XZR` + CmmInt i w | i >= 0 + , Just imm_op <- getMovWideImm i w -> do + return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOVZ (OpReg w dst) imm_op))) + CmmInt i w | isNbitEncodeable 16 i, i >= 0 -> do return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger i))))) + CmmInt i w | isNbitEncodeable 32 i, i >= 0 -> do let half0 = fromIntegral (fromIntegral i :: Word16) half1 = fromIntegral (fromIntegral (i `shiftR` 16) :: Word16) @@ -586,7 +688,6 @@ getRegister' config plat expr (op, imm_code) <- litToImm' lit let rep = cmmLitType plat lit format = cmmTypeFormat rep - -- width = typeWidth rep return (Any format (\dst -> imm_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op)) CmmLabelOff lbl off -> do @@ -791,17 +892,51 @@ getRegister' config plat expr -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op -- A "plain" operation. - bitOp w op = do + bitOpImm w op encode_imm = do -- compute x <- x -- compute x <- y -- x, x, x (reg_x, format_x, code_x) <- getSomeReg x - (reg_y, format_y, code_y) <- getSomeReg y - massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOp: incompatible" + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n w + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x == isIntFormat format_y) $ text "bitOpImm: incompatible" return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` - op (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) + op (OpReg w dst) (OpReg w reg_x) op_y) + + -- A (potentially signed) integer operation. + -- In the case of 8- and 16-bit signed arithmetic we must first + -- sign-extend both arguments to 32-bits. + -- See Note [Signed arithmetic on AArch64]. + intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) + intOpImm {- is signed -} True w op _encode_imm = intOp True w op + intOpImm False w op encode_imm = do + -- compute x <- x + -- compute x <- y + -- x, x, x + (reg_x, format_x, code_x) <- getSomeReg x + (op_y, format_y, code_y) <- case y of + CmmLit (CmmInt n w) + | Just imm_operand_y <- encode_imm n w + -> return (imm_operand_y, intFormat w, nilOL) + _ -> do + (reg_y, format_y, code_y) <- getSomeReg y + return (OpReg w reg_y, format_y, code_y) + massertPpr (isIntFormat format_x && isIntFormat format_y) $ text "intOp: non-int" + -- This is the width of the registers on which the operation + -- should be performed. + let w' = opRegWidth w + return $ Any (intFormat w) $ \dst -> + code_x `appOL` + code_y `appOL` + op (OpReg w' dst) (OpReg w' reg_x) (op_y) `appOL` + truncateReg w' w dst -- truncate back to the operand's original width -- A (potentially signed) integer operation. -- In the case of 8- and 16-bit signed arithmetic we must first @@ -847,9 +982,9 @@ getRegister' config plat expr case op of -- Integer operations -- Add/Sub should only be Integer Options. - MO_Add w -> intOp False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) + MO_Add w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (ADD d x y)) getArithImm -- TODO: Handle sub-word case - MO_Sub w -> intOp False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) + MO_Sub w -> intOpImm False w (\d x y -> unitOL $ annExpr expr (SUB d x y)) getArithImm -- Note [CSET] -- ~~~~~~~~~~~ @@ -891,8 +1026,8 @@ getRegister' config plat expr -- N.B. We needn't sign-extend sub-word size (in)equality comparisons -- since we don't care about ordering. - MO_Eq w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d EQ ]) - MO_Ne w -> bitOp w (\d x y -> toOL [ CMP x y, CSET d NE ]) + MO_Eq w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d EQ ]) getArithImm + MO_Ne w -> bitOpImm w (\d x y -> toOL [ CMP x y, CSET d NE ]) getArithImm -- Signed multiply/divide MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) @@ -921,10 +1056,10 @@ getRegister' config plat expr MO_S_Lt w -> intOp True w (\d x y -> toOL [ CMP x y, CSET d SLT ]) -- Unsigned comparisons - MO_U_Ge w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) - MO_U_Le w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) - MO_U_Gt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) - MO_U_Lt w -> intOp False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) + MO_U_Ge w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGE ]) getArithImm + MO_U_Le w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULE ]) getArithImm + MO_U_Gt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d UGT ]) getArithImm + MO_U_Lt w -> intOpImm False w (\d x y -> toOL [ CMP x y, CSET d ULT ]) getArithImm -- Floating point arithmetic MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) @@ -947,9 +1082,9 @@ getRegister' config plat expr MO_F_Lt w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OLT ]) -- x < y <=> y >= x -- Bitwise operations - MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) + MO_And w -> bitOpImm w (\d x y -> unitOL $ AND d x y) getBitmaskImm + MO_Or w -> bitOpImm w (\d x y -> unitOL $ ORR d x y) getBitmaskImm + MO_Xor w -> bitOpImm w (\d x y -> unitOL $ EOR d x y) getBitmaskImm MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) @@ -999,7 +1134,7 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool - isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) + isNbitEncodeable n_bits i = let shift = n_bits - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) -- N.B. MUL does not set the overflow flag. do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -110,6 +110,7 @@ regUsageOfInstr platform instr = case instr of LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) + MOVZ dst src -> usage (regOp src, regOp dst) MVN dst src -> usage (regOp src, regOp dst) ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -251,6 +252,7 @@ patchRegsOfInstr instr env = case instr of LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) + MOVZ o1 o2 -> MOVZ (patchOp o1) (patchOp o2) MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) @@ -381,9 +383,8 @@ mkSpillInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) + mkIp0SpillAddr imm = ANN (text "Spill: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkStrSp imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) mkStrIp0 imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) @@ -408,9 +409,7 @@ mkLoadInstr config reg delta slot = where a .&~. b = a .&. (complement b) - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 + fmt = fmtOfRealReg (case reg of { RegReal r -> r; _ -> panic "Expected real reg"}) mkIp0SpillAddr imm = ANN (text "Reload: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) mkLdrSp imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) @@ -619,7 +618,7 @@ data Instr | MOV Operand Operand -- rd = rn or rd = #i | MOVK Operand Operand -- | MOVN Operand Operand - -- | MOVZ Operand Operand + | MOVZ Operand Operand | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 | ORR Operand Operand Operand -- rd = rn | op2 @@ -708,6 +707,7 @@ instrCon i = LSR{} -> "LSR" MOV{} -> "MOV" MOVK{} -> "MOVK" + MOVZ{} -> "MOVZ" MVN{} -> "MVN" ORN{} -> "ORN" ORR{} -> "ORR" @@ -782,6 +782,9 @@ wzr = OpReg W32 (RegReal (RealRegSingle (-1))) sp = OpReg W64 (RegReal (RealRegSingle 31)) ip0 = OpReg W64 (RegReal (RealRegSingle 16)) +reg_zero :: Reg +reg_zero = RegReal (RealRegSingle (-1)) + _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) x0, x1, x2, x3, x4, x5, x6, x7 :: Operand ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -417,6 +417,7 @@ pprInstr platform instr = case instr of | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 | otherwise -> op2 (text "\tmov") o1 o2 MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 + MOVZ o1 o2 -> op2 (text "\tmovz") o1 o2 MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3 ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -77,6 +77,8 @@ litToImm (CmmInt i w) = ImmInteger (narrowS w i) -- narrow to the width: a CmmInt might be out of -- range, but we assume that ImmInteger only contains -- in-range values. A signed value should be fine here. + -- AK: We do call this with out of range values, however + -- it just truncates as we would expect. litToImm (CmmFloat f W32) = ImmFloat f litToImm (CmmFloat f W64) = ImmDouble f litToImm (CmmLabel l) = ImmCLbl l @@ -147,6 +149,13 @@ classOfRealReg (RealRegSingle i) | i < 32 = RcInteger | otherwise = RcDouble +fmtOfRealReg :: RealReg -> Format +fmtOfRealReg real_reg = + case classOfRealReg real_reg of + RcInteger -> II64 + RcDouble -> FF64 + RcFloat -> panic "No float regs on arm" + regDotColor :: RealReg -> SDoc regDotColor reg = case classOfRealReg reg of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40425c5021a9d8eb5e1c1046e2d5fa0a2918f96c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40425c5021a9d8eb5e1c1046e2d5fa0a2918f96c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 22:48:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 18:48:36 -0400 Subject: [Git][ghc/ghc][master] Bump filepath submodule to 1.4.100.4 Message-ID: <64c445c4a3d39_1cc350ba0401005e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - 1 changed file: - libraries/filepath Changes: ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit bb0e5cd49655b41bd3209b100f7a5a74698cbe83 +Subproject commit 367f6bffc158ef1a9055fb876e23447636853aa4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9a0fa3f6db3ce995c6d0d30798cee78cbd7e90d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9a0fa3f6db3ce995c6d0d30798cee78cbd7e90d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Jul 28 22:49:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 28 Jul 2023 18:49:55 -0400 Subject: [Git][ghc/ghc][master] Add since pragmas to GHC.IO.Handle.FD Message-ID: <64c44612f2211_1cc350b9fb4109369@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - 1 changed file: - libraries/base/GHC/IO/Handle/FD.hs Changes: ===================================== libraries/base/GHC/IO/Handle/FD.hs ===================================== @@ -13,6 +13,8 @@ -- -- Handle operations implemented by file descriptors (FDs) -- +-- @since 4.2.0.0 +-- ----------------------------------------------------------------------------- module GHC.IO.Handle.FD ( @@ -157,6 +159,8 @@ openFile fp im = -- raising an exception. If closing the handle raises an exception, then -- this exception will be raised by 'withFile' rather than any exception -- raised by @act at . +-- +-- @since 4.16.0.0 withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r withFile fp im act = catchException @@ -189,6 +193,8 @@ openFileBlocking fp im = -- by raising an exception. If closing the handle raises an exception, then -- this exception will be raised by 'withFile' rather than any exception raised -- by @act at . +-- +-- @since 4.16.0.0 withFileBlocking :: FilePath -> IOMode -> (Handle -> IO r) -> IO r withFileBlocking fp im act = catchException @@ -217,6 +223,8 @@ openBinaryFile fp m = -- the file will be closed automatically. The action /should/ -- close the file when finished with it so the file does not remain -- open until the garbage collector collects the handle. +-- +-- @since 4.16.0.0 withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r withBinaryFile fp im act = catchException @@ -366,6 +374,8 @@ fdToHandle fdint = do -- | Turn an existing Handle into a file descriptor. This function throws an -- IOError if the Handle does not reference a file descriptor. +-- +-- @since 4.10.0.0 handleToFd :: Handle -> IO FD.FD handleToFd h = case h of FileHandle _ mv -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee93edfded6ef95e911b7d265feebd1c7f542e8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee93edfded6ef95e911b7d265feebd1c7f542e8d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 00:09:00 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 28 Jul 2023 20:09:00 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 19 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c4589c11295_1cc350b9ff013587@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - af04ebee by Simon Peyton Jones at 2023-07-28T22:54:13+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. But the geom mean stay solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - a2ebb7d7 by Simon Peyton Jones at 2023-07-28T23:33:58+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 13b2156a by Simon Peyton Jones at 2023-07-28T23:33:58+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The net result is good: a 2% improvement in compile time. The table below shows changes over 1%. The main changes are: * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * When making join points, don't do so if the join point is so small it will immediately be inlined. See Note [Duplicating alternatives] * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * Many new or rewritten Notes. E.g. Note [Avoiding simplifying repeatedly] I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I added an INLINE pragma to it. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -4.3% GOOD LargeRecord(normal) -23.3% GOOD PmSeriesS(normal) -2.4% T11195(normal) -1.7% T12227(normal) -20.0% GOOD T12545(normal) -5.4% T13253-spj(normal) -50.7% GOOD T13386(normal) -5.1% GOOD T14766(normal) -2.4% GOOD T15164(normal) -1.7% T15304(normal) +1.0% T15630(normal) -7.7% T15630a(normal) NEW T15703(normal) -7.5% GOOD T16577(normal) -5.1% GOOD T17516(normal) -3.6% T18223(normal) -16.8% GOOD T18282(normal) -1.5% T18304(normal) +1.9% T21839c(normal) -3.5% GOOD T3064(normal) -1.5% T5030(normal) -16.2% GOOD T5321Fun(normal) -1.6% T6048(optasm) -2.1% GOOD T8095(normal) -6.1% GOOD T9630(normal) -5.1% GOOD WWRec(normal) -1.6% geo. mean -2.1% minimum -50.7% maximum +1.9% Metric Decrease: CoOpt_Singletons LargeRecord T12227 T13253-spj T13386 T14766 T15703 T16577 T18223 T21839c T5030 T6048 T8095 T9630 - - - - - 0a5a2092 by Simon Peyton Jones at 2023-07-28T23:33:58+01:00 Improve postInlineUnconditionally This commit adds two things to postInlineUnconditionally: 1. Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. 2. Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. - - - - - 18 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Inline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2687f3950d8f3f0d7f9e3d8f17e4ab9adf6ad09e...0a5a2092c07a5e759993a8dd0d5ce82898a811f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2687f3950d8f3f0d7f9e3d8f17e4ab9adf6ad09e...0a5a2092c07a5e759993a8dd0d5ce82898a811f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 08:19:48 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 29 Jul 2023 04:19:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/th-ops-tilde-atsign Message-ID: <64c4cba496428_33df9aba09010277@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/th-ops-tilde-atsign at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/th-ops-tilde-atsign You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 10:30:36 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 29 Jul 2023 06:30:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/arm_cleanup Message-ID: <64c4ea4ce4ade_33df9ab9ff0444ba@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/arm_cleanup at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/arm_cleanup You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 10:31:35 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 29 Jul 2023 06:31:35 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_cleanup] 64 commits: Reg.Liveness: Strictness Message-ID: <64c4ea877ef63_33df9aba0544464f@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_cleanup at Glasgow Haskell Compiler / GHC Commits: 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - eacd9246 by Andreas Klebinger at 2023-07-29T12:22:06+02:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - 30 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/Word64Map.hs - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Lazy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ad069868c6139e5492c2e6bede3bb875051f0fb...eacd92461f31f81ebb1bc76e989fede7f2d25fcf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ad069868c6139e5492c2e6bede3bb875051f0fb...eacd92461f31f81ebb1bc76e989fede7f2d25fcf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 10:51:16 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 29 Jul 2023 06:51:16 -0400 Subject: [Git][ghc/ghc][wip/andreask/arm_cleanup] AArch NCG: Pure refactor Message-ID: <64c4ef24e1c6d_33df9ab9ff0470e5@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/arm_cleanup at Glasgow Haskell Compiler / GHC Commits: 16765cad by Andreas Klebinger at 2023-07-29T12:41:47+02:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -794,33 +794,25 @@ getRegister' config plat expr -- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' - -- 1. Compute Reg +/- n directly. - -- For Add/Sub we can directly encode 12bits, or 12bits lsl #12. - CmmMachOp (MO_Add w) [(CmmReg reg), CmmLit (CmmInt n _)] - | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ADD (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) - -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12. - where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) - r' = getRegisterReg plat reg - CmmMachOp (MO_Sub w) [(CmmReg reg), CmmLit (CmmInt n _)] - | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (SUB (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) - -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12. - where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) - r' = getRegisterReg plat reg + -- Immediates are handled via `getArithImm` in the generic code path. CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` + (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` + (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) -- 2. Shifts. x << n, x >> n. - CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do + CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] + | w == W32 || w == W64 + , 0 <= n, n < fromIntegral (widthInBits w) -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) @@ -830,7 +822,8 @@ getRegister' config plat expr CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -838,24 +831,23 @@ getRegister' config plat expr CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do + CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] + | w == W32 || w == W64 + , 0 <= n, n < fromIntegral (widthInBits w) -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) CmmMachOp (MO_U_Shr w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -863,13 +855,12 @@ getRegister' config plat expr CmmMachOp (MO_U_Shr w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) + `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do + CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] + | w == W32 || w == W64 + , 0 <= n, n < fromIntegral (widthInBits w) -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) @@ -915,8 +906,8 @@ getRegister' config plat expr -- sign-extend both arguments to 32-bits. -- See Note [Signed arithmetic on AArch64]. intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) - intOpImm {- is signed -} True w op _encode_imm = intOp True w op - intOpImm False w op encode_imm = do + intOpImm {- is signed -} True w op _encode_imm = intOp True w op + intOpImm False w op encode_imm = do -- compute x <- x -- compute x <- y -- x, x, x View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16765cad3b3e5c64bbabf54486da6fb65aec5c69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/16765cad3b3e5c64bbabf54486da6fb65aec5c69 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 11:24:24 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 29 Jul 2023 07:24:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/forall-keyword Message-ID: <64c4f6e8c070d_33df9aba004499b2@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/forall-keyword at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/forall-keyword You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 12:38:16 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 29 Jul 2023 08:38:16 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 82 commits: nativeGen: Explicitly set flags of text sections on Windows Message-ID: <64c5083837be7_33df9aba01854946@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - 899dc6c4 by Alan Zimmerman at 2023-07-29T09:55:37+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - b2361593 by Alan Zimmerman at 2023-07-29T10:08:07+01:00 Summary: EPA make getLocA a synonym for getHasLoc Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-16 09:25:10 +0100 EPA make getLocA a synonym for getHasLoc - - - - - ffc8a5ad by Alan Zimmerman at 2023-07-29T10:08:55+01:00 Summary: Remove Location from WarningTxt source - - - - - 54ea5726 by Alan Zimmerman at 2023-07-29T10:08:59+01:00 EPA: Use Introduce [DeclTag] in AnnSortKey Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-23 09:40:15 +0100 Summary: Introduce AnnSortKey [DeclTag] info: patch template saved to `-` - - - - - 97b2bc8d by Alan Zimmerman at 2023-07-29T10:08:59+01:00 EPA: Introduce HasAnnotation class - - - - - 66a4a3c3 by Alan Zimmerman at 2023-07-29T10:08:59+01:00 EPA HasAnnotation 2 - - - - - 59be0638 by Alan Zimmerman at 2023-07-29T10:08:59+01:00 EPA: put noAnnSrcSpan in HasAnnotation - - - - - 982a1993 by Alan Zimmerman at 2023-07-29T10:08:59+01:00 EPA: Fix span for GRHS - - - - - d94cd4f4 by Alan Zimmerman at 2023-07-29T10:09:00+01:00 EPA: Capture full range for a CaseAlt Match - - - - - 7b454ccd by Alan Zimmerman at 2023-07-29T10:09:00+01:00 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 Summary: Patch: summary-epa-use-full-range-for Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:35:37 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-07-19 20:34:57 +0100 EPA Use full range for Anchor, and do not widen for [TrailingAnn] info: patch template saved to `-` - - - - - 91b9477d by Alan Zimmerman at 2023-07-29T10:09:00+01:00 EPA: Move TrailingAnns from last match to FunBind - - - - - aa08f362 by Alan Zimmerman at 2023-07-29T10:09:00+01:00 EPA: Fix simple tests - - - - - f582cf24 by Alan Zimmerman at 2023-07-29T10:09:00+01:00 Summary: Patch: use-anchor-end-as-prior-end Author: Alan Zimmerman <alan.zimm at gmail.com> Date: 2023-06-25 12:41:37 +0100 EPA: Use the current Anchor end as prior end Use the original anchor location end as the source of truth for calculating print deltas. This allows original spacing to apply in most cases, only changed AST items need initial delta positions. - - - - - a4ea2f64 by Alan Zimmerman at 2023-07-29T10:09:01+01:00 EPA: Add DArrow to TrailingAnn - - - - - 661938f6 by Alan Zimmerman at 2023-07-29T10:15:39+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 982d0700 by Alan Zimmerman at 2023-07-29T10:15:42+01:00 Summary: HasTrailing instances - - - - - 85c848a7 by Alan Zimmerman at 2023-07-29T10:15:42+01:00 EPA use [TrailingAnn] in enterAnn And remove it from ExactPrint (LocatedN RdrName) - - - - - d410f2ab by Alan Zimmerman at 2023-07-29T10:15:42+01:00 EPA: In HsDo, put TrailingAnns at top of LastStmt - - - - - a994e2ad by Alan Zimmerman at 2023-07-29T10:15:42+01:00 EPA: do not convert comments to deltas when balancing. It seems its not needed with the new approach - - - - - 424a2049 by Alan Zimmerman at 2023-07-29T10:15:42+01:00 EPA: deal with fallout from getMonoBind - - - - - 0de30a25 by Alan Zimmerman at 2023-07-29T10:15:42+01:00 EPA fix captureLineSpacing - - - - - bf63f851 by Alan Zimmerman at 2023-07-29T10:15:43+01:00 EPA print any comments in the span before exiting it - - - - - 0fc10aa0 by Alan Zimmerman at 2023-07-29T10:15:43+01:00 EPA: getting rid of tweakDelta WIP at present - - - - - b9dd6978 by Alan Zimmerman at 2023-07-29T10:15:43+01:00 EPA: tweaks to ExactPrint - - - - - 2bc1996d by Alan Zimmerman at 2023-07-29T10:15:43+01:00 EPA: Add comments to AnchorOperation - - - - - ed3326d1 by Alan Zimmerman at 2023-07-29T10:15:43+01:00 EPA: remove AnnEofComment It is no longer used - - - - - 59caef91 by Alan Zimmerman at 2023-07-29T10:15:43+01:00 EPA: make locA a function, not a field name - - - - - 6b66ada5 by Alan Zimmerman at 2023-07-29T10:15:44+01:00 EPA: generalise reLoc - - - - - 1ec0c100 by Alan Zimmerman at 2023-07-29T12:45:34+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - 66628739 by Alan Zimmerman at 2023-07-29T12:45:48+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 80b28c58 by Alan Zimmerman at 2023-07-29T12:45:48+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 3cdb789b by Alan Zimmerman at 2023-07-29T12:45:48+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - e7990c56 by Alan Zimmerman at 2023-07-29T12:45:48+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - 48efc1e1 by Alan Zimmerman at 2023-07-29T13:15:24+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/Word64Map.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/Data/Word64Set.hs - compiler/GHC/Data/Word64Set/Internal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/663d596cd3c214cb63af96b11bdc31e1d3856492...48efc1e15860537371042b5d0a4994303f2f08da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/663d596cd3c214cb63af96b11bdc31e1d3856492...48efc1e15860537371042b5d0a4994303f2f08da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 13:49:35 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Sat, 29 Jul 2023 09:49:35 -0400 Subject: [Git][ghc/ghc][wip/or-pats] 122 commits: Drop circle-ci-job.sh Message-ID: <64c518ef4139d_33df9aba02c867c5@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - 69c90848 by David Knothe at 2023-07-29T15:49:16+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. stuff Implement empty one of Prohibit TyApps Remove unused update submodule haddock Update tests Parser.y - - - - - 15 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87553e331df7bc889ad0890f28e623dac443e14e...69c90848db1fa58c00b5be2c7d0582793302f013 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87553e331df7bc889ad0890f28e623dac443e14e...69c90848db1fa58c00b5be2c7d0582793302f013 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 15:34:44 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 29 Jul 2023 11:34:44 -0400 Subject: [Git][ghc/ghc][wip/T22404] 5 commits: Include -haddock in DynFlags fingerprint Message-ID: <64c53193ef9fa_33df9aba0401005bb@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - 15c014d5 by Simon Peyton Jones at 2023-07-29T16:34:35+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. But the geom mean stay solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af04ebee389800f4350d22b7bb0e919604baf2eb...15c014d558298299df756061b8df5eae10db4e91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af04ebee389800f4350d22b7bb0e919604baf2eb...15c014d558298299df756061b8df5eae10db4e91 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 16:32:56 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 29 Jul 2023 12:32:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/andreask/reg-offset Message-ID: <64c53f38c955c_33df9ab9fdc1074e0@gitlab.mail> Andreas Klebinger pushed new branch wip/andreask/reg-offset at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/andreask/reg-offset You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 16:33:55 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 29 Jul 2023 12:33:55 -0400 Subject: [Git][ghc/ghc][wip/andreask/reg-offset] Aarch ncg: Optimized immediate use for address calculations Message-ID: <64c53f73b3b84_33df9aba0901096cc@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/reg-offset at Glasgow Haskell Compiler / GHC Commits: de0c15bb by Andreas Klebinger at 2023-07-29T18:33:22+02:00 Aarch ncg: Optimized immediate use for address calculations - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -61,6 +61,7 @@ import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Constants (debugIsOn) +import GHC.Hs.Dump (showAstDataFull) -- Note [General layout of an NCG] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -580,6 +581,10 @@ getRegister' config plat (CmmMachOp (MO_Sub w0) [x, CmmLit (CmmInt i w1)]) | i < -- Generic case. getRegister' config plat expr = case expr of + -- TODO: Delete + -- _ + -- | pprTrace "getRegister' (monadic CmmMachOp):" (pdoc plat expr $$ (text $ show expr)) False + -- -> undefined CmmReg (CmmGlobal (GlobalRegUse PicBaseReg _)) -> pprPanic "getRegisterReg-memory" (ppr $ PicBaseReg) CmmLit lit @@ -711,18 +716,11 @@ getRegister' config plat expr -> return (Fixed (cmmTypeFormat (cmmRegType reg)) (getRegisterReg plat reg) nilOL) - CmmRegOff reg off | isNbitEncodeable 12 (fromIntegral off) -> do - getRegister' config plat $ - CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType reg) - - CmmRegOff reg off -> do - (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width) - (reg, _format, code) <- getSomeReg $ CmmReg reg - return $ Any (intFormat width) (\dst -> off_code `appOL` code `snocOL` ADD (OpReg width dst) (OpReg width reg) (OpReg width off_r)) - where width = typeWidth (cmmRegType reg) - - + CmmRegOff reg off -> + -- If we got here we will load the address into a register either way. So we might as well just expand + -- and re-use the existing code path to handle "reg + off". + let !width = cmmRegWidth reg + in getRegister' config plat (CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]) -- for MachOps, see GHC.Cmm.MachOp -- For CmmMachOp, see GHC.Cmm.Expr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de0c15bbd033252eb9a5682bc8669f573863e573 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de0c15bbd033252eb9a5682bc8669f573863e573 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 19:56:58 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 29 Jul 2023 15:56:58 -0400 Subject: [Git][ghc/ghc][wip/az/epa-importdecl-span] EPA: Provide correct annotation span for ImportDecl Message-ID: <64c56f0ae2522_33df9aba054121030@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-importdecl-span at Glasgow Haskell Compiler / GHC Commits: 70790dd4 by Alan Zimmerman at 2023-07-29T20:55:38+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. Metric Decrease: T9961 Metric Increase: T13035 - - - - - 6 changed files: - compiler/GHC/Parser.y - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1134,8 +1134,9 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ - ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False + ; let loc = (comb5 $1 $6 $7 (snd $8) $9); + ; fmap reLocA $ acs (\cs -> L loc $ + ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 , ideclQualified = snd $ importDeclQualifiedStyle mPreQual mPostQual ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -31,7 +31,7 @@ (XImportDeclPass (EpAnn (Anchor - { mod185.hs:3:1-6 } + { mod185.hs:3:1-24 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { mod185.hs:3:1-6 }) ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -35,7 +35,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpParsedAst.hs:5:1-6 } + { DumpParsedAst.hs:5:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpParsedAst.hs:5:1-6 }) ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -1466,7 +1466,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpRenamedAst.hs:5:1-6 } + { DumpRenamedAst.hs:5:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpRenamedAst.hs:5:1-6 }) @@ -1494,7 +1494,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpRenamedAst.hs:7:1-6 } + { DumpRenamedAst.hs:7:1-23 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpRenamedAst.hs:7:1-6 }) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -58,7 +58,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpSemis.hs:5:1-6 } + { DumpSemis.hs:5:1-19 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpSemis.hs:5:1-6 }) @@ -116,7 +116,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpSemis.hs:7:1-6 } + { DumpSemis.hs:7:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpSemis.hs:7:1-6 }) ===================================== testsuite/tests/parser/should_compile/KindSigs.stderr ===================================== @@ -35,7 +35,7 @@ (XImportDeclPass (EpAnn (Anchor - { KindSigs.hs:8:1-6 } + { KindSigs.hs:8:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { KindSigs.hs:8:1-6 }) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70790dd40f307ecaec2c063c655e720978b6f907 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70790dd40f307ecaec2c063c655e720978b6f907 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 22:14:30 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sat, 29 Jul 2023 18:14:30 -0400 Subject: [Git][ghc/ghc][wip/az/epa-importdecl-span] EPA: Provide correct annotation span for ImportDecl Message-ID: <64c58f46bfd6f_33df9aba01812731f@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-importdecl-span at Glasgow Haskell Compiler / GHC Commits: e4077fc7 by Alan Zimmerman at 2023-07-29T23:14:09+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. Metric Decrease: T9961 T5205 Metric Increase: T13035 - - - - - 6 changed files: - compiler/GHC/Parser.y - testsuite/tests/module/mod185.stderr - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/DumpSemis.stderr - testsuite/tests/parser/should_compile/KindSigs.stderr Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -1134,8 +1134,9 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnPackage = fst $5 , importDeclAnnAs = fst $8 } - ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $ - ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False + ; let loc = (comb5 $1 $6 $7 (snd $8) $9); + ; fmap reLocA $ acs (\cs -> L loc $ + ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 , ideclQualified = snd $ importDeclQualifiedStyle mPreQual mPostQual ===================================== testsuite/tests/module/mod185.stderr ===================================== @@ -31,7 +31,7 @@ (XImportDeclPass (EpAnn (Anchor - { mod185.hs:3:1-6 } + { mod185.hs:3:1-24 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { mod185.hs:3:1-6 }) ===================================== testsuite/tests/parser/should_compile/DumpParsedAst.stderr ===================================== @@ -35,7 +35,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpParsedAst.hs:5:1-6 } + { DumpParsedAst.hs:5:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpParsedAst.hs:5:1-6 }) ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -1466,7 +1466,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpRenamedAst.hs:5:1-6 } + { DumpRenamedAst.hs:5:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpRenamedAst.hs:5:1-6 }) @@ -1494,7 +1494,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpRenamedAst.hs:7:1-6 } + { DumpRenamedAst.hs:7:1-23 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpRenamedAst.hs:7:1-6 }) ===================================== testsuite/tests/parser/should_compile/DumpSemis.stderr ===================================== @@ -58,7 +58,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpSemis.hs:5:1-6 } + { DumpSemis.hs:5:1-19 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpSemis.hs:5:1-6 }) @@ -116,7 +116,7 @@ (XImportDeclPass (EpAnn (Anchor - { DumpSemis.hs:7:1-6 } + { DumpSemis.hs:7:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { DumpSemis.hs:7:1-6 }) ===================================== testsuite/tests/parser/should_compile/KindSigs.stderr ===================================== @@ -35,7 +35,7 @@ (XImportDeclPass (EpAnn (Anchor - { KindSigs.hs:8:1-6 } + { KindSigs.hs:8:1-16 } (UnchangedAnchor)) (EpAnnImportDecl (EpaSpan { KindSigs.hs:8:1-6 }) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4077fc72d4c5a1f1de1e6de5dc16e5a881b6eef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4077fc72d4c5a1f1de1e6de5dc16e5a881b6eef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Jul 29 23:06:25 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Sat, 29 Jul 2023 19:06:25 -0400 Subject: [Git][ghc/ghc][wip/andreask/reg-offset] Aarch ncg: Optimize immediate use for address calculations Message-ID: <64c59b711ec2b_33df9aba02c129874@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/reg-offset at Glasgow Haskell Compiler / GHC Commits: e16cd38b by Andreas Klebinger at 2023-07-30T01:00:27+02:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -711,18 +711,11 @@ getRegister' config plat expr -> return (Fixed (cmmTypeFormat (cmmRegType reg)) (getRegisterReg plat reg) nilOL) - CmmRegOff reg off | isNbitEncodeable 12 (fromIntegral off) -> do - getRegister' config plat $ - CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType reg) - - CmmRegOff reg off -> do - (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width) - (reg, _format, code) <- getSomeReg $ CmmReg reg - return $ Any (intFormat width) (\dst -> off_code `appOL` code `snocOL` ADD (OpReg width dst) (OpReg width reg) (OpReg width off_r)) - where width = typeWidth (cmmRegType reg) - - + CmmRegOff reg off -> + -- If we got here we will load the address into a register either way. So we might as well just expand + -- and re-use the existing code path to handle "reg + off". + let !width = cmmRegWidth reg + in getRegister' config plat (CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]) -- for MachOps, see GHC.Cmm.MachOp -- For CmmMachOp, see GHC.Cmm.Expr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e16cd38b3e10f1dbd93ed093827031dc5540d539 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e16cd38b3e10f1dbd93ed093827031dc5540d539 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 09:32:25 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?SmFrb2IgQnLDvG5rZXIgKEBKYWtvYkJydWVua2VyKQ==?=) Date: Sun, 30 Jul 2023 05:32:25 -0400 Subject: [Git][ghc/ghc][wip/jbruenker/foreach] 4 commits: wip Message-ID: <64c62e29ced72_33df9aba0401479b4@gitlab.mail> Jakob Brünker pushed to branch wip/jbruenker/foreach at Glasgow Haskell Compiler / GHC Commits: b9d5eec0 by Jakob Bruenker at 2023-07-27T06:54:32+02:00 wip - - - - - b502977a by Jakob Bruenker at 2023-07-27T06:55:07+02:00 wip haddock update - - - - - f837d1b8 by Jakob Bruenker at 2023-07-27T06:55:51+02:00 wip update cabal - - - - - 084720b0 by Jakob Bruenker at 2023-07-30T11:31:45+02:00 wip went through HsForAllty - - - - - 30 changed files: - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22c35e984a96167f9fb0b43e1a946133f4f31348...084720b01194d409bf5ed459b7206eb146349580 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22c35e984a96167f9fb0b43e1a946133f4f31348...084720b01194d409bf5ed459b7206eb146349580 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 09:35:37 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?SmFrb2IgQnLDvG5rZXIgKEBKYWtvYkJydWVua2VyKQ==?=) Date: Sun, 30 Jul 2023 05:35:37 -0400 Subject: [Git][ghc/ghc][wip/jbruenker/foreach] wip update haddock Message-ID: <64c62ee9b265d_33df9aba02c14812c@gitlab.mail> Jakob Brünker pushed to branch wip/jbruenker/foreach at Glasgow Haskell Compiler / GHC Commits: 6ca50e81 by Jakob Bruenker at 2023-07-30T11:35:26+02:00 wip update haddock - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 0dd20885f87788a946d619fb5e6e287d190ae6ef +Subproject commit b0730146f79884d2d06821d3651504aa52c9cc58 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ca50e8136296503e2e6d31e6e82d0b7a05c24c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ca50e8136296503e2e6d31e6e82d0b7a05c24c7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 13:14:34 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 30 Jul 2023 09:14:34 -0400 Subject: [Git][ghc/ghc][wip/T22404] Make the occurrence analyser smarter about join points Message-ID: <64c6623aa08e3_33df9aba0401644e@gitlab.mail> Simon Peyton Jones pushed to branch wip/T22404 at Glasgow Haskell Compiler / GHC Commits: d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 30 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - + testsuite/tests/simplCore/should_compile/T22404.hs - + testsuite/tests/simplCore/should_compile/T22404.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d03698023891b9d474915ad1cccdef8c8ba78e78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d03698023891b9d474915ad1cccdef8c8ba78e78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 15:52:37 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 30 Jul 2023 11:52:37 -0400 Subject: [Git][ghc/ghc][wip/int-index/forall-keyword] testsuite: Fix PprUnicodeSyntax Message-ID: <64c687452c54d_33df9aba0a41795b2@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/forall-keyword at Glasgow Haskell Compiler / GHC Commits: a897b71c by Vladislav Zavialov at 2023-07-30T18:51:47+03:00 testsuite: Fix PprUnicodeSyntax - - - - - 1 changed file: - testsuite/tests/printer/PprUnicodeSyntax.hs Changes: ===================================== testsuite/tests/printer/PprUnicodeSyntax.hs ===================================== @@ -1,3 +1,4 @@ {-# LANGUAGE UnicodeSyntax #-} -foo x = addToEnv (∀) +foo :: ∀ a. a -> a +foo = id View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a897b71c31660de375ec07a4631217e946599206 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a897b71c31660de375ec07a4631217e946599206 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 18:32:42 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 30 Jul 2023 14:32:42 -0400 Subject: [Git][ghc/ghc][wip/int-index/forall-keyword] 13 commits: ci: Test bootstrapping configurations with full-ci and on marge batches Message-ID: <64c6acca21ada_33df9aba0902034c3@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/forall-keyword at Glasgow Haskell Compiler / GHC Commits: 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - 616f1f73 by Vladislav Zavialov at 2023-07-30T21:31:51+03:00 Make forall a keyword (#23719) Before this change, GHC used to accept `forall` as a term-level identifier: -- from constraints-0.13 forall :: forall p. (forall a. Dict (p a)) -> Dict (Forall p) forall d = ... Now it is a parse error. The -Wforall-identifier warning has served its purpose and is now a deprecated no-op. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Utils/Lexeme.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/bugs.rst - docs/users_guide/using-warnings.rst - hadrian/bootstrap/bootstrap.py The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a897b71c31660de375ec07a4631217e946599206...616f1f7399f2a19afdd654c0b106eeeeceb51010 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a897b71c31660de375ec07a4631217e946599206...616f1f7399f2a19afdd654c0b106eeeeceb51010 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 18:41:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 30 Jul 2023 14:41:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Include -haddock in DynFlags fingerprint Message-ID: <64c6aeceed3c0_33df9aba02c2037f8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 59c6d666 by Julian Ospald at 2023-07-30T14:41:15-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7eceeb0cd202af25d296759d5605b00c08f1c658...59c6d66624f1cafd8d6d80de6c7bfc8bf15ab46c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7eceeb0cd202af25d296759d5605b00c08f1c658...59c6d66624f1cafd8d6d80de6c7bfc8bf15ab46c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 18:46:34 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?SmFrb2IgQnLDvG5rZXIgKEBKYWtvYkJydWVua2VyKQ==?=) Date: Sun, 30 Jul 2023 14:46:34 -0400 Subject: [Git][ghc/ghc][wip/jbruenker/foreach] wip remove foreach error Message-ID: <64c6b00a8e681_33df9aba0a4209634@gitlab.mail> Jakob Brünker pushed to branch wip/jbruenker/foreach at Glasgow Haskell Compiler / GHC Commits: da668bb3 by Jakob Bruenker at 2023-07-30T20:46:19+02:00 wip remove foreach error - - - - - 3 changed files: - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs Changes: ===================================== compiler/GHC/Parser/Errors/Ppr.hs ===================================== @@ -211,8 +211,6 @@ instance Diagnostic PsMessage where -> mkSimpleDecorated $ text "Fields cannot be qualified when OverloadedRecordUpdate is enabled" PsErrExplicitForall is_unicode -> mkSimpleDecorated $ text "Illegal symbol" <+> quotes (forallSym is_unicode) <+> text "in type" - PsErrForeach is_unicode - -> mkSimpleDecorated $ text "Illegal symbol" <+> quotes (foreachSym is_unicode) <+> text "in type" PsErrIllegalQualifiedDo qdoDoc -> mkSimpleDecorated $ text "Illegal qualified" <+> quotes qdoDoc <+> text "block" @@ -553,7 +551,6 @@ instance Diagnostic PsMessage where PsErrIllegalPatSynExport -> ErrorWithoutFlag PsErrOverloadedRecordUpdateNoQualifiedFields -> ErrorWithoutFlag PsErrExplicitForall{} -> ErrorWithoutFlag - PsErrForeach{} -> ErrorWithoutFlag PsErrIllegalQualifiedDo{} -> ErrorWithoutFlag PsErrQualifiedDoInCmd{} -> ErrorWithoutFlag PsErrRecordSyntaxInPatSynDecl{} -> ErrorWithoutFlag @@ -691,7 +688,6 @@ instance Diagnostic PsMessage where let info = text "or a similar language extension to enable explicit-forall syntax:" <+> forallSym is_unicode <+> text ". " in [ suggestExtensionWithInfo info LangExt.RankNTypes ] - PsErrForeach is_unicode -> [suggestExtension LangExt.Foreach] PsErrIllegalQualifiedDo{} -> [suggestExtension LangExt.QualifiedDo] PsErrQualifiedDoInCmd{} -> noHints PsErrRecordSyntaxInPatSynDecl{} -> noHints ===================================== compiler/GHC/Parser/Errors/Types.hs ===================================== @@ -433,10 +433,6 @@ data PsMessage | PsErrExplicitForall !Bool -- ^ is Unicode forall? - -- | foreach found but no extension allowing it is enabled - | PsErrForeach !Bool - -- ^ is Unicode foreach? - -- | Found qualified-do without QualifiedDo enabled | PsErrIllegalQualifiedDo !SDoc ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -189,8 +189,6 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "PsErrIllegalPatSynExport" = 89515 GhcDiagnosticCode "PsErrOverloadedRecordUpdateNoQualifiedFields" = 94863 GhcDiagnosticCode "PsErrExplicitForall" = 25955 - -- XXX JB do we need this? probably depends on whether foreach is a keyword without extension - GhcDiagnosticCode "PsErrForeach" = 13790 GhcDiagnosticCode "PsErrIllegalQualifiedDo" = 40280 GhcDiagnosticCode "PsErrQualifiedDoInCmd" = 54089 GhcDiagnosticCode "PsErrRecordSyntaxInPatSynDecl" = 28021 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da668bb339b05165ed0a8596d1856dd8cecc506f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da668bb339b05165ed0a8596d1856dd8cecc506f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 21:21:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 30 Jul 2023 17:21:43 -0400 Subject: [Git][ghc/ghc][master] Make the occurrence analyser smarter about join points Message-ID: <64c6d4674e9c_33df9aba0182400d8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 30 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Outputable.hs - + testsuite/tests/simplCore/should_compile/T22404.hs - + testsuite/tests/simplCore/should_compile/T22404.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d03698023891b9d474915ad1cccdef8c8ba78e78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d03698023891b9d474915ad1cccdef8c8ba78e78 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 21:22:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 30 Jul 2023 17:22:30 -0400 Subject: [Git][ghc/ghc][master] Improve documentation around IOException and ioe_filename Message-ID: <64c6d496d0bd1_33df9aba0902444bb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - 1 changed file: - libraries/base/GHC/IO/Exception.hs Changes: ===================================== libraries/base/GHC/IO/Exception.hs ===================================== @@ -329,13 +329,16 @@ type IOError = IOException -- flagged. data IOException = IOError { - ioe_handle :: Maybe Handle, -- the handle used by the action flagging - -- the error. - ioe_type :: IOErrorType, -- what it was. - ioe_location :: String, -- location. - ioe_description :: String, -- error type specific information. - ioe_errno :: Maybe CInt, -- errno leading to this error, if any. - ioe_filename :: Maybe FilePath -- filename the error is related to. + ioe_handle :: Maybe Handle, -- ^ the handle used by the action flagging + -- the error. + ioe_type :: IOErrorType, -- ^ what it was. + ioe_location :: String, -- ^ location. + ioe_description :: String, -- ^ error type specific information. + ioe_errno :: Maybe CInt, -- ^ errno leading to this error, if any. + ioe_filename :: Maybe FilePath -- ^ filename the error is related to + -- (some libraries may assume different encodings + -- when constructing this field from e.g. 'ByteString' + -- or other types) } -- | @since 4.1.0.0 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42aa7fbd6cc51f7cd993621336e1c3fa8202ab1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42aa7fbd6cc51f7cd993621336e1c3fa8202ab1f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 21:27:56 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?SmFrb2IgQnLDvG5rZXIgKEBKYWtvYkJydWVua2VyKQ==?=) Date: Sun, 30 Jul 2023 17:27:56 -0400 Subject: [Git][ghc/ghc][wip/jbruenker/foreach] wip type desugaring Message-ID: <64c6d5dc70b18_33df9aba040253081@gitlab.mail> Jakob Brünker pushed to branch wip/jbruenker/foreach at Glasgow Haskell Compiler / GHC Commits: 1e8dd284 by Jakob Bruenker at 2023-07-30T23:27:43+02:00 wip type desugaring - - - - - 5 changed files: - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -49,7 +49,7 @@ module GHC.Core.TyCo.Rep ( mkVisFunTy, mkScaledFunTys, mkInvisFunTy, mkInvisFunTys, tcMkVisFunTy, tcMkInvisFunTy, tcMkScaledFunTys, - mkForAllTy, mkForAllTys, mkInvisForAllTys, + mkForAllTy, mkForAllTys, mkInvisForAllTys, mkForEachTys, mkPiTy, mkPiTys, mkVisFunTyMany, mkVisFunTysMany, nonDetCmpTyLit, cmpTyLit, @@ -805,6 +805,11 @@ mkForAllTy bndr body mkForAllTys :: [ForAllTyBinder] -> Type -> Type mkForAllTys tyvars ty = foldr ForAllTy ty tyvars +-- | Wraps foralls and function binders over the type using the provided 'TyCoVar's from left to right +mkForEachTys :: [ForAllTyBinder] -> Type -> Type +mkForEachTys tyvars ty = + foldr (\v t -> mkForAllTy v (mkFunTy FTF_T_T manyDataConTy (binderType v) t)) ty tyvars + -- | Wraps foralls over the type using the provided 'InvisTVBinder's from left to right mkInvisForAllTys :: [InvisTVBinder] -> Type -> Type mkInvisForAllTys tyvars = mkForAllTys (tyVarSpecToBinders tyvars) ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -133,6 +133,7 @@ dsLHsBind :: LHsBind GhcTc dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind +-- XXX JB Desugar somewhere in here. However we need to add some info during typechecking to the pattern match, maybe, idk, so we can desugar properly -- | Desugar a single binding (or group of recursive binds). dsHsBind :: DynFlags -> HsBind GhcTc ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -876,6 +876,7 @@ tc_inst_forall_arg conc_tvs (tvb, inner_ty) hs_ty {- Note [Visible type application and abstraction] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- XXX JB Note update GHC supports the types forall {a}. a -> t -- ForAllTyFlag is Inferred forall a. a -> t -- ForAllTyFlag is Specified @@ -945,20 +946,19 @@ Syntax of types forall {a}. t -- HsForAllInvis (c.o. HsForAllTelescope) and InferredSpec (c.o. Specificity) forall a. t -- HsForAllInvis (c.o. HsForAllTelescope) and SpecifiedSpec (c.o. Specificity) forall a -> t -- HsForAllVis (c.o. HsForAllTelescope) - foreach {a}. t -- HsForEachInvis (c.o. HsForAllTelescope) and InferredSpec (c.o. Specificity) - foreach a. t -- HsForEachInvis (c.o. HsForAllTelescope) and SpecifiedSpec (c.o. Specificity) - foreach a -> t -- HsForEachVis (c.o. HsForAllTelescope) + foreach {a}. t -- HsForEachInvis (c.o. HsForAllTelescope) and InferredSpec (c.o. Specificity) + foreach a. t -- HsForEachInvis (c.o. HsForAllTelescope) and SpecifiedSpec (c.o. Specificity) + foreach a -> t -- HsForEachVis (c.o. HsForAllTelescope) * By the time we get to checking applications/abstractions (e.g. GHC.Tc.Gen.App) the types have been kind-checked (e.g. by tcLHsType) into ForAllTy (c.o. Type). - At this stage, we have: + At this stage, we have (using t.o. to mean "type of"): forall {a}. t -- ForAllTy (c.o. Type) and Inferred (c.o. ForAllTyFlag) forall a. t -- ForAllTy (c.o. Type) and Specified (c.o. ForAllTyFlag) forall a -> t -- ForAllTy (c.o. Type) and Required (c.o. ForAllTyFlag) - -- XXX JB fix this. Should be ForAllTy -> FunTy I guess? - foreach {a}. t -- ForAllTy (c.o. Type) and Inferred (c.o. ForAllTyFlag) - foreach a. t -- ForAllTy (c.o. Type) and Specified (c.o. ForAllTyFlag) - foreach a -> t -- ForAllTy (c.o. Type) and Required (c.o. ForAllTyFlag) + foreach {a}. t.o. a -> t -- ForAllTy (c.o. Type) and Inferred (c.o. ForAllTyFlag) + foreach a. t.o. a -> t -- ForAllTy (c.o. Type) and Specified (c.o. ForAllTyFlag) + foreach a -> t.o. a -> t -- ForAllTy (c.o. Type) and Required (c.o. ForAllTyFlag) Syntax of applications in HsExpr -------------------------------- @@ -1090,6 +1090,7 @@ Proposal #281. Typechecking type abstractions ------------------------------ +-- XXX JB patterns read here! Type abstractions are checked alongside ordinary patterns in GHC.Tc.Gen.Pat.tcPats. One of its inputs is a list of ExpPatType that has two constructors * ExpFunPatTy ... -- the type A of a function A -> B ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1179,9 +1179,8 @@ tc_hs_type mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind = tc_fun_type mode (HsUnrestrictedArrow noHsUniTok) ty1 ty2 exp_kind --------- Foralls --- XXX JB HsForAllTy I think this is where we change things into Core tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind - = do { (tv_bndrs, ty') <- tcTKTelescope mode tele $ + = do { (erasure, tv_bndrs, ty') <- tcTKTelescope mode tele $ tc_lhs_type mode ty exp_kind -- Pass on the mode from the type, to any wildcards -- in kind signatures on the forall'd variables @@ -1190,7 +1189,7 @@ tc_hs_type mode (HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind -- Do not kind-generalise here! See Note [Kind generalisation] - ; return (mkForAllTys tv_bndrs ty') } + ; return ((if erasure == Erased then mkForAllTys else mkForEachTys) tv_bndrs ty') } tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = rn_ty }) exp_kind | null (unLoc ctxt) @@ -1382,7 +1381,7 @@ tc_fun_type mode mult ty1 ty2 exp_kind = case mode_tyki mode of {- Note [Skolem escape and forall-types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See also Note [Checking telescopes]. --- XXX JB Note update +-- XX JB Note update Consider f :: forall a. (forall kb (b :: kb). Proxy '[a, b]) -> () @@ -3014,10 +3013,9 @@ checkForDuplicateScopedTyVars scoped_prs tcTKTelescope :: TcTyMode -> HsForAllTelescope GhcRn -> TcM a - -> TcM ([TcTyVarBinder], a) + -> TcM (Erasure, [TcTyVarBinder], a) -- A HsForAllTelescope comes only from a HsForAllTy, -- an explicit, user-written forall type --- XXX JB HsForAllType typechecking, do we need to change this? tcTKTelescope mode tele thing_inside = case tele of HsForAllVis { hsf_vis_bndrs = bndrs } -> do { skol_info <- mkSkolemInfo (ForAllSkol (HsTyVarBndrsRn (unLoc <$> bndrs))) @@ -3026,7 +3024,7 @@ tcTKTelescope mode tele thing_inside = case tele of ; (req_tv_bndrs, thing) <- tcExplicitTKBndrsX skol_mode bndrs thing_inside -- req_tv_bndrs :: [VarBndr TyVar ()], -- but we want [VarBndr TyVar ForAllTyFlag] - ; return (tyVarReqToBinders req_tv_bndrs, thing) } + ; return (Erased, tyVarReqToBinders req_tv_bndrs, thing) } HsForAllInvis { hsf_invis_bndrs = bndrs } -> do { skol_info <- mkSkolemInfo (ForAllSkol (HsTyVarBndrsRn (unLoc <$> bndrs))) @@ -3035,7 +3033,7 @@ tcTKTelescope mode tele thing_inside = case tele of ; (inv_tv_bndrs, thing) <- tcExplicitTKBndrsX skol_mode bndrs thing_inside -- inv_tv_bndrs :: [VarBndr TyVar Specificity], -- but we want [VarBndr TyVar ForAllTyFlag] - ; return (tyVarSpecToBinders inv_tv_bndrs, thing) } + ; return (Erased, tyVarSpecToBinders inv_tv_bndrs, thing) } HsForEachVis { hsf_retained_vis_bndrs = bndrs } -> do { skol_info <- mkSkolemInfo (ForAllSkol (HsTyVarBndrsRn (unLoc <$> bndrs))) @@ -3044,7 +3042,7 @@ tcTKTelescope mode tele thing_inside = case tele of ; (req_tv_bndrs, thing) <- tcExplicitTKBndrsX skol_mode bndrs thing_inside -- req_tv_bndrs :: [VarBndr TyVar ()], -- but we want [VarBndr TyVar ForAllTyFlag] - ; return (tyVarReqToBinders req_tv_bndrs, thing) } + ; return (Retained, tyVarReqToBinders req_tv_bndrs, thing) } HsForEachInvis { hsf_retained_invis_bndrs = bndrs } -> do { skol_info <- mkSkolemInfo (ForAllSkol (HsTyVarBndrsRn (unLoc <$> bndrs))) @@ -3053,7 +3051,7 @@ tcTKTelescope mode tele thing_inside = case tele of ; (inv_tv_bndrs, thing) <- tcExplicitTKBndrsX skol_mode bndrs thing_inside -- inv_tv_bndrs :: [VarBndr TyVar Specificity], -- but we want [VarBndr TyVar ForAllTyFlag] - ; return (tyVarSpecToBinders inv_tv_bndrs, thing) } + ; return (Retained, tyVarSpecToBinders inv_tv_bndrs, thing) } -------------------------------------- -- HsOuterTyVarBndrs ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -67,7 +67,7 @@ module GHC.Types.Var ( -- * ForAllTyFlags ForAllTyFlag(Invisible,Required,Specified,Inferred), - Specificity(..), + Specificity(..), Erasure(..), isVisibleForAllTyFlag, isInvisibleForAllTyFlag, isInferredForAllTyFlag, coreTyLamForAllTyFlag, @@ -472,7 +472,6 @@ data Specificity = InferredSpec -- | Whether a dependent argument is erased at runtime data Erasure = Erased | Retained deriving (Eq, Data) - -- XXX JB Erasure flag do we need it? pattern Inferred, Specified :: ForAllTyFlag pattern Inferred = Invisible InferredSpec View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e8dd284dc334cbb77fa9db21caa8a9491460374 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e8dd284dc334cbb77fa9db21caa8a9491460374 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 22:29:14 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sun, 30 Jul 2023 18:29:14 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 10 commits: Include -haddock in DynFlags fingerprint Message-ID: <64c6e43a74860_16d02dba0a487753@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - 6e3b92bf by Simon Peyton Jones at 2023-07-30T22:29:34+01:00 Several improvements to the handling of coercions * Make `mkSymCo` and `mkInstCo` smarter Fixes #23642 * Fix return role of `SelCo` in the coercion optimiser. Fixes #23617 * Make the coercion optimiser `opt_trans_rule` work better for newtypes Fixes #23619 - - - - - 6262e6ad by Simon Peyton Jones at 2023-07-30T22:29:34+01:00 Simplifier improvements This MR started as: allow the simplifer to do more in one pass, arising from places I could see the simplifier taking two iterations where one would do. But it turned into a larger project, because these changes unexpectedly made inlining blow up, especially join points in deeply-nested cases. The net result is good: a 2% improvement in compile time. The table below shows changes over 1%. The main changes are: * The SimplEnv now has a seInlineDepth field, which says how deep in unfoldings we are. See Note [Inline depth] in Simplify.Env * Avoid repeatedly simplifying coercions. see Note [Avoid re-simplifying coercions] in Simplify.Iteration As you'll see from the Note, this makes use of the seInlineDepth. * Allow Simplify.Utils.postInlineUnconditionally to inline variables that are used exactly once. See Note [Post-inline for single-use things]. * Allow Simplify.Iteration.simplAuxBind to inline used-once things. This is another part of Note [Post-inline for single-use things], and is really good for reducing simplifier iterations in situations like case K e of { K x -> blah } wher x is used once in blah. * Make GHC.Core.SimpleOpt.exprIsConApp_maybe do some simple case elimination. Note [Case elim in exprIsConApp_maybe] * When making join points, don't do so if the join point is so small it will immediately be inlined. See Note [Duplicating alternatives] * Do not add an unfolding to a join point at birth. This is a tricky one and has a long Note [Do not add unfoldings to join points at birth] It shows up in two places - In `mkDupableAlt` do not add an inlining - (trickier) In `simplLetUnfolding` don't add an unfolding for a fresh join point I am not fully satisifed with this, but it works and is well documented. * Many new or rewritten Notes. E.g. Note [Avoiding simplifying repeatedly] I discovered that GHC.HsToCore.Pmc.Solver.Types.trvVarInfo was very delicately balanced. It's a small, heavily used, overloaded function and it's important that it inlines. By a fluke it was before, but at various times in my journey it stopped doing so. So I added an INLINE pragma to it. Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -4.3% GOOD LargeRecord(normal) -23.3% GOOD PmSeriesS(normal) -2.4% T11195(normal) -1.7% T12227(normal) -20.0% GOOD T12545(normal) -5.4% T13253-spj(normal) -50.7% GOOD T13386(normal) -5.1% GOOD T14766(normal) -2.4% GOOD T15164(normal) -1.7% T15304(normal) +1.0% T15630(normal) -7.7% T15630a(normal) NEW T15703(normal) -7.5% GOOD T16577(normal) -5.1% GOOD T17516(normal) -3.6% T18223(normal) -16.8% GOOD T18282(normal) -1.5% T18304(normal) +1.9% T21839c(normal) -3.5% GOOD T3064(normal) -1.5% T5030(normal) -16.2% GOOD T5321Fun(normal) -1.6% T6048(optasm) -2.1% GOOD T8095(normal) -6.1% GOOD T9630(normal) -5.1% GOOD WWRec(normal) -1.6% geo. mean -2.1% minimum -50.7% maximum +1.9% Metric Decrease: CoOpt_Singletons LargeRecord T12227 T13253-spj T13386 T14766 T15703 T16577 T18223 T21839c T5030 T6048 T8095 T9630 - - - - - 50518da5 by Simon Peyton Jones at 2023-07-30T22:29:34+01:00 Improve postInlineUnconditionally This commit adds two things to postInlineUnconditionally: 1. Do not postInlineUnconditionally join point, ever. Doing so does not reduce allocation, which is the main point, and with join points that are used a lot it can bloat code. See point (1) of Note [Duplicating join points] in GHC.Core.Opt.Simplify.Iteration. 2. Do not postInlineUnconditionally a strict (demanded) binding. It will not allocate a thunk (it'll turn into a case instead) so again the main point of inlining it doesn't hold. Better to check per-call-site. - - - - - 0caebc5d by Simon Peyton Jones at 2023-07-30T22:29:34+01:00 Update testsuite output - - - - - 15 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a5a2092c07a5e759993a8dd0d5ce82898a811f7...0caebc5d5f197f74ae6849ca2c4f38ef82d44412 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0a5a2092c07a5e759993a8dd0d5ce82898a811f7...0caebc5d5f197f74ae6849ca2c4f38ef82d44412 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Jul 30 22:47:35 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Sun, 30 Jul 2023 18:47:35 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-07-15] 14 commits: EPA: generalise reLoc Message-ID: <64c6e88758af8_16d02dba0048856d@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-07-15 at Glasgow Haskell Compiler / GHC Commits: 2684b368 by Alan Zimmerman at 2023-07-29T15:26:50+01:00 EPA: generalise reLoc - - - - - 75dd0ee3 by Alan Zimmerman at 2023-07-29T19:24:32+01:00 EPA: get rid of l2l and friends - - - - - aa6b2c3f by Alan Zimmerman at 2023-07-29T23:40:02+01:00 EPA: get rid of l2l and friends - - - - - 52f43884 by Alan Zimmerman at 2023-07-30T00:06:31+01:00 EPA: harmonise acsa and acsA - - - - - bc6f96bc by Alan Zimmerman at 2023-07-30T14:49:43+01:00 EPA: Replace Anchor with EpaLocation - - - - - 8aab018c by Alan Zimmerman at 2023-07-30T18:11:13+01:00 EPA: get rid of AnchorOperation - - - - - bc197378 by Alan Zimmerman at 2023-07-30T21:29:53+01:00 EPA: Use SrcSpan in EpaSpan - - - - - 43124fd3 by Alan Zimmerman at 2023-07-30T23:01:01+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - dae593aa by Alan Zimmerman at 2023-07-30T23:01:05+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 7ef73a73 by Alan Zimmerman at 2023-07-30T23:01:05+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - 2e3ea7c7 by Alan Zimmerman at 2023-07-30T23:01:05+01:00 EPA: Move TrailingAnns to the top of FieldOcc - - - - - 00d91bd8 by Alan Zimmerman at 2023-07-30T23:01:05+01:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - f5b71afe by Alan Zimmerman at 2023-07-30T23:01:05+01:00 EPA: Add '=>' to TrailingAnn This is used as a trailing annotation in a context. Add its normal and unicode variants. Note that we keep the parsed representation the same, but make use of it when exact printing. - - - - - b8a6a58f by Alan Zimmerman at 2023-07-30T23:46:04+01:00 EPA: Improve WrapXRec instance - - - - - 30 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48efc1e15860537371042b5d0a4994303f2f08da...b8a6a58fbb4138eec6d34ee0af930500ea7090f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48efc1e15860537371042b5d0a4994303f2f08da...b8a6a58fbb4138eec6d34ee0af930500ea7090f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 00:29:39 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sun, 30 Jul 2023 20:29:39 -0400 Subject: [Git][ghc/ghc][wip/T21077-take-two] 66 commits: Reg.Liveness: Strictness Message-ID: <64c7007322734_16d02dba0549716a@gitlab.mail> Ryan Scott pushed to branch wip/T21077-take-two at Glasgow Haskell Compiler / GHC Commits: 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - dd63317f by Ryan Scott at 2023-07-30T20:28:41-04:00 Look through TH splices in splitHsApps This, modifies `splitHsApps` (a key function used in typechecking function applications) to look through untyped TH splices. Not doing so was the cause of #21077. This builds on !7821 by making `splitHsApps` match on `HsUntypedSpliceTop`, which contains the `ThModFinalizers` that must be run as part of invoking the TH splice. See the new `Note [Looking through Template Haskell splices in splitHsApps]` in `GHC.Tc.Gen.Head`. Fixes #21077. - - - - - 30 changed files: - .gitlab-ci.yml - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6a247718be5bea2a1f5d47ade42c6c57d635dab1...dd63317f2a51326f4f45e9ef20266510e0c0a096 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6a247718be5bea2a1f5d47ade42c6c57d635dab1...dd63317f2a51326f4f45e9ef20266510e0c0a096 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 01:27:14 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?SmFrb2IgQnLDvG5rZXIgKEBKYWtvYkJydWVua2VyKQ==?=) Date: Sun, 30 Jul 2023 21:27:14 -0400 Subject: [Git][ghc/ghc][wip/jbruenker/foreach] wip add Erasure - might have to remove it again from... Message-ID: <64c70df2433b3_16d02dba0a41023a7@gitlab.mail> Jakob Brünker pushed to branch wip/jbruenker/foreach at Glasgow Haskell Compiler / GHC Commits: b2ecd7f5 by Jakob Bruenker at 2023-07-31T03:25:58+02:00 wip add Erasure - might have to remove it again from splitForAllForAllTyBinders because Corelint error, not sure if corelint uses this - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/Tc/Deriv/Functor.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2ecd7f51688fe46bbf3823d4e56200095ca2159 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2ecd7f51688fe46bbf3823d4e56200095ca2159 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 01:37:18 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?SmFrb2IgQnLDvG5rZXIgKEBKYWtvYkJydWVua2VyKQ==?=) Date: Sun, 30 Jul 2023 21:37:18 -0400 Subject: [Git][ghc/ghc][wip/jbruenker/foreach] wip changed the thing but corelint still complains Message-ID: <64c7104e67c79_16d02dba0f41025f9@gitlab.mail> Jakob Brünker pushed to branch wip/jbruenker/foreach at Glasgow Haskell Compiler / GHC Commits: 2f14e085 by Jakob Bruenker at 2023-07-31T03:36:49+02:00 wip changed the thing but corelint still complains - - - - - 3 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1952,10 +1952,8 @@ dropForAlls ty = go ty -- | Attempts to take a ForAllTy apart, returning the full ForAllTyBinder splitForAllForAllTyBinder_maybe :: Type -> Maybe (Erasure, ForAllTyBinder, Type) splitForAllForAllTyBinder_maybe ty - | ForAllTy Erased bndr inner_ty <- coreFullView ty = Just (Erased, bndr, inner_ty) - | ForAllTy Retained bndr (FunTy FTF_T_T _ _ inner_ty) <- coreFullView ty = Just (Retained, bndr, inner_ty) - | ForAllTy Retained _ _ <- coreFullView ty = panic "splitForAllTyVarBinder_maybe: Retained binder without matching FunTy" - | otherwise = Nothing + | ForAllTy eras bndr inner_ty <- coreFullView ty = Just (eras, bndr, inner_ty) + | otherwise = Nothing -- | Attempts to take a ForAllTy apart, returning the Var ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1289,6 +1289,7 @@ pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion, ForAllTyFlag, ForAllTyFlag)] pprIfaceForAllCoPart tvs sdoc = sep [ pprIfaceForAllCo tvs, sdoc ] +-- XXX JB HERE printing this needs to be fixed ppr_iface_forall_part :: ShowForAllFlag -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc ppr_iface_forall_part show_forall tvs ctxt sdoc ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -410,7 +410,8 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside -- to syntactically visible patterns in the source program -- See Note [Visible type application and abstraction] in GHC.Tc.Gen.App go acc_arg_tys n ty - | Just (eras, Bndr tv vis, ty') <- splitForAllForAllTyBinder_maybe ty + -- XXX JB HERE Maybe this should use the tc version of splitForAllTys (and then splitForAllTys can stop removing the function type) + | Just (eras, Bndr tv vis, ty') <- tcSplitForAllTyVarBinder_maybe ty , Required <- vis = let init_subst = mkEmptySubst (mkInScopeSet (tyCoVarsOfType ty)) in goVdq eras init_subst acc_arg_tys n ty tv ty' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f14e085001a9b659b93c2fa7582a67b5d51e57a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f14e085001a9b659b93c2fa7582a67b5d51e57a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 07:56:27 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 31 Jul 2023 03:56:27 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (Proposal 0522) Message-ID: <64c7692be13bc_16d02dba0541338de@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: a2455d95 by David Knothe at 2023-07-31T09:56:17+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. stuff Implement empty one of Prohibit TyApps Remove unused update submodule haddock Update tests Parser.y - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2455d95358cb3f5c2405c31276e157103c09779 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a2455d95358cb3f5c2405c31276e157103c09779 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 09:00:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 31 Jul 2023 05:00:18 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Improve documentation around IOException and ioe_filename Message-ID: <64c778225c1ae_2f1200ba3745461d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - db54e894 by Matthew Craven at 2023-07-31T04:58:53-04:00 Adjust and clarify handling of primop effects The existing "can_fail" and "has_side_effects" primop attributes that previously governed this were used in inconsistent and confusingly- documented ways, especially with regard to raising exceptions. This patch replaces them with a single "effect" attribute, with four possible values (NoEffect, CanFail, ThrowsException, ReadWriteEffect) as described in Note [Classifying primop effects]. A substantial amount of related documentation has been re-drafted for clarity and accuracy. In the process of making this attribute format change for literally every primop, several existing mis-classifications were detected and corrected. New primop attributes "cheap" and "work_free" were also added, and used in the obvious places. In view of their actual meaning and uses, `primOpOkForSideEffects` and `exprOkForSideEffects` have been renamed to `primOpOkToDiscard` and `exprOkToDiscard`, respectively. - - - - - 2810170d by Sylvain Henry at 2023-07-31T04:59:04-04:00 JS: implement getMonotonicTime (fix #23687) - - - - - 27 changed files: - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Demand.hs - compiler/Setup.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Lint.hs - hadrian/src/Settings/Builders/GenPrimopCode.hs - libraries/base/GHC/Clock.hsc - libraries/base/GHC/Conc/POSIX.hs - libraries/base/GHC/IO/Exception.hs - libraries/base/Unsafe/Coerce.hs - + libraries/base/tests/T23687.hs - libraries/base/tests/all.T - + testsuite/tests/ghc-api/PrimOpEffect_Sanity.hs - testsuite/tests/ghc-api/all.T - utils/genprimopcode/AccessOps.hs - utils/genprimopcode/Lexer.x - utils/genprimopcode/Main.hs - utils/genprimopcode/Parser.y - utils/genprimopcode/ParserM.hs - utils/genprimopcode/Syntax.hs Changes: ===================================== compiler/GHC/Builtin/PrimOps.hs ===================================== @@ -17,10 +17,12 @@ module GHC.Builtin.PrimOps ( tagToEnumKey, primOpOutOfLine, primOpCodeSize, - primOpOkForSpeculation, primOpOkForSideEffects, - primOpIsCheap, primOpFixity, primOpDocs, + primOpOkForSpeculation, primOpOkToDiscard, + primOpIsWorkFree, primOpIsCheap, primOpFixity, primOpDocs, primOpIsDiv, primOpIsReallyInline, + PrimOpEffect(..), primOpEffect, + getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..), PrimCall(..) @@ -311,221 +313,316 @@ primOpOutOfLine :: PrimOp -> Bool * * ************************************************************************ -Note [Checking versus non-checking primops] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - In GHC primops break down into two classes: - - a. Checking primops behave, for instance, like division. In this - case the primop may throw an exception (e.g. division-by-zero) - and is consequently is marked with the can_fail flag described below. - The ability to fail comes at the expense of precluding some optimizations. - - b. Non-checking primops behavior, for instance, like addition. While - addition can overflow it does not produce an exception. So can_fail is - set to False, and we get more optimisation opportunities. But we must - never throw an exception, so we cannot rewrite to a call to error. - - It is important that a non-checking primop never be transformed in a way that - would cause it to bottom. Doing so would violate Core's let-can-float invariant - (see Note [Core let-can-float invariant] in GHC.Core) which is critical to - the simplifier's ability to float without fear of changing program meaning. - - -Note [PrimOp can_fail and has_side_effects] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Both can_fail and has_side_effects mean that the primop has -some effect that is not captured entirely by its result value. - ----------- has_side_effects --------------------- -A primop "has_side_effects" if it has some side effect, visible -elsewhere, apart from the result it returns - - reading or writing to the world (I/O) - - reading or writing to a mutable data structure (writeIORef) - - throwing a synchronous Haskell exception - -Often such primops have a type like - State -> input -> (State, output) -so the state token guarantees ordering. In general we rely on -data dependencies of the state token to enforce write-effect ordering, -but as the notes below make clear, the matter is a bit more complicated -than that. - - * NB1: if you inline unsafePerformIO, you may end up with - side-effecting ops whose 'state' output is discarded. - And programmers may do that by hand; see #9390. - That is why we (conservatively) do not discard write-effecting - primops even if both their state and result is discarded. - - * NB2: We consider primops, such as raiseIO#, that can raise a - (Haskell) synchronous exception to "have_side_effects" but not - "can_fail". We must be careful about not discarding such things; - see the paper "A semantics for imprecise exceptions". - - * NB3: *Read* effects on *mutable* cells (like reading an IORef or a - MutableArray#) /are/ included. You may find this surprising because it - doesn't matter if we don't do them, or do them more than once. *Sequencing* - is maintained by the data dependency of the state token. But see - "Duplication" below under - Note [Transformations affected by can_fail and has_side_effects] - - Note that read operations on *immutable* values (like indexArray#) do not - have has_side_effects. (They might be marked can_fail, however, because - you might index out of bounds.) - - Using has_side_effects in this way is a bit of a blunt instrument. We could - be more refined by splitting read and write effects (see comments with #3207 - and #20195) - ----------- can_fail ---------------------------- -A primop "can_fail" if it can fail with an *unchecked* exception on -some elements of its input domain. Main examples: - division (fails on zero denominator) - array indexing (fails if the index is out of bounds) - -An "unchecked exception" is one that is an outright error, (not -turned into a Haskell exception,) such as seg-fault or -divide-by-zero error. Such can_fail primops are ALWAYS surrounded -with a test that checks for the bad cases, but we need to be -very careful about code motion that might move it out of -the scope of the test. - -Note [Transformations affected by can_fail and has_side_effects] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The can_fail and has_side_effects properties have the following effect -on program transformations. Summary table is followed by details. - - can_fail has_side_effects -Discard YES NO -Float in YES YES -Float out NO NO -Duplicate YES NO - -* Discarding. case (a `op` b) of _ -> rhs ===> rhs - You should not discard a has_side_effects primop; e.g. - case (writeIntArray# a i v s of (# _, _ #) -> True - Arguably you should be able to discard this, since the - returned stat token is not used, but that relies on NEVER - inlining unsafePerformIO, and programmers sometimes write - this kind of stuff by hand (#9390). So we (conservatively) - never discard a has_side_effects primop. - - However, it's fine to discard a can_fail primop. For example - case (indexIntArray# a i) of _ -> True - We can discard indexIntArray#; it has can_fail, but not - has_side_effects; see #5658 which was all about this. - Notice that indexIntArray# is (in a more general handling of - effects) read effect, but we don't care about that here, and - treat read effects as *not* has_side_effects. - - Similarly (a `/#` b) can be discarded. It can seg-fault or - cause a hardware exception, but not a synchronous Haskell - exception. - - - - Synchronous Haskell exceptions, e.g. from raiseIO#, are treated - as has_side_effects and hence are not discarded. - -* Float in. You can float a can_fail or has_side_effects primop - *inwards*, but not inside a lambda (see Duplication below). - -* Float out. You must not float a can_fail primop *outwards* lest - you escape the dynamic scope of the test. Example: + +Note [Exceptions: asynchronous, synchronous, and unchecked] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +There are three very different sorts of things in GHC-Haskell that are +sometimes called exceptions: + +* Haskell exceptions: + + These are ordinary exceptions that users can raise with the likes + of 'throw' and handle with the likes of 'catch'. They come in two + very different flavors: + + * Asynchronous exceptions: + * These can arise at nearly any time, and may have nothing to do + with the code being executed. + * The compiler itself mostly doesn't need to care about them. + * Examples: a signal from another process, running out of heap or stack + * Even pure code can receive asynchronous exceptions; in this + case, executing the same code again may lead to different + results, because the exception may not happen next time. + * See rts/RaiseAsync.c for the gory details of how they work. + + * Synchronous exceptions: + * These are produced by the code being executed, most commonly via + a call to the `raise#` or `raiseIO#` primops. + * At run-time, if a piece of pure code raises a synchronous + exception, it will always raise the same synchronous exception + if it is run again (and not interrupted by an asynchronous + exception). + * In particular, if an updatable thunk does some work and then + raises a synchronous exception, it is safe to overwrite it with + a thunk that /immediately/ raises the same exception. + * Although we are careful not to discard synchronous exceptions, + we are very liberal about re-ordering them with respect to other + operations. See the paper "A semantics for imprecise exceptions" + as well as Note [Precise exceptions and strictness analysis] in + GHC.Types.Demand. + +* Unchecked exceptions: + + * These are nasty failures like seg-faults or primitive Int# division + by zero. They differ from Haskell exceptions in that they are + un-recoverable and typically bring execution to an immediate halt. + * We generally treat unchecked exceptions as undefined behavior, on + the assumption that the programmer never intends to crash the + program in this way. Thus we have no qualms about replacing a + division-by-zero with a recoverable Haskell exception or + discarding an indexArray# operation whose result is unused. + + +Note [Classifying primop effects] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Each primop has an associated 'PrimOpEffect', based on what that +primop can or cannot do at runtime. This classification is + +* Recorded in the 'effect' field in primops.txt.pp, and +* Exposed to the compiler via the 'primOpEffect' function in this module. + +See Note [Transformations affected by primop effects] for how we make +use of this categorisation. + +The meanings of the four constructors of 'PrimOpEffect' are as +follows, in decreasing order of permissiveness: + +* ReadWriteEffect + A primop is marked ReadWriteEffect if it can + - read or write to the world (I/O), or + - read or write to a mutable data structure (e.g. readMutVar#). + + Every such primop uses State# tokens for sequencing, with a type like: + Inputs -> State# s -> (# State# s, Outputs #) + The state token threading expresses ordering, but duplicating even + a read-only effect would defeat this. (See "duplication" under + Note [Transformations affected by primop effects] for details.) + + Note that operations like `indexArray#` that read *immutable* + data structures do not need such special sequencing-related care, + and are therefore not marked ReadWriteEffect. + +* ThrowsException + A primop is marked ThrowsException if + - it is not marked ReadWriteEffect, and + - it may diverge or throw a synchronous Haskell exception + even when used in a "correct" and well-specified way. + + See also Note [Exceptions: asynchronous, synchronous, and unchecked]. + Examples include raise#, raiseIO#, dataToTag#, and seq#. + + Note that whether an exception is considered precise or imprecise + does not matter for the purposes of the PrimOpEffect flag. + +* CanFail + A primop is marked CanFail if + - it is not marked ReadWriteEffect or ThrowsException, and + - it can trigger a (potentially-unchecked) exception when used incorrectly. + + See Note [Exceptions: asynchronous, synchronous, and unchecked]. + Examples include quotWord# and indexIntArray#, which can fail with + division-by-zero and a segfault respectively. + + A correct use of a CanFail primop is usually surrounded by a test + that screens out the bad cases such as a zero divisor or an + out-of-bounds array index. We must take care never to move a + CanFail primop outside the scope of such a test. + +* NoEffect + A primop is marked NoEffect if it does not belong to any of the + other three categories. We can very aggressively shuffle these + operations around without fear of changing a program's meaning. + + Perhaps surprisingly, this aggressive shuffling imposes another + restriction: The tricky NoEffect primop uncheckedShiftLWord32# has + an undefined result when the provided shift amount is not between + 0 and 31. Thus, a call like `uncheckedShiftLWord32# x 95#` is + obviously invalid. But since uncheckedShiftLWord32# is marked + NoEffect, we may float such an invalid call out of a dead branch + and speculatively evaluate it. + + In particular, we cannot safely rewrite such an invalid call to a + runtime error; we must emit code that produces a valid Word32#. + (If we're lucky, Core Lint may complain that the result of such a + rewrite violates the let-can-float invariant (#16742), but the + rewrite is always wrong!) See also Note [Guarding against silly shifts] + in GHC.Core.Opt.ConstantFold. + + Marking uncheckedShiftLWord32# as CanFail instead of NoEffect + would give us the freedom to rewrite such invalid calls to runtime + errors, but would get in the way of optimization: When speculatively + executing a bit-shift prevents the allocation of a thunk, that's a + big win. + + +Note [Transformations affected by primop effects] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The PrimOpEffect properties have the following effect on program +transformations. The summary table is followed by details. See also +Note [Classifying primop effects] for exactly what each column means. + + NoEffect CanFail ThrowsException ReadWriteEffect +Discard YES YES NO NO +Defer (float in) YES YES SAFE SAFE +Speculate (float out) YES NO NO NO +Duplicate YES YES YES NO + +(SAFE means we could perform the transformation but do not.) + +* Discarding: case (a `op` b) of _ -> rhs ===> rhs + You should not discard a ReadWriteEffect primop; e.g. + case (writeIntArray# a i v s of (# _, _ #) -> True + One could argue in favor of discarding this, since the returned + State# token is not used. But in practice unsafePerformIO can + easily produce similar code, and programmers sometimes write this + kind of stuff by hand (#9390). So we (conservatively) never discard + a ReadWriteEffect primop. + + Digression: We could try to track read-only effects separately + from write effects to allow the former to be discarded. But in + fact we want a more general rewrite for read-only operations: + case readOp# state# of (# newState#, _unused_result #) -> body + ==> case state# of newState# -> body + Such a rewrite is not yet implemented, but would have to be done + in a different place anyway. + + Discarding a ThrowsException primop would also discard any exception + it might have thrown. For `raise#` or `raiseIO#` this would defeat + the whole point of the primop, while for `dataToTag#` or `seq#` this + would make programs unexpectly lazier. + + However, it's fine to discard a CanFail primop. For example + case (indexIntArray# a i) of _ -> True + We can discard indexIntArray# here; this came up in #5658. Notice + that CanFail primops like indexIntArray# can only trigger an + exception when used incorrectly, i.e. a call that might not succeed + is undefined behavior anyway. + +* Deferring (float-in): + See Note [Floating primops] in GHC.Core.Opt.FloatIn. + + In the absence of data dependencies (including state token threading), + we reserve the right to re-order the following things arbitrarily: + * Side effects + * Imprecise exceptions + * Divergent computations (infinite loops) + This lets us safely float almost any primop *inwards*, but not + inside a (multi-shot) lambda. (See "Duplication" below.) + + However, the main reason to float-in a primop application would be + to discard it (by floating it into some but not all branches of a + case), so we actually only float-in NoEffect and CanFail operations. + See also Note [Floating primops] in GHC.Core.Opt.FloatIn. + + (This automatically side-steps the question of precise exceptions, which + mustn't be re-ordered arbitrarily but need at least ThrowsException.) + +* Speculation (strict float-out): + You must not float a CanFail primop *outwards* lest it escape the + dynamic scope of a run-time validity test. Example: case d ># 0# of True -> case x /# d of r -> r +# 1 False -> 0 - Here we must not float the case outwards to give + Here we must not float the case outwards to give case x/# d of r -> case d ># 0# of True -> r +# 1 False -> 0 + Otherwise, if this block is reached when d is zero, it will crash. + Exactly the same reasoning applies to ThrowsException primops. - Nor can you float out a has_side_effects primop. For example: + Nor can you float out a ReadWriteEffect primop. For example: if blah then case writeMutVar# v True s0 of (# s1 #) -> s1 else s0 - Notice that s0 is mentioned in both branches of the 'if', but - only one of these two will actually be consumed. But if we - float out to + Notice that s0 is mentioned in both branches of the 'if', but + only one of these two will actually be consumed. But if we + float out to case writeMutVar# v True s0 of (# s1 #) -> if blah then s1 else s0 - the writeMutVar will be performed in both branches, which is - utterly wrong. - -* Duplication. You cannot duplicate a has_side_effect primop. You - might wonder how this can occur given the state token threading, but - just look at Control.Monad.ST.Lazy.Imp.strictToLazy! We get - something like this + the writeMutVar will be performed in both branches, which is + utterly wrong. + + What about a read-only operation that cannot fail, like + readMutVar#? In principle we could safely float these out. But + there are not very many such operations and it's not clear if + there are real-world programs that would benefit from this. + +* Duplication: + You cannot duplicate a ReadWriteEffect primop. You might wonder + how this can occur given the state token threading, but just look + at Control.Monad.ST.Lazy.Imp.strictToLazy! We get something like this p = case readMutVar# s v of (# s', r #) -> (State# s', r) s' = case p of (s', r) -> s' r = case p of (s', r) -> r - (All these bindings are boxed.) If we inline p at its two call - sites, we get a catastrophe: because the read is performed once when - s' is demanded, and once when 'r' is demanded, which may be much - later. Utterly wrong. #3207 is real example of this happening. + (All these bindings are boxed.) If we inline p at its two call + sites, we get a catastrophe: because the read is performed once when + s' is demanded, and once when 'r' is demanded, which may be much + later. Utterly wrong. #3207 is real example of this happening. + Floating p into a multi-shot lambda would be wrong for the same reason. + + However, it's fine to duplicate a CanFail or ThrowsException primop. - However, it's fine to duplicate a can_fail primop. That is really - the only difference between can_fail and has_side_effects. -Note [Implementation: how can_fail/has_side_effects affect transformations] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Note [Implementation: how PrimOpEffect affects transformations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ How do we ensure that floating/duplication/discarding are done right in the simplifier? -Two main predicates on primops test these flags: - primOpOkForSideEffects <=> not has_side_effects - primOpOkForSpeculation <=> not (has_side_effects || can_fail) +Several predicates on primops test this flag: + primOpOkToDiscard <=> effect < ThrowsException + primOpOkForSpeculation <=> effect == NoEffect && not (out_of_line) + primOpIsCheap <=> cheap -- ...defaults to primOpOkForSpeculation + [[But note that the raise# family and seq# are also considered cheap in + GHC.Core.Utils.exprIsCheap by way of being work-free]] + + * The discarding mentioned above happens in + GHC.Core.Opt.Simplify.Iteration, specifically in rebuildCase, + where it is guarded by exprOkToDiscard, which in turn checks + primOpOkToDiscard. * The "no-float-out" thing is achieved by ensuring that we never - let-bind a can_fail or has_side_effects primop. The RHS of a - let-binding (which can float in and out freely) satisfies - exprOkForSpeculation; this is the let-can-float invariant. And - exprOkForSpeculation is false of can_fail and has_side_effects. + let-bind a saturated primop application unless it has NoEffect. + The RHS of a let-binding (which can float in and out freely) + satisfies exprOkForSpeculation; this is the let-can-float + invariant. And exprOkForSpeculation is false of a saturated + primop application unless it has NoEffect. - * So can_fail and has_side_effects primops will appear only as the + * So primops that aren't NoEffect will appear only as the scrutinees of cases, and that's why the FloatIn pass is capable of floating case bindings inwards. - * The no-duplicate thing is done via primOpIsCheap, by making - has_side_effects things (very very very) not-cheap! + * Duplication via inlining and float-in of (lifted) let-binders is + controlled via primOpIsWorkFree and primOpIsCheap, by making + ReadWriteEffect things (among others) not-cheap! (The test + PrimOpEffect_Sanity will complain if any ReadWriteEffect primop + is considered either work-free or cheap.) Additionally, a + case binding is only floated inwards if its scrutinee is ok-to-discard. -} -primOpHasSideEffects :: PrimOp -> Bool -#include "primop-has-side-effects.hs-incl" +primOpEffect :: PrimOp -> PrimOpEffect +#include "primop-effects.hs-incl" -primOpCanFail :: PrimOp -> Bool -#include "primop-can-fail.hs-incl" +data PrimOpEffect + -- See Note [Classifying primop effects] + = NoEffect + | CanFail + | ThrowsException + | ReadWriteEffect + deriving (Eq, Ord) primOpOkForSpeculation :: PrimOp -> Bool - -- See Note [PrimOp can_fail and has_side_effects] + -- See Note [Classifying primop effects] -- See comments with GHC.Core.Utils.exprOkForSpeculation - -- primOpOkForSpeculation => primOpOkForSideEffects + -- primOpOkForSpeculation => primOpOkToDiscard primOpOkForSpeculation op - = primOpOkForSideEffects op - && not (primOpOutOfLine op || primOpCanFail op) + = primOpEffect op == NoEffect && not (primOpOutOfLine op) -- I think the "out of line" test is because out of line things can -- be expensive (eg sine, cosine), and so we may not want to speculate them -primOpOkForSideEffects :: PrimOp -> Bool -primOpOkForSideEffects op - = not (primOpHasSideEffects op) +primOpOkToDiscard :: PrimOp -> Bool +primOpOkToDiscard op + = primOpEffect op < ThrowsException -{- -Note [primOpIsCheap] -~~~~~~~~~~~~~~~~~~~~ - - at primOpIsCheap@, as used in GHC.Core.Opt.Simplify.Utils. For now (HACK -WARNING), we just borrow some other predicates for a -what-should-be-good-enough test. "Cheap" means willing to call it more -than once, and/or push it inside a lambda. The latter could change the -behaviour of 'seq' for primops that can fail, so we don't treat them as cheap. --} +primOpIsWorkFree :: PrimOp -> Bool +#include "primop-is-work-free.hs-incl" primOpIsCheap :: PrimOp -> Bool --- See Note [PrimOp can_fail and has_side_effects] -primOpIsCheap op = primOpOkForSpeculation op +-- See Note [Classifying primop effects] +#include "primop-is-cheap.hs-incl" -- In March 2001, we changed this to -- primOpIsCheap op = False -- thereby making *no* primops seem cheap. But this killed eta @@ -540,7 +637,7 @@ primOpIsCheap op = primOpOkForSpeculation op -- The problem that originally gave rise to the change was -- let x = a +# b *# c in x +# x -- were we don't want to inline x. But primopIsCheap doesn't control --- that (it's exprIsDupable that does) so the problem doesn't occur +-- that (it's primOpIsWorkFree that does) so the problem doesn't occur -- even if primOpIsCheap sometimes says 'True'. ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -136,11 +136,13 @@ -- Int64X2#, SCALAR expands to Int64#, and VECTUPLE expands to (# Int64#, Int64# #). defaults - has_side_effects = False + effect = NoEffect -- See Note [Classifying primop effects] in GHC.Builtin.PrimOps + can_fail_warning = WarnIfEffectIsCanFail out_of_line = False -- See Note [When do out-of-line primops go in primops.txt.pp] - can_fail = False -- See Note [PrimOp can_fail and has_side_effects] in PrimOp commutable = False code_size = { primOpCodeSizeDefault } + work_free = { primOpCodeSize _thisOp == 0 } + cheap = { primOpOkForSpeculation _thisOp } strictness = { \ arity -> mkClosedDmdSig (replicate arity topDmd) topDiv } fixity = Nothing llvm_only = False @@ -166,8 +168,7 @@ defaults -- -- - No polymorphism in type -- - `strictness = ` --- - `can_fail = False` --- - `has_side_effects = True` +-- - `effect = ReadWriteEffect` -- -- https://gitlab.haskell.org/ghc/ghc/issues/16929 tracks this issue, -- and has a table of which external-only primops are blocked by which @@ -295,15 +296,15 @@ primop Int8MulOp "timesInt8#" GenPrimOp Int8# -> Int8# -> Int8# primop Int8QuotOp "quotInt8#" GenPrimOp Int8# -> Int8# -> Int8# with - can_fail = True + effect = CanFail primop Int8RemOp "remInt8#" GenPrimOp Int8# -> Int8# -> Int8# with - can_fail = True + effect = CanFail primop Int8QuotRemOp "quotRemInt8#" GenPrimOp Int8# -> Int8# -> (# Int8#, Int8# #) with - can_fail = True + effect = CanFail primop Int8SllOp "uncheckedShiftLInt8#" GenPrimOp Int8# -> Int# -> Int8# primop Int8SraOp "uncheckedShiftRAInt8#" GenPrimOp Int8# -> Int# -> Int8# @@ -341,15 +342,15 @@ primop Word8MulOp "timesWord8#" GenPrimOp Word8# -> Word8# -> Word8# primop Word8QuotOp "quotWord8#" GenPrimOp Word8# -> Word8# -> Word8# with - can_fail = True + effect = CanFail primop Word8RemOp "remWord8#" GenPrimOp Word8# -> Word8# -> Word8# with - can_fail = True + effect = CanFail primop Word8QuotRemOp "quotRemWord8#" GenPrimOp Word8# -> Word8# -> (# Word8#, Word8# #) with - can_fail = True + effect = CanFail primop Word8AndOp "andWord8#" GenPrimOp Word8# -> Word8# -> Word8# with commutable = True @@ -399,15 +400,15 @@ primop Int16MulOp "timesInt16#" GenPrimOp Int16# -> Int16# -> Int16# primop Int16QuotOp "quotInt16#" GenPrimOp Int16# -> Int16# -> Int16# with - can_fail = True + effect = CanFail primop Int16RemOp "remInt16#" GenPrimOp Int16# -> Int16# -> Int16# with - can_fail = True + effect = CanFail primop Int16QuotRemOp "quotRemInt16#" GenPrimOp Int16# -> Int16# -> (# Int16#, Int16# #) with - can_fail = True + effect = CanFail primop Int16SllOp "uncheckedShiftLInt16#" GenPrimOp Int16# -> Int# -> Int16# primop Int16SraOp "uncheckedShiftRAInt16#" GenPrimOp Int16# -> Int# -> Int16# @@ -445,15 +446,15 @@ primop Word16MulOp "timesWord16#" GenPrimOp Word16# -> Word16# -> Word16# primop Word16QuotOp "quotWord16#" GenPrimOp Word16# -> Word16# -> Word16# with - can_fail = True + effect = CanFail primop Word16RemOp "remWord16#" GenPrimOp Word16# -> Word16# -> Word16# with - can_fail = True + effect = CanFail primop Word16QuotRemOp "quotRemWord16#" GenPrimOp Word16# -> Word16# -> (# Word16#, Word16# #) with - can_fail = True + effect = CanFail primop Word16AndOp "andWord16#" GenPrimOp Word16# -> Word16# -> Word16# with commutable = True @@ -503,15 +504,15 @@ primop Int32MulOp "timesInt32#" GenPrimOp Int32# -> Int32# -> Int32# primop Int32QuotOp "quotInt32#" GenPrimOp Int32# -> Int32# -> Int32# with - can_fail = True + effect = CanFail primop Int32RemOp "remInt32#" GenPrimOp Int32# -> Int32# -> Int32# with - can_fail = True + effect = CanFail primop Int32QuotRemOp "quotRemInt32#" GenPrimOp Int32# -> Int32# -> (# Int32#, Int32# #) with - can_fail = True + effect = CanFail primop Int32SllOp "uncheckedShiftLInt32#" GenPrimOp Int32# -> Int# -> Int32# primop Int32SraOp "uncheckedShiftRAInt32#" GenPrimOp Int32# -> Int# -> Int32# @@ -549,15 +550,15 @@ primop Word32MulOp "timesWord32#" GenPrimOp Word32# -> Word32# -> Word32# primop Word32QuotOp "quotWord32#" GenPrimOp Word32# -> Word32# -> Word32# with - can_fail = True + effect = CanFail primop Word32RemOp "remWord32#" GenPrimOp Word32# -> Word32# -> Word32# with - can_fail = True + effect = CanFail primop Word32QuotRemOp "quotRemWord32#" GenPrimOp Word32# -> Word32# -> (# Word32#, Word32# #) with - can_fail = True + effect = CanFail primop Word32AndOp "andWord32#" GenPrimOp Word32# -> Word32# -> Word32# with commutable = True @@ -607,11 +608,11 @@ primop Int64MulOp "timesInt64#" GenPrimOp Int64# -> Int64# -> Int64# primop Int64QuotOp "quotInt64#" GenPrimOp Int64# -> Int64# -> Int64# with - can_fail = True + effect = CanFail primop Int64RemOp "remInt64#" GenPrimOp Int64# -> Int64# -> Int64# with - can_fail = True + effect = CanFail primop Int64SllOp "uncheckedIShiftL64#" GenPrimOp Int64# -> Int# -> Int64# primop Int64SraOp "uncheckedIShiftRA64#" GenPrimOp Int64# -> Int# -> Int64# @@ -649,11 +650,11 @@ primop Word64MulOp "timesWord64#" GenPrimOp Word64# -> Word64# -> Word64# primop Word64QuotOp "quotWord64#" GenPrimOp Word64# -> Word64# -> Word64# with - can_fail = True + effect = CanFail primop Word64RemOp "remWord64#" GenPrimOp Word64# -> Word64# -> Word64# with - can_fail = True + effect = CanFail primop Word64AndOp "and64#" GenPrimOp Word64# -> Word64# -> Word64# with commutable = True @@ -736,19 +737,19 @@ primop IntQuotOp "quotInt#" GenPrimOp {Rounds towards zero. The behavior is undefined if the second argument is zero. } - with can_fail = True + with effect = CanFail primop IntRemOp "remInt#" GenPrimOp Int# -> Int# -> Int# {Satisfies @('quotInt#' x y) '*#' y '+#' ('remInt#' x y) == x at . The behavior is undefined if the second argument is zero. } - with can_fail = True + with effect = CanFail primop IntQuotRemOp "quotRemInt#" GenPrimOp Int# -> Int# -> (# Int#, Int# #) {Rounds towards zero.} - with can_fail = True + with effect = CanFail primop IntAndOp "andI#" GenPrimOp Int# -> Int# -> Int# {Bitwise "and".} @@ -885,20 +886,20 @@ primop WordMul2Op "timesWord2#" GenPrimOp with commutable = True primop WordQuotOp "quotWord#" GenPrimOp Word# -> Word# -> Word# - with can_fail = True + with effect = CanFail primop WordRemOp "remWord#" GenPrimOp Word# -> Word# -> Word# - with can_fail = True + with effect = CanFail primop WordQuotRemOp "quotRemWord#" GenPrimOp Word# -> Word# -> (# Word#, Word# #) - with can_fail = True + with effect = CanFail primop WordQuotRem2Op "quotRemWord2#" GenPrimOp Word# -> Word# -> Word# -> (# Word#, Word# #) { Takes high word of dividend, then low word of dividend, then divisor. Requires that high word < divisor.} - with can_fail = True + with effect = CanFail primop WordAndOp "and#" GenPrimOp Word# -> Word# -> Word# with commutable = True @@ -1108,7 +1109,7 @@ primop DoubleMulOp "*##" GenPrimOp primop DoubleDivOp "/##" GenPrimOp Double# -> Double# -> Double# - with can_fail = True + with effect = CanFail -- Can this one really fail? fixity = infixl 7 primop DoubleNegOp "negateDouble#" GenPrimOp Double# -> Double# @@ -1136,13 +1137,13 @@ primop DoubleLogOp "logDouble#" GenPrimOp Double# -> Double# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop DoubleLog1POp "log1pDouble#" GenPrimOp Double# -> Double# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop DoubleSqrtOp "sqrtDouble#" GenPrimOp Double# -> Double# @@ -1168,13 +1169,13 @@ primop DoubleAsinOp "asinDouble#" GenPrimOp Double# -> Double# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop DoubleAcosOp "acosDouble#" GenPrimOp Double# -> Double# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop DoubleAtanOp "atanDouble#" GenPrimOp Double# -> Double# @@ -1263,7 +1264,7 @@ primop FloatMulOp "timesFloat#" GenPrimOp primop FloatDivOp "divideFloat#" GenPrimOp Float# -> Float# -> Float# - with can_fail = True + with effect = CanFail primop FloatNegOp "negateFloat#" GenPrimOp Float# -> Float# @@ -1288,13 +1289,13 @@ primop FloatLogOp "logFloat#" GenPrimOp Float# -> Float# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop FloatLog1POp "log1pFloat#" GenPrimOp Float# -> Float# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop FloatSqrtOp "sqrtFloat#" GenPrimOp Float# -> Float# @@ -1320,13 +1321,13 @@ primop FloatAsinOp "asinFloat#" GenPrimOp Float# -> Float# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop FloatAcosOp "acosFloat#" GenPrimOp Float# -> Float# with code_size = { primOpCodeSizeForeignCall } - can_fail = True + effect = CanFail primop FloatAtanOp "atanFloat#" GenPrimOp Float# -> Float# @@ -1461,22 +1462,22 @@ primop NewArrayOp "newArray#" GenPrimOp with each element containing the specified initial value.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop ReadArrayOp "readArray#" GenPrimOp MutableArray# s a_levpoly -> Int# -> State# s -> (# State# s, a_levpoly #) {Read from specified index of mutable array. Result is not yet evaluated.} with - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop WriteArrayOp "writeArray#" GenPrimOp MutableArray# s a_levpoly -> Int# -> a_levpoly -> State# s -> State# s {Write to specified index of mutable array.} with - has_side_effects = True - can_fail = True - code_size = 2 -- card update too + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail + code_size = 2 -- card update too primop SizeofArrayOp "sizeofArray#" GenPrimOp Array# a_levpoly -> Int# @@ -1496,20 +1497,20 @@ primop IndexArrayOp "indexArray#" GenPrimOp heap. Avoiding these thunks, in turn, reduces references to the argument array, allowing it to be garbage collected more promptly.} with - can_fail = True + effect = CanFail primop UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp MutableArray# s a_levpoly -> State# s -> (# State# s, Array# a_levpoly #) {Make a mutable array immutable, without copying.} with - has_side_effects = True + effect = ReadWriteEffect primop UnsafeThawArrayOp "unsafeThawArray#" GenPrimOp Array# a_levpoly -> State# s -> (# State# s, MutableArray# s a_levpoly #) {Make an immutable array mutable, without copying.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop CopyArrayOp "copyArray#" GenPrimOp Array# a_levpoly -> Int# -> MutableArray# s a_levpoly -> Int# -> Int# -> State# s -> State# s @@ -1522,8 +1523,8 @@ primop CopyArrayOp "copyArray#" GenPrimOp either.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp MutableArray# s a_levpoly -> Int# -> MutableArray# s a_levpoly -> Int# -> Int# -> State# s -> State# s @@ -1536,8 +1537,8 @@ primop CopyMutableArrayOp "copyMutableArray#" GenPrimOp destination regions may overlap.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CloneArrayOp "cloneArray#" GenPrimOp Array# a_levpoly -> Int# -> Int# -> Array# a_levpoly @@ -1547,8 +1548,8 @@ primop CloneArrayOp "cloneArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect -- assumed too expensive to duplicate? + can_fail_warning = YesWarnCanFail primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp MutableArray# s a_levpoly -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a_levpoly #) @@ -1558,8 +1559,8 @@ primop CloneMutableArrayOp "cloneMutableArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FreezeArrayOp "freezeArray#" GenPrimOp MutableArray# s a_levpoly -> Int# -> Int# -> State# s -> (# State# s, Array# a_levpoly #) @@ -1569,8 +1570,8 @@ primop FreezeArrayOp "freezeArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop ThawArrayOp "thawArray#" GenPrimOp Array# a_levpoly -> Int# -> Int# -> State# s -> (# State# s, MutableArray# s a_levpoly #) @@ -1580,8 +1581,8 @@ primop ThawArrayOp "thawArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasArrayOp "casArray#" GenPrimOp MutableArray# s a_levpoly -> Int# -> a_levpoly -> a_levpoly -> State# s -> (# State# s, Int#, a_levpoly #) @@ -1599,8 +1600,8 @@ primop CasArrayOp "casArray#" GenPrimOp } with out_of_line = True - has_side_effects = True - can_fail = True -- Might index out of bounds + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail ------------------------------------------------------------------------ @@ -1637,7 +1638,7 @@ primop NewSmallArrayOp "newSmallArray#" GenPrimOp with each element containing the specified initial value.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp SmallMutableArray# s a_levpoly -> Int# -> State# s -> State# s @@ -1654,21 +1655,23 @@ primop ShrinkSmallMutableArrayOp_Char "shrinkSmallMutableArray#" GenPrimOp @since 0.6.1} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail + -- can fail because of the "newSize <= oldSize" requirement primop ReadSmallArrayOp "readSmallArray#" GenPrimOp SmallMutableArray# s a_levpoly -> Int# -> State# s -> (# State# s, a_levpoly #) {Read from specified index of mutable array. Result is not yet evaluated.} with - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop WriteSmallArrayOp "writeSmallArray#" GenPrimOp SmallMutableArray# s a_levpoly -> Int# -> a_levpoly -> State# s -> State# s {Write to specified index of mutable array.} with - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop SizeofSmallArrayOp "sizeofSmallArray#" GenPrimOp SmallArray# a_levpoly -> Int# @@ -1693,20 +1696,20 @@ primop IndexSmallArrayOp "indexSmallArray#" GenPrimOp {Read from specified index of immutable array. Result is packaged into an unboxed singleton; the result itself is not yet evaluated.} with - can_fail = True + effect = CanFail primop UnsafeFreezeSmallArrayOp "unsafeFreezeSmallArray#" GenPrimOp SmallMutableArray# s a_levpoly -> State# s -> (# State# s, SmallArray# a_levpoly #) {Make a mutable array immutable, without copying.} with - has_side_effects = True + effect = ReadWriteEffect primop UnsafeThawSmallArrayOp "unsafeThawSmallArray#" GenPrimOp SmallArray# a_levpoly -> State# s -> (# State# s, SmallMutableArray# s a_levpoly #) {Make an immutable array mutable, without copying.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect -- The code_size is only correct for the case when the copy family of -- primops aren't inlined. It would be nice to keep track of both. @@ -1721,9 +1724,9 @@ primop CopySmallArrayOp "copySmallArray#" GenPrimOp be the same array in different states, but this is not checked either.} with - out_of_line = True - has_side_effects = True - can_fail = True + out_of_line = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp SmallMutableArray# s a_levpoly -> Int# -> SmallMutableArray# s a_levpoly -> Int# -> Int# -> State# s -> State# s @@ -1736,9 +1739,9 @@ primop CopySmallMutableArrayOp "copySmallMutableArray#" GenPrimOp The regions are allowed to overlap, although this is only possible when the same array is provided as both the source and the destination. } with - out_of_line = True - has_side_effects = True - can_fail = True + out_of_line = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CloneSmallArrayOp "cloneSmallArray#" GenPrimOp SmallArray# a_levpoly -> Int# -> Int# -> SmallArray# a_levpoly @@ -1748,8 +1751,8 @@ primop CloneSmallArrayOp "cloneSmallArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect -- assumed too expensive to duplicate? + can_fail_warning = YesWarnCanFail primop CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp SmallMutableArray# s a_levpoly -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a_levpoly #) @@ -1759,8 +1762,8 @@ primop CloneSmallMutableArrayOp "cloneSmallMutableArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp SmallMutableArray# s a_levpoly -> Int# -> Int# -> State# s -> (# State# s, SmallArray# a_levpoly #) @@ -1770,8 +1773,8 @@ primop FreezeSmallArrayOp "freezeSmallArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp SmallArray# a_levpoly -> Int# -> Int# -> State# s -> (# State# s, SmallMutableArray# s a_levpoly #) @@ -1781,8 +1784,8 @@ primop ThawSmallArrayOp "thawSmallArray#" GenPrimOp range, but this is not checked.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasSmallArrayOp "casSmallArray#" GenPrimOp SmallMutableArray# s a_levpoly -> Int# -> a_levpoly -> a_levpoly -> State# s -> (# State# s, Int#, a_levpoly #) @@ -1790,8 +1793,8 @@ primop CasSmallArrayOp "casSmallArray#" GenPrimOp See the documentation of 'casArray#'.} with out_of_line = True - has_side_effects = True - can_fail = True -- Might index out of bounds + effect = ReadWriteEffect -- Might index out of bounds + can_fail_warning = YesWarnCanFail ------------------------------------------------------------------------ section "Byte Arrays" @@ -1857,20 +1860,23 @@ primop NewByteArrayOp_Char "newByteArray#" GenPrimOp the specified state thread. The size of the memory underlying the array will be rounded up to the platform's word size.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp Int# -> State# s -> (# State# s, MutableByteArray# s #) {Like 'newByteArray#' but GC guarantees not to move it.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop NewAlignedPinnedByteArrayOp_Char "newAlignedPinnedByteArray#" GenPrimOp Int# -> Int# -> State# s -> (# State# s, MutableByteArray# s #) {Like 'newPinnedByteArray#' but allow specifying an arbitrary alignment, which must be a power of two.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail + -- can fail warning for the "power of two" requirement + -- TODO: Fact-check this. primop MutableByteArrayIsPinnedOp "isMutableByteArrayPinned#" GenPrimOp MutableByteArray# s -> Int# @@ -1903,7 +1909,9 @@ primop ShrinkMutableByteArrayOp_Char "shrinkMutableByteArray#" GenPrimOp @since 0.4.0.0} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail + -- can fail for the "newSize <= oldSize" requirement primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) @@ -1921,13 +1929,14 @@ primop ResizeMutableByteArrayOp_Char "resizeMutableByteArray#" GenPrimOp @since 0.4.0.0} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp MutableByteArray# s -> State# s -> (# State# s, ByteArray# #) {Make a mutable byte array immutable, without copying.} with - has_side_effects = True + -- why was this has_side_effects? + code_size = 0 primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp ByteArray# -> State# s -> (# State# s, MutableByteArray# s #) @@ -1935,7 +1944,8 @@ primop UnsafeThawByteArrayOp "unsafeThawByteArray#" GenPrimOp @since 0.12.0.0} with - has_side_effects = True + -- why was this has_side_effects? + code_size = 0 primop SizeofByteArrayOp "sizeofByteArray#" GenPrimOp ByteArray# -> Int# @@ -1976,7 +1986,7 @@ primop CompareByteArraysOp "compareByteArrays#" GenPrimOp @since 0.5.2.0} with - can_fail = True + effect = CanFail primop CopyByteArrayOp "copyByteArray#" GenPrimOp ByteArray# -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s @@ -1989,9 +1999,9 @@ primop CopyByteArrayOp "copyByteArray#" GenPrimOp either. } with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall + 4} - can_fail = True primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s @@ -2004,9 +2014,9 @@ primop CopyMutableByteArrayOp "copyMutableByteArray#" GenPrimOp array is provided as both the source and the destination. } with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True primop CopyMutableByteArrayNonOverlappingOp "copyMutableByteArrayNonOverlapping#" GenPrimOp MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s @@ -2020,9 +2030,9 @@ primop CopyMutableByteArrayNonOverlappingOp "copyMutableByteArrayNonOverlapping @since 0.11.0 } with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp ByteArray# -> Int# -> Addr# -> Int# -> State# s -> State# s @@ -2032,9 +2042,9 @@ primop CopyByteArrayToAddrOp "copyByteArrayToAddr#" GenPrimOp ByteArray\# (e.g. if the ByteArray\# were pinned), but this is not checked either.} with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp MutableByteArray# s -> Int# -> Addr# -> Int# -> State# s -> State# s @@ -2044,9 +2054,9 @@ primop CopyMutableByteArrayToAddrOp "copyMutableByteArrayToAddr#" GenPrimOp point into the MutableByteArray\# (e.g. if the MutableByteArray\# were pinned), but this is not checked either.} with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp Addr# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s @@ -2056,9 +2066,9 @@ primop CopyAddrToByteArrayOp "copyAddrToByteArray#" GenPrimOp point into the MutableByteArray\# (e.g. if the MutableByteArray\# were pinned), but this is not checked either.} with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True primop CopyAddrToAddrOp "copyAddrToAddr#" GenPrimOp Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld @@ -2071,9 +2081,9 @@ primop CopyAddrToAddrOp "copyAddrToAddr#" GenPrimOp @since 0.11.0 } with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall } - can_fail = True primop CopyAddrToAddrNonOverlappingOp "copyAddrToAddrNonOverlapping#" GenPrimOp Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld @@ -2087,18 +2097,18 @@ primop CopyAddrToAddrNonOverlappingOp "copyAddrToAddrNonOverlapping#" GenPrimOp @since 0.11.0 } with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall } - can_fail = True primop SetByteArrayOp "setByteArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s {@'setByteArray#' ba off len c@ sets the byte range @[off, off+len)@ of the 'MutableByteArray#' to the byte @c at .} with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall + 4 } - can_fail = True primop SetAddrRangeOp "setAddrRange#" GenPrimOp Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld @@ -2111,9 +2121,9 @@ primop SetAddrRangeOp "setAddrRange#" GenPrimOp @since 0.11.0 } with - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail code_size = { primOpCodeSizeForeignCall } - can_fail = True -- Atomic operations @@ -2121,15 +2131,17 @@ primop AtomicReadByteArrayOp_Int "atomicReadIntArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) {Given an array and an offset in machine words, read an element. The index is assumed to be in bounds. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop AtomicWriteByteArrayOp_Int "atomicWriteIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> State# s -> State# s {Given an array and an offset in machine words, write an element. The index is assumed to be in bounds. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasByteArrayOp_Int "casIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> (# State# s, Int# #) @@ -2138,8 +2150,9 @@ primop CasByteArrayOp_Int "casIntArray#" GenPrimOp value if the current value matches the provided old value. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasByteArrayOp_Int8 "casInt8Array#" GenPrimOp MutableByteArray# s -> Int# -> Int8# -> Int8# -> State# s -> (# State# s, Int8# #) @@ -2148,8 +2161,9 @@ primop CasByteArrayOp_Int8 "casInt8Array#" GenPrimOp value if the current value matches the provided old value. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasByteArrayOp_Int16 "casInt16Array#" GenPrimOp MutableByteArray# s -> Int# -> Int16# -> Int16# -> State# s -> (# State# s, Int16# #) @@ -2158,8 +2172,9 @@ primop CasByteArrayOp_Int16 "casInt16Array#" GenPrimOp value if the current value matches the provided old value. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasByteArrayOp_Int32 "casInt32Array#" GenPrimOp MutableByteArray# s -> Int# -> Int32# -> Int32# -> State# s -> (# State# s, Int32# #) @@ -2168,8 +2183,9 @@ primop CasByteArrayOp_Int32 "casInt32Array#" GenPrimOp value if the current value matches the provided old value. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasByteArrayOp_Int64 "casInt64Array#" GenPrimOp MutableByteArray# s -> Int# -> Int64# -> Int64# -> State# s -> (# State# s, Int64# #) @@ -2178,56 +2194,63 @@ primop CasByteArrayOp_Int64 "casInt64Array#" GenPrimOp value if the current value matches the provided old value. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchAddByteArrayOp_Int "fetchAddIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) {Given an array, and offset in machine words, and a value to add, atomically add the value to the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchSubByteArrayOp_Int "fetchSubIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) {Given an array, and offset in machine words, and a value to subtract, atomically subtract the value from the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchAndByteArrayOp_Int "fetchAndIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) {Given an array, and offset in machine words, and a value to AND, atomically AND the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchNandByteArrayOp_Int "fetchNandIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) {Given an array, and offset in machine words, and a value to NAND, atomically NAND the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchOrByteArrayOp_Int "fetchOrIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) {Given an array, and offset in machine words, and a value to OR, atomically OR the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) {Given an array, and offset in machine words, and a value to XOR, atomically XOR the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail ------------------------------------------------------------------------ section "Addr#" @@ -2273,15 +2296,17 @@ primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) {The atomic exchange operation. Atomically exchanges the value at the first address with the Addr# given as second argument. Implies a read barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop InterlockedExchange_Word "atomicExchangeWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {The atomic exchange operation. Atomically exchanges the value at the address with the given value. Returns the old value. Implies a read barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasAddrOp_Addr "atomicCasAddrAddr#" GenPrimOp Addr# -> Addr# -> Addr# -> State# s -> (# State# s, Addr# #) @@ -2294,8 +2319,9 @@ primop CasAddrOp_Addr "atomicCasAddrAddr#" GenPrimOp most architectures). Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasAddrOp_Word "atomicCasWordAddr#" GenPrimOp Addr# -> Word# -> Word# -> State# s -> (# State# s, Word# #) @@ -2308,8 +2334,9 @@ primop CasAddrOp_Word "atomicCasWordAddr#" GenPrimOp most architectures). Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasAddrOp_Word8 "atomicCasWord8Addr#" GenPrimOp Addr# -> Word8# -> Word8# -> State# s -> (# State# s, Word8# #) @@ -2322,8 +2349,9 @@ primop CasAddrOp_Word8 "atomicCasWord8Addr#" GenPrimOp most architectures). Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasAddrOp_Word16 "atomicCasWord16Addr#" GenPrimOp Addr# -> Word16# -> Word16# -> State# s -> (# State# s, Word16# #) @@ -2336,8 +2364,9 @@ primop CasAddrOp_Word16 "atomicCasWord16Addr#" GenPrimOp most architectures). Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasAddrOp_Word32 "atomicCasWord32Addr#" GenPrimOp Addr# -> Word32# -> Word32# -> State# s -> (# State# s, Word32# #) @@ -2350,8 +2379,9 @@ primop CasAddrOp_Word32 "atomicCasWord32Addr#" GenPrimOp most architectures). Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop CasAddrOp_Word64 "atomicCasWord64Addr#" GenPrimOp Addr# -> Word64# -> Word64# -> State# s -> (# State# s, Word64# #) @@ -2364,68 +2394,77 @@ primop CasAddrOp_Word64 "atomicCasWord64Addr#" GenPrimOp most architectures). Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchAddAddrOp_Word "fetchAddWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to add, atomically add the value to the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchSubAddrOp_Word "fetchSubWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to subtract, atomically subtract the value from the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchAndAddrOp_Word "fetchAndWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to AND, atomically AND the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchNandAddrOp_Word "fetchNandWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to NAND, atomically NAND the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchOrAddrOp_Word "fetchOrWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to OR, atomically OR the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop FetchXorAddrOp_Word "fetchXorWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to XOR, atomically XOR the value into the element. Returns the value of the element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop AtomicReadAddrOp_Word "atomicReadWordAddr#" GenPrimOp Addr# -> State# s -> (# State# s, Word# #) {Given an address, read a machine word. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail primop AtomicWriteAddrOp_Word "atomicWriteWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> State# s {Given an address, write a machine word. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True + with + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail ------------------------------------------------------------------------ @@ -2441,18 +2480,18 @@ primop NewMutVarOp "newMutVar#" GenPrimOp {Create 'MutVar#' with specified initial value in specified state thread.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect -- Note [Why MutVar# ops can't fail] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- --- We don't label readMutVar# or writeMutVar# as can_fail. +-- We don't label readMutVar# or writeMutVar# as CanFail. -- This may seem a bit peculiar, because they surely *could* -- fail spectacularly if passed a pointer to unallocated memory. -- But MutVar#s are always correct by construction; we never -- test if a pointer is valid before using it with these operations. -- So we never have to worry about floating the pointer reference --- outside a validity test. At the moment, has_side_effects blocks +-- outside a validity test. At the moment, ReadWriteEffect blocks -- up the relevant optimizations anyway, but we hope to draw finer -- distinctions soon, which should improve matters for readMutVar# -- at least. @@ -2462,21 +2501,21 @@ primop ReadMutVarOp "readMutVar#" GenPrimOp {Read contents of 'MutVar#'. Result is not yet evaluated.} with -- See Note [Why MutVar# ops can't fail] - has_side_effects = True + effect = ReadWriteEffect primop WriteMutVarOp "writeMutVar#" GenPrimOp MutVar# s a_levpoly -> a_levpoly -> State# s -> State# s {Write contents of 'MutVar#'.} with -- See Note [Why MutVar# ops can't fail] - has_side_effects = True + effect = ReadWriteEffect code_size = { primOpCodeSizeForeignCall } -- for the write barrier primop AtomicSwapMutVarOp "atomicSwapMutVar#" GenPrimOp MutVar# s a_levpoly -> a_levpoly -> State# s -> (# State# s, a_levpoly #) {Atomically exchange the value of a 'MutVar#'.} with - has_side_effects = True + effect = ReadWriteEffect -- Note [Why not an unboxed tuple in atomicModifyMutVar2#?] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2512,8 +2551,8 @@ primop AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp well-typed high-level wrapper.} with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + -- Why was this previously can_fail? strictness = { \ _arity -> mkClosedDmdSig [ topDmd, lazyApply1Dmd, topDmd ] topDiv } primop AtomicModifyMutVar_Op "atomicModifyMutVar_#" GenPrimOp @@ -2523,8 +2562,8 @@ primop AtomicModifyMutVar_Op "atomicModifyMutVar_#" GenPrimOp previous contents. } with out_of_line = True - has_side_effects = True - can_fail = True + effect = ReadWriteEffect + -- Why was this previously can_fail? strictness = { \ _arity -> mkClosedDmdSig [ topDmd, lazyApply1Dmd, topDmd ] topDiv } primop CasMutVarOp "casMutVar#" GenPrimOp @@ -2546,7 +2585,7 @@ primop CasMutVarOp "casMutVar#" GenPrimOp } with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect ------------------------------------------------------------------------ section "Exceptions" @@ -2582,7 +2621,9 @@ primop CatchOp "catch#" GenPrimOp , topDmd] topDiv } -- See Note [Strictness for mask/unmask/catch] out_of_line = True - has_side_effects = True + effect = ReadWriteEffect + -- Either inner computation might potentially raise an unchecked exception, + -- but it doesn't seem worth putting a WARNING in the haddocks over primop RaiseOp "raise#" GenPrimOp a_levpoly -> b_reppoly @@ -2591,36 +2632,37 @@ primop RaiseOp "raise#" GenPrimOp -- exceptions thrown by 'raise#' are considered *imprecise*. -- See Note [Precise vs imprecise exceptions] in GHC.Types.Demand. -- Hence, it has 'botDiv', not 'exnDiv'. - -- For the same reasons, 'raise#' is marked as "can_fail" (which 'raiseIO#' - -- is not), but not as "has_side_effects" (which 'raiseIO#' is). - -- See Note [PrimOp can_fail and has_side_effects] in "GHC.Builtin.PrimOps". strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } out_of_line = True - can_fail = True + effect = ThrowsException + work_free = True primop RaiseUnderflowOp "raiseUnderflow#" GenPrimOp (# #) -> b_reppoly with strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } out_of_line = True - can_fail = True + effect = ThrowsException code_size = { primOpCodeSizeForeignCall } + work_free = True primop RaiseOverflowOp "raiseOverflow#" GenPrimOp (# #) -> b_reppoly with strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } out_of_line = True - can_fail = True + effect = ThrowsException code_size = { primOpCodeSizeForeignCall } + work_free = True primop RaiseDivZeroOp "raiseDivZero#" GenPrimOp (# #) -> b_reppoly with strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } out_of_line = True - can_fail = True + effect = ThrowsException code_size = { primOpCodeSizeForeignCall } + work_free = True primop RaiseIOOp "raiseIO#" GenPrimOp a_levpoly -> State# RealWorld -> (# State# RealWorld, b_reppoly #) @@ -2629,7 +2671,8 @@ primop RaiseIOOp "raiseIO#" GenPrimOp -- for why this is the *only* primop that has 'exnDiv' strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd] exnDiv } out_of_line = True - has_side_effects = True + effect = ThrowsException + work_free = True primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a_reppoly #)) @@ -2644,7 +2687,7 @@ primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv } -- See Note [Strictness for mask/unmask/catch] out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a_reppoly #)) @@ -2658,7 +2701,7 @@ primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp with strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv } out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a_reppoly #)) @@ -2673,13 +2716,13 @@ primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv } -- See Note [Strictness for mask/unmask/catch] out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop MaskStatus "getMaskingState#" GenPrimOp State# RealWorld -> (# State# RealWorld, Int# #) with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect ------------------------------------------------------------------------ section "Continuations" @@ -2849,7 +2892,7 @@ primop NewPromptTagOp "newPromptTag#" GenPrimOp { See "GHC.Prim#continuations". } with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop PromptOp "prompt#" GenPrimOp PromptTag# a @@ -2859,7 +2902,7 @@ primop PromptOp "prompt#" GenPrimOp with strictness = { \ _arity -> mkClosedDmdSig [topDmd, strictOnceApply1Dmd, topDmd] topDiv } out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop Control0Op "control0#" GenPrimOp PromptTag# a @@ -2871,7 +2914,8 @@ primop Control0Op "control0#" GenPrimOp with strictness = { \ _arity -> mkClosedDmdSig [topDmd, lazyApply2Dmd, topDmd] topDiv } out_of_line = True - has_side_effects = True + effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail ------------------------------------------------------------------------ section "STM-accessible Mutable Variables" @@ -2886,7 +2930,7 @@ primop AtomicallyOp "atomically#" GenPrimOp strictness = { \ _arity -> mkClosedDmdSig [strictManyApply1Dmd,topDmd] topDiv } -- See Note [Strictness for mask/unmask/catch] out_of_line = True - has_side_effects = True + effect = ReadWriteEffect -- NB: retry#'s strictness information specifies it to diverge. -- This lets the compiler perform some extra simplifications, since retry# @@ -2903,7 +2947,7 @@ primop RetryOp "retry#" GenPrimOp with strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv } out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop CatchRetryOp "catchRetry#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a_levpoly #) ) @@ -2915,7 +2959,7 @@ primop CatchRetryOp "catchRetry#" GenPrimOp , topDmd ] topDiv } -- See Note [Strictness for mask/unmask/catch] out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop CatchSTMOp "catchSTM#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a_levpoly #) ) @@ -2927,7 +2971,7 @@ primop CatchSTMOp "catchSTM#" GenPrimOp , topDmd ] topDiv } -- See Note [Strictness for mask/unmask/catch] out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop NewTVarOp "newTVar#" GenPrimOp a_levpoly @@ -2935,7 +2979,7 @@ primop NewTVarOp "newTVar#" GenPrimOp {Create a new 'TVar#' holding a specified initial value.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop ReadTVarOp "readTVar#" GenPrimOp TVar# s a_levpoly @@ -2945,7 +2989,7 @@ primop ReadTVarOp "readTVar#" GenPrimOp Does not force evaluation of the result.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop ReadTVarIOOp "readTVarIO#" GenPrimOp TVar# s a_levpoly @@ -2954,7 +2998,7 @@ primop ReadTVarIOOp "readTVarIO#" GenPrimOp Does not force evaluation of the result.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop WriteTVarOp "writeTVar#" GenPrimOp TVar# s a_levpoly @@ -2963,7 +3007,7 @@ primop WriteTVarOp "writeTVar#" GenPrimOp {Write contents of 'TVar#'.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect ------------------------------------------------------------------------ @@ -2981,7 +3025,7 @@ primop NewMVarOp "newMVar#" GenPrimOp {Create new 'MVar#'; initially empty.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop TakeMVarOp "takeMVar#" GenPrimOp MVar# s a_levpoly -> State# s -> (# State# s, a_levpoly #) @@ -2989,7 +3033,7 @@ primop TakeMVarOp "takeMVar#" GenPrimOp Then remove and return its contents, and set it empty.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp MVar# s a_levpoly -> State# s -> (# State# s, Int#, a_levpoly #) @@ -2997,7 +3041,7 @@ primop TryTakeMVarOp "tryTakeMVar#" GenPrimOp Otherwise, return with integer 1 and contents of 'MVar#', and set 'MVar#' empty.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop PutMVarOp "putMVar#" GenPrimOp MVar# s a_levpoly -> a_levpoly -> State# s -> State# s @@ -3005,7 +3049,7 @@ primop PutMVarOp "putMVar#" GenPrimOp Then store value arg as its new contents.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop TryPutMVarOp "tryPutMVar#" GenPrimOp MVar# s a_levpoly -> a_levpoly -> State# s -> (# State# s, Int# #) @@ -3013,7 +3057,7 @@ primop TryPutMVarOp "tryPutMVar#" GenPrimOp Otherwise, store value arg as 'MVar#''s new contents, and return with integer 1.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop ReadMVarOp "readMVar#" GenPrimOp MVar# s a_levpoly -> State# s -> (# State# s, a_levpoly #) @@ -3022,7 +3066,7 @@ primop ReadMVarOp "readMVar#" GenPrimOp of intervention from other threads.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop TryReadMVarOp "tryReadMVar#" GenPrimOp MVar# s a_levpoly -> State# s -> (# State# s, Int#, a_levpoly #) @@ -3030,14 +3074,14 @@ primop TryReadMVarOp "tryReadMVar#" GenPrimOp Otherwise, return with integer 1 and contents of 'MVar#'.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop IsEmptyMVarOp "isEmptyMVar#" GenPrimOp MVar# s a_levpoly -> State# s -> (# State# s, Int# #) {Return 1 if 'MVar#' is empty; 0 otherwise.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect ------------------------------------------------------------------------ @@ -3055,7 +3099,7 @@ primop NewIOPortOp "newIOPort#" GenPrimOp {Create new 'IOPort#'; initially empty.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop ReadIOPortOp "readIOPort#" GenPrimOp IOPort# s a_levpoly -> State# s -> (# State# s, a_levpoly #) @@ -3065,7 +3109,7 @@ primop ReadIOPortOp "readIOPort#" GenPrimOp waiting to read this 'IOPort#'.} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop WriteIOPortOp "writeIOPort#" GenPrimOp IOPort# s a_levpoly -> a_levpoly -> State# s -> (# State# s, Int# #) @@ -3075,7 +3119,7 @@ primop WriteIOPortOp "writeIOPort#" GenPrimOp and return with integer 1. } with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect ------------------------------------------------------------------------ section "Delay/wait operations" @@ -3085,21 +3129,21 @@ primop DelayOp "delay#" GenPrimOp Int# -> State# s -> State# s {Sleep specified number of microseconds.} with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop WaitReadOp "waitRead#" GenPrimOp Int# -> State# s -> State# s {Block until input is available on specified file descriptor.} with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop WaitWriteOp "waitWrite#" GenPrimOp Int# -> State# s -> State# s {Block until output is possible on specified file descriptor.} with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True ------------------------------------------------------------------------ @@ -3127,7 +3171,7 @@ primop ForkOp "fork#" GenPrimOp (State# RealWorld -> (# State# RealWorld, a_reppoly #)) -> State# RealWorld -> (# State# RealWorld, ThreadId# #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd , topDmd ] topDiv } @@ -3136,7 +3180,7 @@ primop ForkOnOp "forkOn#" GenPrimOp Int# -> (State# RealWorld -> (# State# RealWorld, a_reppoly #)) -> State# RealWorld -> (# State# RealWorld, ThreadId# #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True strictness = { \ _arity -> mkClosedDmdSig [ topDmd , lazyApply1Dmd @@ -3145,39 +3189,39 @@ primop ForkOnOp "forkOn#" GenPrimOp primop KillThreadOp "killThread#" GenPrimOp ThreadId# -> a -> State# RealWorld -> State# RealWorld with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop YieldOp "yield#" GenPrimOp State# RealWorld -> State# RealWorld with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop MyThreadIdOp "myThreadId#" GenPrimOp State# RealWorld -> (# State# RealWorld, ThreadId# #) with - has_side_effects = True + effect = ReadWriteEffect primop LabelThreadOp "labelThread#" GenPrimOp ThreadId# -> ByteArray# -> State# RealWorld -> State# RealWorld {Set the label of the given thread. The @ByteArray#@ should contain a UTF-8-encoded string.} with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp State# RealWorld -> (# State# RealWorld, Int# #) with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop NoDuplicateOp "noDuplicate#" GenPrimOp State# s -> State# s with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop GetThreadLabelOp "threadLabel#" GenPrimOp ThreadId# -> State# RealWorld -> (# State# RealWorld, Int#, ByteArray# #) @@ -3202,7 +3246,7 @@ primop ThreadStatusOp "threadStatus#" GenPrimOp @since 0.9} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect primop ListThreadsOp "listThreads#" GenPrimOp State# RealWorld -> (# State# RealWorld, Array# ThreadId# #) @@ -3213,7 +3257,7 @@ primop ListThreadsOp "listThreads#" GenPrimOp @since 0.10} with out_of_line = True - has_side_effects = True + effect = ReadWriteEffect ------------------------------------------------------------------------ section "Weak pointers" @@ -3230,13 +3274,13 @@ primop MkWeakOp "mkWeak#" GenPrimOp the type of @k@ must be represented by a pointer (i.e. of kind @'TYPE' ''LiftedRep' or @'TYPE' ''UnliftedRep'@). } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop MkWeakNoFinalizerOp "mkWeakNoFinalizer#" GenPrimOp a_levpoly -> b_levpoly -> State# RealWorld -> (# State# RealWorld, Weak# b_levpoly #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp @@ -3249,13 +3293,13 @@ primop AddCFinalizerToWeakOp "addCFinalizerToWeak#" GenPrimOp @eptr@ and @ptr at . 'addCFinalizerToWeak#' returns 1 on success, or 0 if @w@ is already dead. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop DeRefWeakOp "deRefWeak#" GenPrimOp Weak# a_levpoly -> State# RealWorld -> (# State# RealWorld, Int#, a_levpoly #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop FinalizeWeakOp "finalizeWeak#" GenPrimOp @@ -3267,14 +3311,30 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp action. An 'Int#' of @1@ indicates that the finalizer is valid. The return value @b@ from the finalizer should be ignored. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop TouchOp "touch#" GenPrimOp a_levpoly -> State# s -> State# s with - code_size = { 0 } - has_side_effects = True + code_size = 0 + effect = ReadWriteEffect -- see Note [touch# has ReadWriteEffect] + work_free = False + + +-- Note [touch# has ReadWriteEffect] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Although touch# emits no code, it is marked as ReadWriteEffect to +-- prevent it from being defeated by the optimizer: +-- * Discarding a touch# call would defeat its whole purpose. +-- * Strictly floating a touch# call out would shorten the lifetime +-- of the touched object, again defeating its purpose. +-- * Duplicating a touch# call might unpredictably extend the lifetime +-- of the touched object. Although this would not defeat the purpose +-- of touch#, it seems undesirable. +-- +-- In practice, this designation probably doesn't matter in most cases, +-- as touch# is usually tightly coupled with a "real" read or write effect. ------------------------------------------------------------------------ section "Stable pointers and names" @@ -3287,24 +3347,24 @@ primtype StableName# a primop MakeStablePtrOp "makeStablePtr#" GenPrimOp a_levpoly -> State# RealWorld -> (# State# RealWorld, StablePtr# a_levpoly #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop DeRefStablePtrOp "deRefStablePtr#" GenPrimOp StablePtr# a_levpoly -> State# RealWorld -> (# State# RealWorld, a_levpoly #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop EqStablePtrOp "eqStablePtr#" GenPrimOp StablePtr# a_levpoly -> StablePtr# a_levpoly -> Int# with - has_side_effects = True + effect = ReadWriteEffect primop MakeStableNameOp "makeStableName#" GenPrimOp a_levpoly -> State# RealWorld -> (# State# RealWorld, StableName# a_levpoly #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop StableNameToIntOp "stableNameToInt#" GenPrimOp @@ -3336,7 +3396,7 @@ primop CompactNewOp "compactNew#" GenPrimOp The capacity is rounded up to a multiple of the allocator block size and is capped to one mega block. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop CompactResizeOp "compactResize#" GenPrimOp @@ -3346,7 +3406,7 @@ primop CompactResizeOp "compactResize#" GenPrimOp determines the capacity of each compact block in the CNF. It does not retroactively affect existing compact blocks in the CNF. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop CompactContainsOp "compactContains#" GenPrimOp @@ -3388,7 +3448,7 @@ primop CompactAllocateBlockOp "compactAllocateBlock#" GenPrimOp so that the address does not escape or memory will be leaked. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp @@ -3401,7 +3461,7 @@ primop CompactFixupPointersOp "compactFixupPointers#" GenPrimOp a serialized CNF. It returns the new CNF and the new adjusted root address. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop CompactAdd "compactAdd#" GenPrimOp @@ -3414,7 +3474,7 @@ primop CompactAdd "compactAdd#" GenPrimOp enforce any mutual exclusion; the caller is expected to arrange this. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop CompactAddWithSharing "compactAddWithSharing#" GenPrimOp @@ -3422,7 +3482,7 @@ primop CompactAddWithSharing "compactAddWithSharing#" GenPrimOp { Like 'compactAdd#', but retains sharing and cycles during compaction. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop CompactSize "compactSize#" GenPrimOp @@ -3430,7 +3490,7 @@ primop CompactSize "compactSize#" GenPrimOp { Return the total capacity (in bytes) of all the compact blocks in the CNF. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True ------------------------------------------------------------------------ @@ -3442,7 +3502,8 @@ primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp a_levpoly -> b_levpoly -> Int# { Returns @1#@ if the given pointers are equal and @0#@ otherwise. } with - can_fail = True -- See Note [reallyUnsafePtrEquality# can_fail] + effect = CanFail -- See Note [reallyUnsafePtrEquality# CanFail] + can_fail_warning = DoNotWarnCanFail -- Note [Pointer comparison operations] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3474,7 +3535,7 @@ primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp -- -- (PE5) reallyUnsafePtrEquality# can't fail, but it is marked as such -- to prevent it from floating out. --- See Note [reallyUnsafePtrEquality# can_fail] +-- See Note [reallyUnsafePtrEquality# CanFail] -- -- The library GHC.Prim.PtrEq (and GHC.Exts) provides -- @@ -3509,10 +3570,10 @@ primop ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp -- -- These operations are all specialisations of unsafePtrEquality#. --- Note [reallyUnsafePtrEquality# can_fail] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Note [reallyUnsafePtrEquality# CanFail] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- reallyUnsafePtrEquality# can't actually fail, per se, but we mark it --- can_fail anyway. Until 5a9a1738023a, GHC considered primops okay for +-- CanFail anyway. Until 5a9a1738023a, GHC considered primops okay for -- speculation only when their arguments were known to be forced. This was -- unnecessarily conservative, but it prevented reallyUnsafePtrEquality# from -- floating out of places where its arguments were known to be forced. @@ -3547,30 +3608,33 @@ primop ParOp "par#" GenPrimOp with -- Note that Par is lazy to avoid that the sparked thing -- gets evaluated strictly, which it should *not* be - has_side_effects = True + effect = ReadWriteEffect code_size = { primOpCodeSizeForeignCall } deprecated_msg = { Use 'spark#' instead } primop SparkOp "spark#" GenPrimOp a -> State# s -> (# State# s, a #) - with has_side_effects = True + with effect = ReadWriteEffect code_size = { primOpCodeSizeForeignCall } +-- See Note [seq# magic] in GHC.Core.Op.ConstantFold primop SeqOp "seq#" GenPrimOp a -> State# s -> (# State# s, a #) - -- See Note [seq# magic] in GHC.Core.Op.ConstantFold + with + effect = ThrowsException + work_free = True -- seq# does work iff its lifted arg does work primop GetSparkOp "getSpark#" GenPrimOp State# s -> (# State# s, Int#, a #) with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop NumSparks "numSparks#" GenPrimOp State# s -> (# State# s, Int# #) { Returns the number of sparks in the local spark pool. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True @@ -3592,6 +3656,8 @@ primop KeepAliveOp "keepAlive#" GenPrimOp with out_of_line = True strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv } + effect = ReadWriteEffect + -- The invoked computation may have side effects ------------------------------------------------------------------------ @@ -3600,16 +3666,20 @@ section "Tag to enum stuff" and small integers.} ------------------------------------------------------------------------ +-- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold primop DataToTagOp "dataToTag#" GenPrimOp a -> Int# -- Zero-indexed; the first constructor has tag zero { Evaluates the argument and returns the tag of the result. Tags are Zero-indexed; the first constructor has tag zero. } with strictness = { \ _arity -> mkClosedDmdSig [evalDmd] topDiv } - -- See Note [dataToTag# magic] in GHC.Core.Opt.ConstantFold + effect = ThrowsException + cheap = True primop TagToEnumOp "tagToEnum#" GenPrimOp Int# -> a + with + effect = CanFail ------------------------------------------------------------------------ section "Bytecode operations" @@ -3658,7 +3728,7 @@ primop NewBCOOp "newBCO#" GenPrimOp encoded in @instrs@, and a static reference table usage bitmap given by @bitmap at . } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop UnpackClosureOp "unpackClosure#" GenPrimOp @@ -3784,7 +3854,7 @@ primop TraceEventOp "traceEvent#" GenPrimOp argument. The event will be emitted either to the @.eventlog@ file, or to stderr, depending on the runtime RTS flags. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop TraceEventBinaryOp "traceBinaryEvent#" GenPrimOp @@ -3794,7 +3864,7 @@ primop TraceEventBinaryOp "traceBinaryEvent#" GenPrimOp the given length passed as the second argument. The event will be emitted to the @.eventlog@ file. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop TraceMarkerOp "traceMarker#" GenPrimOp @@ -3804,14 +3874,14 @@ primop TraceMarkerOp "traceMarker#" GenPrimOp argument. The event will be emitted either to the @.eventlog@ file, or to stderr, depending on the runtime RTS flags. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primop SetThreadAllocationCounter "setThreadAllocationCounter#" GenPrimOp Int64# -> State# RealWorld -> State# RealWorld { Sets the allocation counter for the current thread to the given value. } with - has_side_effects = True + effect = ReadWriteEffect out_of_line = True primtype StackSnapshot# @@ -3900,7 +3970,7 @@ primop VecUnpackOp "unpack#" GenPrimOp primop VecInsertOp "insert#" GenPrimOp VECTOR -> SCALAR -> Int# -> VECTOR { Insert a scalar at the given position in a vector. } - with can_fail = True + with effect = CanFail llvm_only = True vector = ALL_VECTOR_TYPES @@ -3927,21 +3997,21 @@ primop VecMulOp "times#" GenPrimOp primop VecDivOp "divide#" GenPrimOp VECTOR -> VECTOR -> VECTOR { Divide two vectors element-wise. } - with can_fail = True + with effect = CanFail llvm_only = True vector = FLOAT_VECTOR_TYPES primop VecQuotOp "quot#" GenPrimOp VECTOR -> VECTOR -> VECTOR { Rounds towards zero element-wise. } - with can_fail = True + with effect = CanFail llvm_only = True vector = INT_VECTOR_TYPES primop VecRemOp "rem#" GenPrimOp VECTOR -> VECTOR -> VECTOR { Satisfies @('quot#' x y) 'times#' y 'plus#' ('rem#' x y) == x at . } - with can_fail = True + with effect = CanFail llvm_only = True vector = INT_VECTOR_TYPES @@ -3954,46 +4024,46 @@ primop VecNegOp "negate#" GenPrimOp primop VecIndexByteArrayOp "indexArray#" GenPrimOp ByteArray# -> Int# -> VECTOR { Read a vector from specified index of immutable array. } - with can_fail = True + with effect = CanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecReadByteArrayOp "readArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) { Read a vector from specified index of mutable array. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecWriteByteArrayOp "writeArray#" GenPrimOp MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s { Write a vector to specified index of mutable array. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecIndexOffAddrOp "indexOffAddr#" GenPrimOp Addr# -> Int# -> VECTOR { Reads vector; offset in bytes. } - with can_fail = True + with effect = CanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecReadOffAddrOp "readOffAddr#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, VECTOR #) { Reads vector; offset in bytes. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp Addr# -> Int# -> VECTOR -> State# s -> State# s { Write vector; offset in bytes. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES @@ -4001,46 +4071,46 @@ primop VecWriteOffAddrOp "writeOffAddr#" GenPrimOp primop VecIndexScalarByteArrayOp "indexArrayAs#" GenPrimOp ByteArray# -> Int# -> VECTOR { Read a vector from specified index of immutable array of scalars; offset is in scalar elements. } - with can_fail = True + with effect = CanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecReadScalarByteArrayOp "readArrayAs#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, VECTOR #) { Read a vector from specified index of mutable array of scalars; offset is in scalar elements. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecWriteScalarByteArrayOp "writeArrayAs#" GenPrimOp MutableByteArray# s -> Int# -> VECTOR -> State# s -> State# s { Write a vector to specified index of mutable array of scalars; offset is in scalar elements. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecIndexScalarOffAddrOp "indexOffAddrAs#" GenPrimOp Addr# -> Int# -> VECTOR { Reads vector; offset in scalar elements. } - with can_fail = True + with effect = CanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecReadScalarOffAddrOp "readOffAddrAs#" GenPrimOp Addr# -> Int# -> State# s -> (# State# s, VECTOR #) { Reads vector; offset in scalar elements. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES primop VecWriteScalarOffAddrOp "writeOffAddrAs#" GenPrimOp Addr# -> Int# -> VECTOR -> State# s -> State# s { Write vector; offset in scalar elements. } - with has_side_effects = True - can_fail = True + with effect = ReadWriteEffect + can_fail_warning = YesWarnCanFail llvm_only = True vector = ALL_VECTOR_TYPES @@ -4089,7 +4159,7 @@ section "Prefetch" It is important to note that while the prefetch operations will never change the answer to a pure computation, They CAN change the memory locations resident in a CPU cache and that may change the performance and timing characteristics - of an application. The prefetch operations are marked has_side_effects=True + of an application. The prefetch operations are marked as ReadWriteEffect to reflect that these operations have side effects with respect to the runtime performance characteristics of the resulting code. Additionally, if the prefetchValue operations did not have this attribute, GHC does a float out transformation that @@ -4106,70 +4176,70 @@ section "Prefetch" --- primop PrefetchByteArrayOp3 "prefetchByteArray3#" GenPrimOp ByteArray# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchMutableByteArrayOp3 "prefetchMutableByteArray3#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchAddrOp3 "prefetchAddr3#" GenPrimOp Addr# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchValueOp3 "prefetchValue3#" GenPrimOp a -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect ---- primop PrefetchByteArrayOp2 "prefetchByteArray2#" GenPrimOp ByteArray# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchMutableByteArrayOp2 "prefetchMutableByteArray2#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchAddrOp2 "prefetchAddr2#" GenPrimOp Addr# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchValueOp2 "prefetchValue2#" GenPrimOp a -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect ---- primop PrefetchByteArrayOp1 "prefetchByteArray1#" GenPrimOp ByteArray# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchMutableByteArrayOp1 "prefetchMutableByteArray1#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchAddrOp1 "prefetchAddr1#" GenPrimOp Addr# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchValueOp1 "prefetchValue1#" GenPrimOp a -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect ---- primop PrefetchByteArrayOp0 "prefetchByteArray0#" GenPrimOp ByteArray# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchMutableByteArrayOp0 "prefetchMutableByteArray0#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchAddrOp0 "prefetchAddr0#" GenPrimOp Addr# -> Int# -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect primop PrefetchValueOp0 "prefetchValue0#" GenPrimOp a -> State# s -> State# s - with has_side_effects = True + with effect = ReadWriteEffect -- Note [RuntimeRep polymorphism in continuation-style primops] ===================================== compiler/GHC/Core.hs ===================================== @@ -427,9 +427,6 @@ which will generate a @case@ if necessary The let-can-float invariant is initially enforced by mkCoreLet in GHC.Core.Make. -For discussion of some implications of the let-can-float invariant primops see -Note [Checking versus non-checking primops] in GHC.Builtin.PrimOps. - Historical Note [The let/app invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Before 2022 GHC used the "let/app invariant", which applied the let-can-float rules ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -1099,7 +1099,7 @@ shiftRule lit_num_ty shift_op = do _ | shift_len == 0 -> pure e1 -- See Note [Guarding against silly shifts] - _ | shift_len < 0 || shift_len > bit_size + _ | shift_len < 0 || shift_len >= bit_size -> pure $ Lit $ mkLitNumberWrap platform lit_num_ty 0 -- Be sure to use lit_num_ty here, so we get a correctly typed zero. -- See #18589 @@ -1581,15 +1581,15 @@ as follows: let x = I# (error "invalid shift") in ... -This was originally done in the fix to #16449 but this breaks the let-can-float -invariant (see Note [Core let-can-float invariant] in GHC.Core) as noted in #16742. -For the reasons discussed in Note [Checking versus non-checking -primops] (in the PrimOp module) there is no safe way to rewrite the argument of I# -such that it bottoms. +This was originally done in the fix to #16449 but this breaks the +let-can-float invariant (see Note [Core let-can-float invariant] in +GHC.Core) as noted in #16742. For the reasons discussed under +"NoEffect" in Note [Classifying primop effects] (in GHC.Builtin.PrimOps) +there is no safe way to rewrite the argument of I# such that it bottoms. -Consequently we instead take advantage of the fact that large shifts are -undefined behavior (see associated documentation in primops.txt.pp) and -transform the invalid shift into an "obviously incorrect" value. +Consequently we instead take advantage of the fact that the result of a +large shift is unspecified (see associated documentation in primops.txt.pp) +and transform the invalid shift into an "obviously incorrect" value. There are two cases: @@ -2016,13 +2016,6 @@ Only `SeqOp` shares that property. (Other primops do not do anything as fancy as argument evaluation.) The special handling for dataToTag# is: -* GHC.Core.Utils.exprOkForSpeculation has a special case for DataToTagOp, - (actually in app_ok). Most primops with lifted arguments do not - evaluate those arguments, but DataToTagOp and SeqOp are two - exceptions. We say that they are /never/ ok-for-speculation, - regardless of the evaluated-ness of their argument. - See GHC.Core.Utils Note [exprOkForSpeculation and SeqOp/DataToTagOp] - * There is a special case for DataToTagOp in GHC.StgToCmm.Expr.cgExpr, that evaluates its argument and then extracts the tag from the returned value. @@ -2113,12 +2106,9 @@ Implementing seq#. The compiler has magic for SeqOp in - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq# -- GHC.Core.Utils.exprOkForSpeculation; - see Note [exprOkForSpeculation and SeqOp/DataToTagOp] in GHC.Core.Utils - - Simplify.addEvals records evaluated-ness for the result; see Note [Adding evaluatedness info to pattern-bound variables] - in GHC.Core.Opt.Simplify + in GHC.Core.Opt.Simplify.Iteration -} seqRule :: RuleM CoreExpr ===================================== compiler/GHC/Core/Opt/FloatIn.hs ===================================== @@ -423,6 +423,30 @@ motivating example was #5658: in particular, this change allows array indexing operations, which have a single DEFAULT alternative without any binders, to be floated inward. +In particular, we want to be able to transform + + case indexIntArray# arr i of vi { + __DEFAULT -> case <# j n of _ { + __DEFAULT -> False + 1# -> case indexIntArray# arr j of vj { + __DEFAULT -> ... vi ... vj ... + } + } + } + +by floating in `indexIntArray# arr i` to produce + + case <# j n of _ { + __DEFAULT -> False + 1# -> case indexIntArray# arr i of vi { + __DEFAULT -> case indexIntArray# arr j of vj { + __DEFAULT -> ... vi ... vj ... + } + } + } + +...which skips the `indexIntArray# arr i` call entirely in the out-of-bounds branch. + SIMD primops for unpacking SIMD vectors into an unboxed tuple of unboxed scalars also need to be floated inward, but unpacks have a single non-DEFAULT alternative that binds the elements of the tuple. We now therefore also support @@ -431,12 +455,11 @@ floating in cases with a single alternative that may bind values. But there are wrinkles * Which unlifted cases do we float? - See Note [PrimOp can_fail and has_side_effects] in GHC.Builtin.PrimOps which - explains: - - We can float in can_fail primops (which concerns imprecise exceptions), - but we can't float them out. - - But we can float a has_side_effects primop, but NOT inside a lambda, - so for now we don't float them at all. Hence exprOkForSideEffects. + See Note [Transformations affected by primop effects] in GHC.Builtin.PrimOps + which explains: + - We can float in or discard CanFail primops, but we can't float them out. + - We don't want to discard a synchronous exception or side effect + so we don't float those at all. Hence exprOkToDiscard. - Throwing precise exceptions is a special case of the previous point: We may /never/ float in a call to (something that ultimately calls) 'raiseIO#'. @@ -448,7 +471,7 @@ But there are wrinkles ===> f (case a /# b of r -> F# r) because that creates a new thunk that wasn't there before. And - because it can't be floated out (can_fail), the thunk will stay + because it can't be floated out (CanFail), the thunk will stay there. Disaster! (This happened in nofib 'simple' and 'scs'.) Solution: only float cases into the branches of other cases, and @@ -477,7 +500,7 @@ bindings are: fiExpr platform to_drop (_, AnnCase scrut case_bndr _ [AnnAlt con alt_bndrs rhs]) | isUnliftedType (idType case_bndr) -- binders have a fixed RuntimeRep so it's OK to call isUnliftedType - , exprOkForSideEffects (deAnnotate scrut) + , exprOkToDiscard (deAnnotate scrut) -- See Note [Floating primops] = wrapFloats shared_binds $ fiExpr platform (case_float : rhs_binds) rhs ===================================== compiler/GHC/Core/Opt/SetLevels.hs ===================================== @@ -15,7 +15,7 @@ outwards (@FloatOut@). 2. We also let-ify many expressions (notably case scrutinees), so they - will have a fighting chance of being floated sensible. + will have a fighting chance of being floated sensibly. 3. Note [Need for cloning during float-out] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3016,11 +3016,10 @@ rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont -- a) it binds nothing (so it's really just a 'seq') -- b) evaluating the scrutinee has no side effects | is_plain_seq - , exprOkForSideEffects scrut + , exprOkToDiscard scrut -- The entire case is dead, so we can drop it -- if the scrutinee converges without having imperative -- side effects or raising a Haskell exception - -- See Note [PrimOp can_fail and has_side_effects] in GHC.Builtin.PrimOps = simplExprF env rhs cont -- 2b. Turn the case into a let, if ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Core.Utils ( exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun, - exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprOkForSpecEval, + exprIsHNF, exprOkForSpeculation, exprOkToDiscard, exprOkForSpecEval, exprIsWorkFree, exprIsConLike, isCheapApp, isExpandableApp, isSaturatedConApp, exprIsTickedString, exprIsTickedString_maybe, @@ -1381,6 +1381,7 @@ isWorkFreeApp fn n_val_args | otherwise = case idDetails fn of DataConWorkId {} -> True + PrimOpId op _ -> primOpIsWorkFree op _ -> False isCheapApp :: CheapAppFun @@ -1488,34 +1489,45 @@ it's applied only to dictionaries. -} ----------------------------- --- | 'exprOkForSpeculation' returns True of an expression that is: +-- | To a first approximation, 'exprOkForSpeculation' returns True of +-- an expression that is: -- -- * Safe to evaluate even if normal order eval might not --- evaluate the expression at all, or +-- evaluate the expression at all, and -- -- * Safe /not/ to evaluate even if normal order would do so -- --- It is usually called on arguments of unlifted type, but not always --- In particular, Simplify.rebuildCase calls it on lifted types --- when a 'case' is a plain 'seq'. See the example in --- Note [exprOkForSpeculation: case expressions] below +-- More specifically, this means that: +-- * A: Evaluation of the expression reaches weak-head-normal-form, +-- * B: soon, +-- * C: without causing a write side effect (e.g. writing a mutable variable). -- --- Precisely, it returns @True@ iff: --- a) The expression guarantees to terminate, --- b) soon, --- c) without causing a write side effect (e.g. writing a mutable variable) --- d) without throwing a Haskell exception --- e) without risking an unchecked runtime exception (array out of bounds, --- divide by zero) +-- In particular, an expression that may +-- * throw a synchronous Haskell exception, or +-- * risk an unchecked runtime exception (e.g. array +-- out of bounds, divide by zero) +-- is /not/ considered OK-for-speculation, as these violate condition A. -- --- For @exprOkForSideEffects@ the list is the same, but omitting (e). +-- For 'exprOkToDiscard', condition A is weakened to allow expressions +-- that might risk an unchecked runtime exception but must otherwise +-- reach weak-head-normal-form. +-- (Note that 'exprOkForSpeculation' implies 'exprOkToDiscard') -- --- Note that --- exprIsHNF implies exprOkForSpeculation --- exprOkForSpeculation implies exprOkForSideEffects +-- But in fact both functions are a bit more conservative than the above, +-- in at least the following ways: +-- +-- * W1: We do not take advantage of already-evaluated lifted variables. +-- As a result, 'exprIsHNF' DOES NOT imply 'exprOkForSpeculation'; +-- if @y@ is a case-binder of lifted type, then @exprIsHNF y@ is +-- 'True', while @exprOkForSpeculation y@ is 'False'. +-- See Note [exprOkForSpeculation and evaluated variables] for why. +-- * W2: Read-effects on mutable variables are currently also included. +-- See Note [Classifying primop effects] "GHC.Builtin.PrimOps". +-- * W3: Currently, 'exprOkForSpeculation' always returns 'False' for +-- let-expressions. Lets can be stacked deeply, so we just give up. +-- In any case, the argument of 'exprOkForSpeculation' is usually in +-- a strict context, so any lets will have been floated away. -- --- See Note [PrimOp can_fail and has_side_effects] in "GHC.Builtin.PrimOps" --- and Note [Transformations affected by can_fail and has_side_effects] -- -- As an example of the considerations in this test, consider: -- @@ -1529,12 +1541,24 @@ it's applied only to dictionaries. -- > in E -- > } -- --- We can only do this if the @y + 1@ is ok for speculation: it has no +-- We can only do this if the @y# +# 1#@ is ok for speculation: it has no -- side effects, and can't diverge or raise an exception. +-- +-- +-- See also Note [Classifying primop effects] in "GHC.Builtin.PrimOps" +-- and Note [Transformations affected by primop effects]. +-- +-- 'exprOkForSpeculation' is used to define Core's let-can-float +-- invariant. (See Note [Core let-can-float invariant] in +-- "GHC.Core".) It is therefore frequently called on arguments of +-- unlifted type, especially via 'needsCaseBinding'. But it is +-- sometimes called on expressions of lifted type as well. For +-- example, see Note [Speculative evaluation] in "GHC.CoreToStg.Prep". + -exprOkForSpeculation, exprOkForSideEffects :: CoreExpr -> Bool +exprOkForSpeculation, exprOkToDiscard :: CoreExpr -> Bool exprOkForSpeculation = expr_ok fun_always_ok primOpOkForSpeculation -exprOkForSideEffects = expr_ok fun_always_ok primOpOkForSideEffects +exprOkToDiscard = expr_ok fun_always_ok primOpOkToDiscard fun_always_ok :: Id -> Bool fun_always_ok _ = True @@ -1564,10 +1588,7 @@ expr_ok fun_ok primop_ok (Tick tickish e) | otherwise = expr_ok fun_ok primop_ok e expr_ok _ _ (Let {}) = False - -- Lets can be stacked deeply, so just give up. - -- In any case, the argument of exprOkForSpeculation is - -- usually in a strict context, so any lets will have been - -- floated away. +-- See W3 in the Haddock comment for exprOkForSpeculation expr_ok fun_ok primop_ok (Case scrut bndr _ alts) = -- See Note [exprOkForSpeculation: case expressions] @@ -1599,16 +1620,24 @@ app_ok :: (Id -> Bool) -> (PrimOp -> Bool) -> Id -> [CoreExpr] -> Bool app_ok fun_ok primop_ok fun args | not (fun_ok fun) = False -- This code path is only taken for Note [Speculative evaluation] + + | idArity fun > n_val_args + -- Partial application: just check passing the arguments is OK + = args_ok + | otherwise = case idDetails fun of - DFunId new_type -> not new_type + DFunId new_type -> not new_type -- DFuns terminate, unless the dict is implemented -- with a newtype in which case they may not - DataConWorkId {} -> True + DataConWorkId {} -> args_ok -- The strictness of the constructor has already -- been expressed by its "wrapper", so we don't need -- to take the arguments into account + -- Well, we thought so. But it's definitely wrong! + -- See #20749 and Note [How untagged pointers can + -- end up in strict fields] in GHC.Stg.InferTags ClassOpId _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] @@ -1630,16 +1659,7 @@ app_ok fun_ok primop_ok fun args -- Often there is a literal divisor, and this -- can get rid of a thunk in an inner loop - | SeqOp <- op -- See Note [exprOkForSpeculation and SeqOp/DataToTagOp] - -> False -- for the special cases for SeqOp and DataToTagOp - | DataToTagOp <- op - -> False - | KeepAliveOp <- op - -> False - - | otherwise - -> primop_ok op -- Check the primop itself - && and (zipWith arg_ok arg_tys args) -- Check the arguments + | otherwise -> primop_ok op && args_ok _other -- Unlifted and terminating types; -- Also c.f. the Var case of exprIsHNF @@ -1652,10 +1672,6 @@ app_ok fun_ok primop_ok fun args -- (If we added unlifted function types this would change, -- and we'd need to actually test n_val_args == 0.) - -- Partial applications - | idArity fun > n_val_args -> - and (zipWith arg_ok arg_tys args) -- Check the arguments - -- Functions that terminate fast without raising exceptions etc -- See Note [Discarding unnecessary unsafeEqualityProofs] | fun `hasKey` unsafeEqualityProofIdKey -> True @@ -1669,12 +1685,14 @@ app_ok fun_ok primop_ok fun args n_val_args = valArgCount args (arg_tys, _) = splitPiTys fun_ty - -- Used for arguments to primops and to partial applications + -- Even if a function call itself is OK, any unlifted + -- args are still evaluated eagerly and must be checked + args_ok = and (zipWith arg_ok arg_tys args) arg_ok :: PiTyVarBinder -> CoreExpr -> Bool arg_ok (Named _) _ = True -- A type argument arg_ok (Anon ty _) arg -- A term argument | definitelyLiftedType (scaledThing ty) - = True -- See Note [Primops with lifted arguments] + = True -- lifted args are not evaluated eagerly | otherwise = expr_ok fun_ok primop_ok arg @@ -1821,46 +1839,16 @@ points do the job nicely. ------- End of historical note ------------ -Note [Primops with lifted arguments] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Is this ok-for-speculation (see #13027)? - reallyUnsafePtrEquality# a b -Well, yes. The primop accepts lifted arguments and does not -evaluate them. Indeed, in general primops are, well, primitive -and do not perform evaluation. - -Bottom line: - * In exprOkForSpeculation we simply ignore all lifted arguments. - * In the rare case of primops that /do/ evaluate their arguments, - (namely DataToTagOp and SeqOp) return False; see - Note [exprOkForSpeculation and evaluated variables] - -Note [exprOkForSpeculation and SeqOp/DataToTagOp] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Most primops with lifted arguments don't evaluate them -(see Note [Primops with lifted arguments]), so we can ignore -that argument entirely when doing exprOkForSpeculation. - -But DataToTagOp and SeqOp are exceptions to that rule. -For reasons described in Note [exprOkForSpeculation and -evaluated variables], we simply return False for them. - -Not doing this made #5129 go bad. -Lots of discussion in #15696. - Note [exprOkForSpeculation and evaluated variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Recall that - seq# :: forall a s. a -> State# s -> (# State# s, a #) - dataToTag# :: forall a. a -> Int# -must always evaluate their first argument. - -Now consider these examples: +Consider these examples: * case x of y { DEFAULT -> ....y.... } Should 'y' (alone) be considered ok-for-speculation? * case x of y { DEFAULT -> ....let z = dataToTag# y... } - Should (dataToTag# y) be considered ok-for-spec? + Should (dataToTag# y) be considered ok-for-spec? Recall that + dataToTag# :: forall a. a -> Int# + must always evaluate its argument. (See also Note [dataToTag# magic].) You could argue 'yes', because in the case alternative we know that 'y' is evaluated. But the binder-swap transformation, which is @@ -1874,13 +1862,16 @@ and then it really, really doesn't obey the let-can-float invariant. The solution is simple: exprOkForSpeculation does not try to take advantage of the evaluated-ness of (lifted) variables. And it returns -False (always) for DataToTagOp and SeqOp. +False (always) for primops that perform evaluation. We achieve the latter +by marking the relevant primops as "ThrowsException" or +"ReadWriteEffect"; see also Note [Classifying primop effects] in +GHC.Builtin.PrimOps. Note that exprIsHNF /can/ and does take advantage of evaluated-ness; it doesn't have the trickiness of the let-can-float invariant to worry about. Note [Discarding unnecessary unsafeEqualityProofs] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In #20143 we found case unsafeEqualityProof @t1 @t2 of UnsafeRefl cv[dead] -> blah where 'blah' didn't mention 'cv'. We'd like to discard this @@ -1889,7 +1880,7 @@ To do this we need to know (a) that cv is unused (done by OccAnal), and (b) that unsafeEqualityProof terminates rapidly without side effects. -At the moment we check that explicitly here in exprOkForSideEffects, +At the moment we check that explicitly here in exprOkToDiscard, but one might imagine a more systematic check in future. @@ -1904,15 +1895,15 @@ but one might imagine a more systematic check in future. -- ~~~~~~~~~~~~~~~~ -- | exprIsHNF returns true for expressions that are certainly /already/ -- evaluated to /head/ normal form. This is used to decide whether it's ok --- to change: +-- to perform case-to-let for lifted expressions, which changes: -- --- > case x of _ -> e +-- > case x of x' { _ -> e } -- -- into: -- --- > e +-- > let x' = x in e -- --- and to decide whether it's safe to discard a 'seq'. +-- and in so doing makes the binding lazy. -- -- So, it does /not/ treat variables as evaluated, unless they say they are. -- However, it /does/ treat partial applications and constructor applications ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -1427,7 +1427,7 @@ see Note [Data-con worker strictness]. -- -- [n] nontermination (e.g. loops) -- [i] throws imprecise exception --- [p] throws precise exceTtion +-- [p] throws precise exception -- [c] converges (reduces to WHNF). -- -- The different lattice elements correspond to different subsets, indicated by ===================================== compiler/Setup.hs ===================================== @@ -38,12 +38,13 @@ primopIncls = [ ("primop-data-decl.hs-incl" , "--data-decl") , ("primop-tag.hs-incl" , "--primop-tag") , ("primop-list.hs-incl" , "--primop-list") - , ("primop-has-side-effects.hs-incl" , "--has-side-effects") + , ("primop-effects.hs-incl" , "--primop-effects") , ("primop-out-of-line.hs-incl" , "--out-of-line") , ("primop-commutable.hs-incl" , "--commutable") , ("primop-code-size.hs-incl" , "--code-size") - , ("primop-can-fail.hs-incl" , "--can-fail") , ("primop-strictness.hs-incl" , "--strictness") + , ("primop-is-work-free.hs-incl" , "--is-work-free") + , ("primop-is-cheap.hs-incl" , "--is-cheap") , ("primop-fixity.hs-incl" , "--fixity") , ("primop-primop-info.hs-incl" , "--primop-primop-info") , ("primop-vector-uniques.hs-incl" , "--primop-vector-uniques") ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -82,16 +82,17 @@ compilerDependencies = do stage <- getStage ghcPath <- expr $ buildPath (vanillaContext stage compiler) pure $ (ghcPath -/-) <$> - [ "primop-can-fail.hs-incl" - , "primop-code-size.hs-incl" + [ "primop-code-size.hs-incl" , "primop-commutable.hs-incl" , "primop-data-decl.hs-incl" , "primop-fixity.hs-incl" - , "primop-has-side-effects.hs-incl" + , "primop-effects.hs-incl" , "primop-list.hs-incl" , "primop-out-of-line.hs-incl" , "primop-primop-info.hs-incl" , "primop-strictness.hs-incl" + , "primop-is-work-free.hs-incl" + , "primop-is-cheap.hs-incl" , "primop-tag.hs-incl" , "primop-vector-tycons.hs-incl" , "primop-vector-tys-exports.hs-incl" ===================================== hadrian/src/Rules/Lint.hs ===================================== @@ -98,11 +98,12 @@ hsIncls path = [ path "primop-vector-tycons.hs-incl" , path "primop-tag.hs-incl" , path "primop-list.hs-incl" , path "primop-strictness.hs-incl" + , path "primop-is-work-free.hs-incl" + , path "primop-is-cheap.hs-incl" , path "primop-fixity.hs-incl" , path "primop-docs.hs-incl" , path "primop-primop-info.hs-incl" , path "primop-out-of-line.hs-incl" - , path "primop-has-side-effects.hs-incl" - , path "primop-can-fail.hs-incl" + , path "primop-effects.hs-incl" , path "primop-commutable.hs-incl" ] ===================================== hadrian/src/Settings/Builders/GenPrimopCode.hs ===================================== @@ -9,12 +9,13 @@ genPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat , output "//primop-data-decl.hs-incl" ? arg "--data-decl" , output "//primop-tag.hs-incl" ? arg "--primop-tag" , output "//primop-list.hs-incl" ? arg "--primop-list" - , output "//primop-has-side-effects.hs-incl" ? arg "--has-side-effects" + , output "//primop-effects.hs-incl" ? arg "--primop-effects" , output "//primop-out-of-line.hs-incl" ? arg "--out-of-line" , output "//primop-commutable.hs-incl" ? arg "--commutable" , output "//primop-code-size.hs-incl" ? arg "--code-size" - , output "//primop-can-fail.hs-incl" ? arg "--can-fail" , output "//primop-strictness.hs-incl" ? arg "--strictness" + , output "//primop-is-work-free.hs-incl" ? arg "--is-work-free" + , output "//primop-is-cheap.hs-incl" ? arg "--is-cheap" , output "//primop-fixity.hs-incl" ? arg "--fixity" , output "//primop-primop-info.hs-incl" ? arg "--primop-primop-info" , output "//primop-vector-uniques.hs-incl" ? arg "--primop-vector-uniques" ===================================== libraries/base/GHC/Clock.hsc ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -9,17 +10,36 @@ module GHC.Clock import GHC.Base import GHC.Real import Data.Word +#if defined(javascript_HOST_ARCH) +import GHC.Num +#endif -- | Return monotonic time in seconds, since some unspecified starting point -- -- @since 4.11.0.0 getMonotonicTime :: IO Double -getMonotonicTime = do w <- getMonotonicTimeNSec - return (fromIntegral w / 1000000000) +getMonotonicTime = do +#if defined(javascript_HOST_ARCH) + w <- getMonotonicTimeMSec + return (w / 1000) +#else + w <- getMonotonicTimeNSec + return (fromIntegral w / 1000000000) +#endif -- | Return monotonic time in nanoseconds, since some unspecified starting point -- -- @since 4.11.0.0 +#if defined(javascript_HOST_ARCH) +getMonotonicTimeNSec :: IO Word64 +getMonotonicTimeNSec = do + w <- getMonotonicTimeMSec + return (floor w * 1000000) + +foreign import javascript unsafe "performance.now" getMonotonicTimeMSec:: IO Double + + +#else foreign import ccall unsafe "getMonotonicNSec" getMonotonicTimeNSec :: IO Word64 - +#endif ===================================== libraries/base/GHC/Conc/POSIX.hs ===================================== @@ -49,6 +49,7 @@ module GHC.Conc.POSIX import Data.Bits (shiftR) import GHC.Base +import GHC.Clock import GHC.Conc.Sync import GHC.Conc.POSIX.Const import GHC.Event.Windows.ConsoleEvent @@ -209,13 +210,9 @@ delayTime (Delay t _) = t delayTime (DelaySTM t _) = t type USecs = Word64 -type NSecs = Word64 - -foreign import ccall unsafe "getMonotonicNSec" - getMonotonicNSec :: IO NSecs getMonotonicUSec :: IO USecs -getMonotonicUSec = fmap (`div` 1000) getMonotonicNSec +getMonotonicUSec = fmap (`div` 1000) getMonotonicTimeNSec {-# NOINLINE prodding #-} prodding :: IORef Bool ===================================== libraries/base/GHC/IO/Exception.hs ===================================== @@ -329,13 +329,16 @@ type IOError = IOException -- flagged. data IOException = IOError { - ioe_handle :: Maybe Handle, -- the handle used by the action flagging - -- the error. - ioe_type :: IOErrorType, -- what it was. - ioe_location :: String, -- location. - ioe_description :: String, -- error type specific information. - ioe_errno :: Maybe CInt, -- errno leading to this error, if any. - ioe_filename :: Maybe FilePath -- filename the error is related to. + ioe_handle :: Maybe Handle, -- ^ the handle used by the action flagging + -- the error. + ioe_type :: IOErrorType, -- ^ what it was. + ioe_location :: String, -- ^ location. + ioe_description :: String, -- ^ error type specific information. + ioe_errno :: Maybe CInt, -- ^ errno leading to this error, if any. + ioe_filename :: Maybe FilePath -- ^ filename the error is related to + -- (some libraries may assume different encodings + -- when constructing this field from e.g. 'ByteString' + -- or other types) } -- | @since 4.1.0.0 ===================================== libraries/base/Unsafe/Coerce.hs ===================================== @@ -78,9 +78,11 @@ floating. But what stops the whole (case unsafeEqualityProof of ...) from floating? Answer: we never float a case on a redex that can fail outside a conditional. See Primop.hs, -Note [Transformations affected by can_fail and has_side_effects]. +Note [Transformations affected by primop effects]. And unsafeEqualityProof (being opaque) is definitely treated as can-fail. + (Huh? It seems we have a special-case in exprOkForSpeculation (app_ok) + /specifically/ allowing unsafeEqualityProof. Something smells wrong.) While unsafeCoerce is a perfectly ordinary function that needs no special treatment, Unsafe.Coerce.unsafeEqualityProof is magical, in ===================================== libraries/base/tests/T23687.hs ===================================== @@ -0,0 +1,14 @@ +module Main where + +import GHC.Clock +import Control.Monad + +main :: IO () +main = do + a <- getMonotonicTimeNSec + b <- getMonotonicTimeNSec + when (a > b) $ putStrLn "Non-monotonic time" + + c <- getMonotonicTime + d <- getMonotonicTime + when (c > d) $ putStrLn "Non-monotonic time" ===================================== libraries/base/tests/all.T ===================================== @@ -310,3 +310,4 @@ test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) test('T23454', normal, compile_fail, ['']) +test('T23687', normal, compile_and_run, ['']) ===================================== testsuite/tests/ghc-api/PrimOpEffect_Sanity.hs ===================================== @@ -0,0 +1,17 @@ +import GHC.Builtin.PrimOps +import GHC.Utils.Outputable + +main :: IO () +main = let + errs = do + op <- allThePrimOps + case primOpEffect op of + NoEffect -> [] + CanFail -> [] + ThrowsException -> [] + ReadWriteEffect + -> [ppr op <+> text "has ReadWriteEffect but is work-free" + | primOpIsWorkFree op] + ++ [ppr op <+> text "has ReadWriteEffect but is cheap" + | primOpIsCheap op] + in putStrLn $ showSDocUnsafe (vcat errs) ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -37,3 +37,4 @@ test('T19156', [ extra_run_opts('"' + config.libdir + '"') test('T20757', [unless(opsys('mingw32'), skip), exit_code(1)], compile_and_run, ['-package ghc']) +test('PrimOpEffect_Sanity', normal, compile_and_run, ['-Wall -Werror -package ghc']) ===================================== utils/genprimopcode/AccessOps.hs ===================================== @@ -83,7 +83,7 @@ mkIndexByteArrayOp e = PrimOpSpec (elt_rep_ty e) , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." - , opts = [OptionTrue "can_fail"] + , opts = [OptionEffect CanFail] } mkUnalignedIndexByteArrayOp :: ElementType -> Entry @@ -95,7 +95,7 @@ mkUnalignedIndexByteArrayOp e = PrimOpSpec (elt_rep_ty e) , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in bytes." - , opts = [OptionTrue "can_fail"] + , opts = [OptionEffect CanFail] } mkReadByteArrayOp :: ElementType -> Entry @@ -107,7 +107,7 @@ mkReadByteArrayOp e = PrimOpSpec $ readResTy e , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } mkUnalignedReadByteArrayOp :: ElementType -> Entry @@ -119,7 +119,7 @@ mkUnalignedReadByteArrayOp e = PrimOpSpec $ readResTy e , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in bytes." - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } mkWriteByteArrayOp :: ElementType -> Entry @@ -131,7 +131,7 @@ mkWriteByteArrayOp e = PrimOpSpec $ writeResTy e , cat = GenPrimOp , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "." - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } mkUnalignedWriteByteArrayOp :: ElementType -> Entry @@ -143,7 +143,7 @@ mkUnalignedWriteByteArrayOp e = PrimOpSpec $ writeResTy e , cat = GenPrimOp , desc = "Write " ++ elt_desc e ++ "; offset in bytes." - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } @@ -168,7 +168,7 @@ mkIndexOffAddrOp e = PrimOpSpec , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" ++ getAlignWarn e - , opts = [OptionTrue "can_fail"] + , opts = [OptionEffect CanFail] } {- @@ -181,7 +181,7 @@ mkUnalignedIndexOffAddrOp e = PrimOpSpec (elt_rep_ty e) , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in bytes." - , opts = [OptionTrue "can_fail"] + , opts = [OptionEffect CanFail] } -} @@ -195,7 +195,7 @@ mkReadOffAddrOp e = PrimOpSpec , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" ++ getAlignWarn e - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } {- @@ -208,7 +208,7 @@ mkUnalignedReadOffAddrOp e = PrimOpSpec $ readResTy e , cat = GenPrimOp , desc = "Read " ++ elt_desc e ++ "; offset in bytes." - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } -} @@ -222,7 +222,7 @@ mkWriteOffAddrOp e = PrimOpSpec , cat = GenPrimOp , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n" ++ getAlignWarn e - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } {- @@ -235,7 +235,7 @@ mkUnalignedWriteOffAddrOp e = PrimOpSpec $ writeResTy e , cat = GenPrimOp , desc = "Write " ++ elt_desc e ++ "; offset in bytes." - , opts = [OptionTrue "can_fail", OptionTrue "has_side_effects"] + , opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail] } -} ===================================== utils/genprimopcode/Lexer.x ===================================== @@ -51,6 +51,15 @@ words :- <0> "infixl" { mkT TInfixL } <0> "infixr" { mkT TInfixR } <0> "Nothing" { mkT TNothing } + <0> "effect" { mkT TEffect } + <0> "NoEffect" { mkT TNoEffect } + <0> "CanFail" { mkT TCanFail } + <0> "ThrowsException" { mkT TThrowsException } + <0> "ReadWriteEffect" { mkT TReadWriteEffect } + <0> "can_fail_warning" { mkT TCanFailWarnFlag } + <0> "DoNotWarnCanFail" { mkT TDoNotWarnCanFail } + <0> "WarnIfEffectIsCanFail" { mkT TWarnIfEffectIsCanFail } + <0> "YesWarnCanFail" { mkT TYesWarnCanFail } <0> "vector" { mkT TVector } <0> "bytearray_access_ops" { mkT TByteArrayAccessOps } <0> "addr_access_ops" { mkT TAddrAccessOps } ===================================== utils/genprimopcode/Main.hs ===================================== @@ -126,11 +126,6 @@ main = getArgs >>= \args -> "--data-decl" -> putStr (gen_data_decl p_o_specs) - "--has-side-effects" - -> putStr (gen_switch_from_attribs - "has_side_effects" - "primOpHasSideEffects" p_o_specs) - "--out-of-line" -> putStr (gen_switch_from_attribs "out_of_line" @@ -146,10 +141,15 @@ main = getArgs >>= \args -> "code_size" "primOpCodeSize" p_o_specs) - "--can-fail" + "--is-work-free" + -> putStr (gen_switch_from_attribs + "work_free" + "primOpIsWorkFree" p_o_specs) + + "--is-cheap" -> putStr (gen_switch_from_attribs - "can_fail" - "primOpCanFail" p_o_specs) + "cheap" + "primOpIsCheap" p_o_specs) "--strictness" -> putStr (gen_switch_from_attribs @@ -161,6 +161,11 @@ main = getArgs >>= \args -> "fixity" "primOpFixity" p_o_specs) + "--primop-effects" + -> putStr (gen_switch_from_attribs + "effect" + "primOpEffect" p_o_specs) + "--primop-primop-info" -> putStr (gen_primop_info p_o_specs) @@ -197,13 +202,14 @@ main = getArgs >>= \args -> known_args :: [String] known_args = [ "--data-decl", - "--has-side-effects", "--out-of-line", "--commutable", "--code-size", - "--can-fail", + "--is-work-free", + "--is-cheap", "--strictness", "--fixity", + "--primop-effects", "--primop-primop-info", "--primop-tag", "--primop-list", @@ -287,7 +293,9 @@ gen_hs_source (Info defaults entries) = opt (OptionString n v) = n ++ " = { " ++ v ++ "}" opt (OptionInteger n v) = n ++ " = " ++ show v opt (OptionVector _) = "" - opt (OptionFixity mf) = "fixity" ++ " = " ++ show mf + opt (OptionFixity mf) = "fixity = " ++ show mf + opt (OptionEffect eff) = "effect = " ++ show eff + opt (OptionCanFailWarnFlag wf) = "can_fail_warning = " ++ show wf hdr s@(Section {}) = sec s hdr (PrimOpSpec { name = n }) = wrapOp n ++ "," @@ -341,7 +349,10 @@ gen_hs_source (Info defaults entries) = can_fail options = [ "can fail with an unchecked exception" - | Just (OptionTrue _) <- [lookup_attrib "can_fail" options] ] + | Just (OptionEffect eff) <- [lookup_attrib "effect" options] + , Just (OptionCanFailWarnFlag wflag) <- [lookup_attrib "can_fail_warning" options] + , wflag /= DoNotWarnCanFail + , wflag == YesWarnCanFail || eff == CanFail ] prim_deprecated options n = [ "{-# DEPRECATED " ++ wrapOp n ++ " \"" ++ msg ++ "\" #-}" @@ -608,6 +619,8 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries) getAltRhs (OptionString _ s) = s getAltRhs (OptionVector _) = "True" getAltRhs (OptionFixity mf) = show mf + getAltRhs (OptionEffect eff) = show eff + getAltRhs (OptionCanFailWarnFlag wf) = show wf mkAlt po = case lookup_attrib attrib_name (opts po) of @@ -621,13 +634,13 @@ gen_switch_from_attribs attrib_name fn_name (Info defaults entries) Nothing -> error ("gen_switch_from: " ++ attrib_name) Just xx -> unlines alternatives - ++ fn_name ++ " _ = " ++ getAltRhs xx ++ "\n" + ++ fn_name ++ " _thisOp = " ++ getAltRhs xx ++ "\n" {- Note [GHC.Prim Docs] ~~~~~~~~~~~~~~~~~~~~ For haddocks of GHC.Prim we generate a dummy haskell file (gen_hs_source) that -contains the type signatures and the commends (but no implementations) +contains the type signatures and the comments (but no implementations) specifically for consumption by haddock. GHCi's :doc command reads directly from ModIface's though, and GHC.Prim has a ===================================== utils/genprimopcode/Parser.y ===================================== @@ -45,6 +45,15 @@ import AccessOps infixl { TInfixL } infixr { TInfixR } nothing { TNothing } + effect { TEffect } + NoEffect { TNoEffect } + CanFail { TCanFail } + ThrowsException { TThrowsException } + ReadWriteEffect { TReadWriteEffect } + can_fail_warning { TCanFailWarnFlag } + DoNotWarnCanFail { TDoNotWarnCanFail } + WarnIfEffectIsCanFail { TWarnIfEffectIsCanFail } + YesWarnCanFail { TYesWarnCanFail } vector { TVector } SCALAR { TSCALAR } VECTOR { TVECTOR } @@ -77,6 +86,8 @@ pOption : lowerName '=' false { OptionFalse $1 } | lowerName '=' integer { OptionInteger $1 $3 } | vector '=' pVectorTemplate { OptionVector $3 } | fixity '=' pInfix { OptionFixity $3 } + | effect '=' pEffect { OptionEffect $3 } + | can_fail_warning '=' pPrimOpCanFailWarnFlag { OptionCanFailWarnFlag $3 } pInfix :: { Maybe Fixity } pInfix : infix integer { Just $ Fixity NoSourceText $2 InfixN } @@ -84,6 +95,16 @@ pInfix : infix integer { Just $ Fixity NoSourceText $2 InfixN } | infixr integer { Just $ Fixity NoSourceText $2 InfixR } | nothing { Nothing } +pEffect :: { PrimOpEffect } +pEffect : NoEffect { NoEffect } + | CanFail { CanFail } + | ThrowsException { ThrowsException } + | ReadWriteEffect { ReadWriteEffect } + +pPrimOpCanFailWarnFlag :: { PrimOpCanFailWarnFlag } +pPrimOpCanFailWarnFlag : DoNotWarnCanFail { DoNotWarnCanFail } + | WarnIfEffectIsCanFail { WarnIfEffectIsCanFail } + | YesWarnCanFail { YesWarnCanFail } pEntries :: { [Entry] } pEntries : pEntry pEntries { $1 : $2 } ===================================== utils/genprimopcode/ParserM.hs ===================================== @@ -111,6 +111,15 @@ data Token = TEOF | TInfixL | TInfixR | TNothing + | TEffect + | TNoEffect + | TCanFail + | TThrowsException + | TReadWriteEffect + | TCanFailWarnFlag + | TDoNotWarnCanFail + | TWarnIfEffectIsCanFail + | TYesWarnCanFail | TVector | TSCALAR | TVECTOR ===================================== utils/genprimopcode/Syntax.hs ===================================== @@ -61,6 +61,8 @@ data Option | OptionInteger String Int -- name = | OptionVector [(String,String,Int)] -- name = [(,...),...] | OptionFixity (Maybe Fixity) -- fixity = infix{,l,r} | Nothing + | OptionEffect PrimOpEffect -- effect = NoEffect | DoNotSpeculate | CanFail | ThrowsException | ReadWriteEffect | FallibleReadWriteEffect + | OptionCanFailWarnFlag PrimOpCanFailWarnFlag -- can_fail_warning = DoNotWarnCanFail | WarnIfEffectIsCanFail | YesWarnCanFail deriving Show -- categorises primops @@ -109,6 +111,19 @@ data SourceText = SourceText String | NoSourceText deriving (Eq,Show) +data PrimOpEffect + = NoEffect + | CanFail + | ThrowsException + | ReadWriteEffect + deriving (Eq, Show) + +data PrimOpCanFailWarnFlag + = DoNotWarnCanFail + | WarnIfEffectIsCanFail + | YesWarnCanFail + deriving (Eq, Show) + ------------------------------------------------------------------ -- Sanity checking ----------------------------------------------- ------------------------------------------------------------------ @@ -131,7 +146,7 @@ sanityTop :: Info -> () sanityTop (Info defs entries) = let opt_names = map get_attrib_name defs primops = filter is_primop entries - in + in if length opt_names /= length (nub opt_names) then error ("non-unique default attribute names: " ++ show opt_names ++ "\n") else myseqAll (map (sanityPrimOp opt_names) primops) () @@ -168,6 +183,8 @@ get_attrib_name (OptionString nm _) = nm get_attrib_name (OptionInteger nm _) = nm get_attrib_name (OptionVector _) = "vector" get_attrib_name (OptionFixity _) = "fixity" +get_attrib_name (OptionEffect _) = "effect" +get_attrib_name (OptionCanFailWarnFlag _) = "can_fail_warning" lookup_attrib :: String -> [Option] -> Maybe Option lookup_attrib _ [] = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/59c6d66624f1cafd8d6d80de6c7bfc8bf15ab46c...2810170db7d66e385adb9199c85a306a8bf1cf56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/59c6d66624f1cafd8d6d80de6c7bfc8bf15ab46c...2810170db7d66e385adb9199c85a306a8bf1cf56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 10:31:22 2023 From: gitlab at gitlab.haskell.org (Andreas Klebinger (@AndreasK)) Date: Mon, 31 Jul 2023 06:31:22 -0400 Subject: [Git][ghc/ghc][wip/andreask/reg-offset] Aarch ncg: Optimize immediate use for address calculations Message-ID: <64c78d7a44046_2f1200ba3d8102070@gitlab.mail> Andreas Klebinger pushed to branch wip/andreask/reg-offset at Glasgow Haskell Compiler / GHC Commits: bc41ea01 by Andreas Klebinger at 2023-07-31T12:31:09+02:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -462,6 +462,23 @@ getBitmaskImm n w where truncated = narrowU w n +-- | Load/store immediate. +-- Depends on the width of the store to some extent. +isOffsetImm :: Int -> Width -> Bool +isOffsetImm off w + -- 8 bits + sign for unscaled offsets + | -256 <= off, off <= 255 = True + -- Offset using 12-bit positive immediate, scaled by width + -- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4 + -- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8 + -- 16-bit: 0 .. 8188, 8-bit: 0 -- 4095 + | 0 <= off, off < 4096 * byte_width, off `mod` byte_width == 0 = True + | otherwise = False + where + byte_width = widthInBytes w + + + -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. @@ -711,18 +728,11 @@ getRegister' config plat expr -> return (Fixed (cmmTypeFormat (cmmRegType reg)) (getRegisterReg plat reg) nilOL) - CmmRegOff reg off | isNbitEncodeable 12 (fromIntegral off) -> do - getRegister' config plat $ - CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType reg) - - CmmRegOff reg off -> do - (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width) - (reg, _format, code) <- getSomeReg $ CmmReg reg - return $ Any (intFormat width) (\dst -> off_code `appOL` code `snocOL` ADD (OpReg width dst) (OpReg width reg) (OpReg width off_r)) - where width = typeWidth (cmmRegType reg) - - + CmmRegOff reg off -> + -- If we got here we will load the address into a register either way. So we might as well just expand + -- and re-use the existing code path to handle "reg + off". + let !width = cmmRegWidth reg + in getRegister' config plat (CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]) -- for MachOps, see GHC.Cmm.MachOp -- For CmmMachOp, see GHC.Cmm.Expr @@ -1253,20 +1263,8 @@ getAmode :: Platform -- OPTIMIZATION WARNING: Addressing modes. -- Addressing options: --- LDUR/STUR: imm9: -256 - 255 -getAmode platform _ (CmmRegOff reg off) | -256 <= off, off <= 255 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4 -getAmode platform W32 (CmmRegOff reg off) - | 0 <= off, off <= 16380, off `mod` 4 == 0 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8 -getAmode platform W64 (CmmRegOff reg off) - | 0 <= off, off <= 32760, off `mod` 8 == 0 +getAmode platform w (CmmRegOff reg off) + | isOffsetImm off w = return $ Amode (AddrRegImm reg' off') nilOL where reg' = getRegisterReg platform reg off' = ImmInt off @@ -1275,15 +1273,15 @@ getAmode platform W64 (CmmRegOff reg off) -- CmmStore (CmmMachOp (MO_Add w) [CmmLoad expr, CmmLit (CmmInt n w')]) (expr2) -- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ] -- for `n` in range. -getAmode _platform _ (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= off, off <= 255 +getAmode _platform w (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) + | isOffsetImm (fromIntegral off) w = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger off)) code -getAmode _platform _ (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= -off, -off <= 255 +getAmode _platform w (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) + | isOffsetImm (fromIntegral $ -off) w = do (reg, _format, code) <- getSomeReg expr - return $ Amode (AddrRegImm reg (ImmInteger (-off))) code + return $ Amode (AddrRegImm reg (ImmInteger $ -off)) code -- Generic case getAmode _platform _ expr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc41ea01a8044ae5cf83bcc9f80ed763ca8913a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc41ea01a8044ae5cf83bcc9f80ed763ca8913a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 13:20:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 31 Jul 2023 09:20:48 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: JS: implement getMonotonicTime (fix #23687) Message-ID: <64c7b5303659_2f1200ba3c41649ca@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: df82be2f by Sylvain Henry at 2023-07-31T09:19:57-04:00 JS: implement getMonotonicTime (fix #23687) - - - - - bf1b74eb by Matthew Pickering at 2023-07-31T09:19:58-04:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 93256469 by Bartłomiej Cieślar at 2023-07-31T09:20:04-04:00 Add cases to T23279: HasField for deprecated record fields This commit adds additional tests from ticket #23279 to ensure that we don't regress on reporting deprecated record fields in conjunction with HasField, either when using overloaded record dot syntax or directly through `getField`. Fixes #23279 - - - - - 3a523556 by Andreas Klebinger at 2023-07-31T09:20:04-04:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - db4314aa by Andreas Klebinger at 2023-07-31T09:20:05-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - 10 changed files: - .gitlab-ci.yml - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - hadrian/ghci-cabal.in - hadrian/src/Settings/Builders/Cabal.hs - libraries/base/GHC/Clock.hsc - libraries/base/GHC/Conc/POSIX.hs - + libraries/base/tests/T23687.hs - libraries/base/tests/all.T - testsuite/tests/overloadedrecflds/should_compile/T23279.hs - testsuite/tests/overloadedrecflds/should_compile/T23279.stderr Changes: ===================================== .gitlab-ci.yml ===================================== @@ -369,6 +369,9 @@ hadrian-ghc-in-ghci: - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - .gitlab/ci.sh configure + # Enable -Werror when building hadrian + - "echo 'package hadrian' > hadrian/cabal.project.local" + - "echo ' ghc-options: -Werror' >> hadrian/cabal.project.local" # Load ghc-in-ghci then immediately exit and check the modules loaded - echo ":q" | hadrian/ghci -j`mk/detect-cpu-count.sh`| tail -n2 | grep "Ok," after_script: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -462,6 +462,23 @@ getBitmaskImm n w where truncated = narrowU w n +-- | Load/store immediate. +-- Depends on the width of the store to some extent. +isOffsetImm :: Int -> Width -> Bool +isOffsetImm off w + -- 8 bits + sign for unscaled offsets + | -256 <= off, off <= 255 = True + -- Offset using 12-bit positive immediate, scaled by width + -- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4 + -- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8 + -- 16-bit: 0 .. 8188, 8-bit: 0 -- 4095 + | 0 <= off, off < 4096 * byte_width, off `mod` byte_width == 0 = True + | otherwise = False + where + byte_width = widthInBytes w + + + -- TODO OPT: we might be able give getRegister -- a hint, what kind of register we want. @@ -711,18 +728,11 @@ getRegister' config plat expr -> return (Fixed (cmmTypeFormat (cmmRegType reg)) (getRegisterReg plat reg) nilOL) - CmmRegOff reg off | isNbitEncodeable 12 (fromIntegral off) -> do - getRegister' config plat $ - CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] - where width = typeWidth (cmmRegType reg) - - CmmRegOff reg off -> do - (off_r, _off_format, off_code) <- getSomeReg $ CmmLit (CmmInt (fromIntegral off) width) - (reg, _format, code) <- getSomeReg $ CmmReg reg - return $ Any (intFormat width) (\dst -> off_code `appOL` code `snocOL` ADD (OpReg width dst) (OpReg width reg) (OpReg width off_r)) - where width = typeWidth (cmmRegType reg) - - + CmmRegOff reg off -> + -- If we got here we will load the address into a register either way. So we might as well just expand + -- and re-use the existing code path to handle "reg + off". + let !width = cmmRegWidth reg + in getRegister' config plat (CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]) -- for MachOps, see GHC.Cmm.MachOp -- For CmmMachOp, see GHC.Cmm.Expr @@ -794,33 +804,25 @@ getRegister' config plat expr -- 0. TODO This should not exist! Rewrite: Reg +- 0 -> Reg CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' - -- 1. Compute Reg +/- n directly. - -- For Add/Sub we can directly encode 12bits, or 12bits lsl #12. - CmmMachOp (MO_Add w) [(CmmReg reg), CmmLit (CmmInt n _)] - | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ADD (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) - -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12. - where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) - r' = getRegisterReg plat reg - CmmMachOp (MO_Sub w) [(CmmReg reg), CmmLit (CmmInt n _)] - | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (SUB (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) - -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12. - where w' = formatToWidth (cmmTypeFormat (cmmRegType reg)) - r' = getRegisterReg plat reg + -- Immediates are handled via `getArithImm` in the generic code path. CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` + (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` + (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) -- 2. Shifts. x << n, x >> n. - CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do + CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] + | w == W32 || w == W64 + , 0 <= n, n < fromIntegral (widthInBits w) -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) @@ -830,7 +832,8 @@ getRegister' config plat expr CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -838,24 +841,23 @@ getRegister' config plat expr CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do + CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] + | w == W32 || w == W64 + , 0 <= n, n < fromIntegral (widthInBits w) -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) CmmMachOp (MO_U_Shr w) [x, y] | w == W8 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` + (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -863,13 +865,12 @@ getRegister' config plat expr CmmMachOp (MO_U_Shr w) [x, y] | w == W16 -> do (reg_x, _format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) + `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do + CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] + | w == W32 || w == W64 + , 0 <= n, n < fromIntegral (widthInBits w) -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) @@ -915,8 +916,8 @@ getRegister' config plat expr -- sign-extend both arguments to 32-bits. -- See Note [Signed arithmetic on AArch64]. intOpImm :: Bool -> Width -> (Operand -> Operand -> Operand -> OrdList Instr) -> (Integer -> Width -> Maybe Operand) -> NatM (Register) - intOpImm {- is signed -} True w op _encode_imm = intOp True w op - intOpImm False w op encode_imm = do + intOpImm {- is signed -} True w op _encode_imm = intOp True w op + intOpImm False w op encode_imm = do -- compute x <- x -- compute x <- y -- x, x, x @@ -1253,20 +1254,8 @@ getAmode :: Platform -- OPTIMIZATION WARNING: Addressing modes. -- Addressing options: --- LDUR/STUR: imm9: -256 - 255 -getAmode platform _ (CmmRegOff reg off) | -256 <= off, off <= 255 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4 -getAmode platform W32 (CmmRegOff reg off) - | 0 <= off, off <= 16380, off `mod` 4 == 0 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8 -getAmode platform W64 (CmmRegOff reg off) - | 0 <= off, off <= 32760, off `mod` 8 == 0 +getAmode platform w (CmmRegOff reg off) + | isOffsetImm off w = return $ Amode (AddrRegImm reg' off') nilOL where reg' = getRegisterReg platform reg off' = ImmInt off @@ -1275,15 +1264,15 @@ getAmode platform W64 (CmmRegOff reg off) -- CmmStore (CmmMachOp (MO_Add w) [CmmLoad expr, CmmLit (CmmInt n w')]) (expr2) -- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ] -- for `n` in range. -getAmode _platform _ (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= off, off <= 255 +getAmode _platform w (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) + | isOffsetImm (fromIntegral off) w = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger off)) code -getAmode _platform _ (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= -off, -off <= 255 +getAmode _platform w (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) + | isOffsetImm (fromIntegral $ -off) w = do (reg, _format, code) <- getSomeReg expr - return $ Amode (AddrRegImm reg (ImmInteger (-off))) code + return $ Amode (AddrRegImm reg (ImmInteger $ -off)) code -- Generic case getAmode _platform _ expr ===================================== hadrian/ghci-cabal.in ===================================== @@ -5,6 +5,6 @@ set -e export TOOL_OUTPUT=.hadrian_ghci/ghci_args # Replace newlines with spaces, as these otherwise break the ghci invocation on windows. -CABFLAGS=-v0 "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS +CABFLAGS="-v0 $CABFLAGS" "hadrian/build-cabal" tool:compiler/GHC.hs --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS GHC_FLAGS="$GHC_FLAGS $(cat $TOOL_OUTPUT | tr '\n\r' ' ')" @WithGhc@ --interactive $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m ===================================== hadrian/src/Settings/Builders/Cabal.hs ===================================== @@ -59,7 +59,6 @@ commonReinstallCabalArgs :: Args commonReinstallCabalArgs = do top <- expr topDirectory root <- getBuildRoot - threads <- shakeThreads <$> expr getShakeOptions _pkg <- getPackage compiler <- expr $ programPath =<< programContext Stage1 ghc mconcat [ arg "--project-file" ===================================== libraries/base/GHC/Clock.hsc ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -9,17 +10,36 @@ module GHC.Clock import GHC.Base import GHC.Real import Data.Word +#if defined(javascript_HOST_ARCH) +import GHC.Num +#endif -- | Return monotonic time in seconds, since some unspecified starting point -- -- @since 4.11.0.0 getMonotonicTime :: IO Double -getMonotonicTime = do w <- getMonotonicTimeNSec - return (fromIntegral w / 1000000000) +getMonotonicTime = do +#if defined(javascript_HOST_ARCH) + w <- getMonotonicTimeMSec + return (w / 1000) +#else + w <- getMonotonicTimeNSec + return (fromIntegral w / 1000000000) +#endif -- | Return monotonic time in nanoseconds, since some unspecified starting point -- -- @since 4.11.0.0 +#if defined(javascript_HOST_ARCH) +getMonotonicTimeNSec :: IO Word64 +getMonotonicTimeNSec = do + w <- getMonotonicTimeMSec + return (floor w * 1000000) + +foreign import javascript unsafe "performance.now" getMonotonicTimeMSec:: IO Double + + +#else foreign import ccall unsafe "getMonotonicNSec" getMonotonicTimeNSec :: IO Word64 - +#endif ===================================== libraries/base/GHC/Conc/POSIX.hs ===================================== @@ -49,6 +49,7 @@ module GHC.Conc.POSIX import Data.Bits (shiftR) import GHC.Base +import GHC.Clock import GHC.Conc.Sync import GHC.Conc.POSIX.Const import GHC.Event.Windows.ConsoleEvent @@ -209,13 +210,9 @@ delayTime (Delay t _) = t delayTime (DelaySTM t _) = t type USecs = Word64 -type NSecs = Word64 - -foreign import ccall unsafe "getMonotonicNSec" - getMonotonicNSec :: IO NSecs getMonotonicUSec :: IO USecs -getMonotonicUSec = fmap (`div` 1000) getMonotonicNSec +getMonotonicUSec = fmap (`div` 1000) getMonotonicTimeNSec {-# NOINLINE prodding #-} prodding :: IORef Bool ===================================== libraries/base/tests/T23687.hs ===================================== @@ -0,0 +1,14 @@ +module Main where + +import GHC.Clock +import Control.Monad + +main :: IO () +main = do + a <- getMonotonicTimeNSec + b <- getMonotonicTimeNSec + when (a > b) $ putStrLn "Non-monotonic time" + + c <- getMonotonicTime + d <- getMonotonicTime + when (c > d) $ putStrLn "Non-monotonic time" ===================================== libraries/base/tests/all.T ===================================== @@ -310,3 +310,4 @@ test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) test('T23454', normal, compile_fail, ['']) +test('T23687', normal, compile_and_run, ['']) ===================================== testsuite/tests/overloadedrecflds/should_compile/T23279.hs ===================================== @@ -1,10 +1,23 @@ -{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields, DataKinds + , OverloadedLabels, OverloadedRecordDot #-} module T23279 where import T23279_aux +import GHC.Records + +bar :: Bar bar = Bar { x = 3, y = 'x', z = False, w = 17.28 } + +baz :: Baz baz = Baz { z = 1.1 } v = w + +barDot :: Bar -> Int +barDot b = b.x + +barGetField :: Bar -> Bool +barGetField = getField @"z" + ===================================== testsuite/tests/overloadedrecflds/should_compile/T23279.stderr ===================================== @@ -1,20 +1,28 @@ -T23279.hs:7:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] +T23279.hs:11:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] In the use of record field of Bar ‘x’ (imported from T23279_aux): Deprecated: "Don't use x" -T23279.hs:7:29: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] +T23279.hs:11:29: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] In the use of record field of Bar ‘z’ (imported from T23279_aux): Deprecated: "Don't use z" -T23279.hs:7:40: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] +T23279.hs:11:40: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] In the use of record field of Bar ‘w’ (imported from T23279_aux): Deprecated: "Don't use w" -T23279.hs:8:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] +T23279.hs:14:13: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] In the use of record field of Baz ‘z’ (imported from T23279_aux): Deprecated: "Don't use z" -T23279.hs:10:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] +T23279.hs:16:5: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] In the use of ‘w’ (imported from T23279_aux): Deprecated: "Don't use w" + +T23279.hs:19:12: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of record field of Bar ‘x’ (imported from T23279_aux): + Deprecated: "Don't use x" + +T23279.hs:22:15: warning: [GHC-68441] [-Wdeprecations (in -Wextended-warnings)] + In the use of record field of Bar ‘z’ (imported from T23279_aux): + Deprecated: "Don't use z" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2810170db7d66e385adb9199c85a306a8bf1cf56...db4314aa4917671c49c6602d4175256ec5c77e73 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2810170db7d66e385adb9199c85a306a8bf1cf56...db4314aa4917671c49c6602d4175256ec5c77e73 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 13:24:53 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 31 Jul 2023 09:24:53 -0400 Subject: [Git][ghc/ghc][wip/t23702] Add -finfo-table-map-with-fallback -finfo-table-map-with-stack Message-ID: <64c7b6255d53b_2f1200ba388166896@gitlab.mail> Finley McIlwaine pushed to branch wip/t23702 at Glasgow Haskell Compiler / GHC Commits: cf34e7db by Finley McIlwaine at 2023-07-31T07:24:39-06:00 Add -finfo-table-map-with-fallback -finfo-table-map-with-stack The -fno-info-table-map-with-stack flag omits STACK info tables from the info table map, and the -fno-info-table-map-with-fallback flag omits info tables with defaulted source locations from the map. In a test on the Agda codebase the build results were about 7% smaller when both of those types of tables were omitted. Adds a test that verifies that passing each combination of these flags results in the correct output for -dipe-stats. This commit also refactors a lot of the logic around extracting info tables from the Cmm results and building the info table map. This commit also fixes some issues in the users guide rst source to fix warnings that were noticed while debugging the documentation for these flags. Fixes #23702 - - - - - 16 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/GenerateCgIPEStub.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Heap/Layout.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prof.hs - compiler/GHC/StgToCmm/Utils.hs - docs/users_guide/9.10.1-notes.rst - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debug-info.rst - docs/users_guide/debugging.rst - docs/users_guide/exts/implicit_parameters.rst - docs/users_guide/phases.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf34e7db9e757ba0e3ff388c0aa3168183331d10 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf34e7db9e757ba0e3ff388c0aa3168183331d10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 14:10:08 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 31 Jul 2023 10:10:08 -0400 Subject: [Git][ghc/ghc][wip/T23576] 171 commits: Filter out nontrivial substituted expressions in substTickish Message-ID: <64c7c0c03109a_2f1200ba34c1826bc@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 6fdcf969 by Torsten Schmits at 2023-07-06T12:12:09-04:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: testsuite: use req_c predicate instead of js_broken - - - - - 74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00 JS: implement some file primitives (lstat,rmdir) (#22374) - Implement lstat and rmdir. - Implement base_c_s_is* functions (testing a file type) - Enable passing tests - - - - - 7e759914 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: cleanup utils (#23314) - Removed unused code - Don't export unused functions - Move toTypeList to Closure module - - - - - f617655c by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: rename VarType/Vt into JSRep - - - - - 19216ca5 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: remove custom PrimRep conversion (#23314) We use the usual conversion to PrimRep and then we convert these PrimReps to JSReps. - - - - - d3de8668 by Sylvain Henry at 2023-07-07T02:39:38-04:00 JS: don't use isRuntimeRepKindedTy in JS FFI - - - - - 8d1b75cb by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Also updates ghcup-nightlies-0.0.7.yaml file Fixes #23600 - - - - - e524fa7f by Matthew Pickering at 2023-07-07T02:40:15-04:00 ghcup-metadata: Use dynamically linked alpine bindists In theory these will work much better on alpine to allow people to build statically linked applications there. We don't need to distribute a statically linked application ourselves in order to allow that. Fixes #23602 - - - - - b9e7beb9 by Ben Gamari at 2023-07-07T11:32:22-04:00 Drop circle-ci-job.sh - - - - - 9955eead by Ben Gamari at 2023-07-07T11:32:22-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 48f80968 by Ben Gamari at 2023-07-07T11:32:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 76983a0d by Matthew Pickering at 2023-07-07T11:32:58-04:00 driver: Fix -S with .cmm files There was an oversight in the driver which assumed that you would always produce a `.o` file when compiling a .cmm file. Fixes #23610 - - - - - 6df15e93 by Mike Pilgrem at 2023-07-07T11:33:40-04:00 Update Hadrian's stack.yaml - - - - - 1dff43cf by Ben Gamari at 2023-07-08T05:05:37-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8165404b by Ben Gamari at 2023-07-08T05:05:37-04:00 testsuite: Add test to catch changes in core libraries This adds testing infrastructure to ensure that changes in core libraries (e.g. `base` and `ghc-prim`) are caught in CI. - - - - - ec1c32e2 by Melanie Phoenix at 2023-07-08T05:06:14-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 5d2442b8 by Ben Gamari at 2023-07-08T05:06:51-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - a9bc20cb by Oleg Grenrus at 2023-07-08T05:07:31-04:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - c7026962 by Ben Gamari at 2023-07-08T05:08:11-04:00 configure: Don't use ld.gold on i386 ld.gold appears to produce invalid static constructor tables on i386. While ideally we would add an autoconf check to check for this brokenness, sadly such a check isn't easy to compose. Instead to summarily reject such linkers on i386. Somewhat hackily closes #23579. - - - - - 054261dd by Bodigrim at 2023-07-08T19:32:47-04:00 Add since annotations for Data.Foldable1 - - - - - 550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00 JS: support -this-unit-id for programs in the linker (#23613) - - - - - d284470a by Bodigrim at 2023-07-08T19:34:08-04:00 Bump text submodule - - - - - 8e11630e by jade at 2023-07-10T16:58:40-04:00 Add a hint to enable ExplicitNamespaces for type operator imports (Fixes/Enhances #20007) As suggested in #20007 and implemented in !8895, trying to import type operators will suggest a fix to use the 'type' keyword, without considering whether ExplicitNamespaces is enabled. This patch will query whether ExplicitNamespaces is enabled and add a hint to suggest enabling ExplicitNamespaces if it isn't enabled, alongside the suggestion of adding the 'type' keyword. - - - - - 61b1932e by sheaf at 2023-07-10T16:59:26-04:00 tyThingLocalGREs: include all DataCons for RecFlds The GREInfo for a record field should include the collection of all the data constructors of the parent TyCon that have this record field. This information was being incorrectly computed in the tyThingLocalGREs function for a DataCon, as we were not taking into account other DataCons with the same parent TyCon. Fixes #23546 - - - - - e6627cbd by Alan Zimmerman at 2023-07-10T17:00:05-04:00 EPA: Simplify GHC/Parser.y comb3 A follow up to !10743 - - - - - ee20da34 by Bodigrim at 2023-07-10T17:01:01-04:00 Document that compareByteArrays# is available since ghc-prim-0.5.2.0 - - - - - 4926af7b by Matthew Pickering at 2023-07-10T17:01:38-04:00 Revert "Bump text submodule" This reverts commit d284470a77042e6bc17bdb0ab0d740011196958a. This commit requires that we bootstrap with ghc-9.4, which we do not require until #23195 has been completed. Subsequently this has broken nighty jobs such as the rocky8 job which in turn has broken nightly releases. - - - - - d1c92bf3 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Fingerprint more code generation flags Previously our recompilation check was quite inconsistent in its coverage of non-optimisation code generation flags. Specifically, we failed to account for most flags that would affect the behavior of generated code in ways that might affect the result of a program's execution (e.g. `-feager-blackholing`, `-fstrict-dicts`) Closes #23369. - - - - - eb623149 by Ben Gamari at 2023-07-11T08:07:02-04:00 compiler: Record original thunk info tables on stack Here we introduce a new code generation option, `-forig-thunk-info`, which ensures that an `stg_orig_thunk_info` frame is pushed before every update frame. This can be invaluable when debugging thunk cycles and similar. See Note [Original thunk info table frames] for details. Closes #23255. - - - - - 4731f44e by Jaro Reinders at 2023-07-11T08:07:40-04:00 Fix wrong MIN_VERSION_GLASGOW_HASKELL macros I forgot to change these after rebasing. - - - - - dd38aca9 by Andreas Schwab at 2023-07-11T13:55:56+00:00 Hadrian: enable GHCi support on riscv64 - - - - - 09a5c6cc by Josh Meredith at 2023-07-12T11:25:13-04:00 JavaScript: support unicode code points > 2^16 in toJSString using String.fromCodePoint (#23628) - - - - - 29fbbd4e by Matthew Pickering at 2023-07-12T11:25:49-04:00 Remove references to make build system in mk/build.mk Fixes #23636 - - - - - 630e3026 by sheaf at 2023-07-12T11:26:43-04:00 Valid hole fits: don't panic on a Given The function GHC.Tc.Errors.validHoleFits would end up panicking when encountering a Given constraint. To fix this, it suffices to filter out the Givens before continuing. Fixes #22684 - - - - - c39f279b by Matthew Pickering at 2023-07-12T23:18:38-04:00 Use deb10 for i386 bindists deb9 is now EOL so it's time to upgrade the i386 bindist to use deb10 Fixes #23585 - - - - - bf9b9de0 by Krzysztof Gogolewski at 2023-07-12T23:19:15-04:00 Fix #23567, a specializer bug Found by Simon in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507834 The testcase isn't ideal because it doesn't detect the bug in master, unless doNotUnbox is removed as in https://gitlab.haskell.org/ghc/ghc/-/issues/23567#note_507692. But I have confirmed that with that modification, it fails before and passes afterwards. - - - - - 84c1a4a2 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 Comments - - - - - b2846cb5 by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 updates to comments - - - - - 2af23f0e by Bartłomiej Cieślar at 2023-07-12T23:20:08-04:00 changes - - - - - 6143838a by sheaf at 2023-07-13T08:02:17-04:00 Fix deprecation of record fields Commit 3f374399 inadvertently broke the deprecation/warning mechanism for record fields due to its introduction of record field namespaces. This patch ensures that, when a top-level deprecation is applied to an identifier, it applies to all the record fields as well. This is achieved by refactoring GHC.Rename.Env.lookupLocalTcNames, and GHC.Rename.Env.lookupBindGroupOcc, to not look up a fixed number of NameSpaces but to look up all NameSpaces and filter out the irrelevant ones. - - - - - 6fd8f566 by sheaf at 2023-07-13T08:02:17-04:00 Introduce greInfo, greParent These are simple helper functions that wrap the internal field names gre_info, gre_par. - - - - - 7f0a86ed by sheaf at 2023-07-13T08:02:17-04:00 Refactor lookupGRE_... functions This commit consolidates all the logic for looking up something in the Global Reader Environment into the single function lookupGRE. This allows us to declaratively specify all the different modes of looking up in the GlobalRdrEnv, and avoids manually passing around filtering functions as was the case in e.g. the function GHC.Rename.Env.lookupSubBndrOcc_helper. ------------------------- Metric Decrease: T8095 ------------------------- ------------------------- Metric Increase: T8095 ------------------------- - - - - - 5e951395 by Rodrigo Mesquita at 2023-07-13T08:02:54-04:00 configure: Drop DllWrap command We used to configure into settings a DllWrap command for windows builds and distributions, however, we no longer do, and dllwrap is effectively unused. This simplification is motivated in part by the larger toolchain-selection project (#19877, !9263) - - - - - e10556b6 by Teo Camarasu at 2023-07-14T16:28:46-04:00 base: fix haddock syntax in GHC.Profiling - - - - - 0f3fda81 by Matthew Pickering at 2023-07-14T16:29:23-04:00 Revert "CI: add JS release and debug builds, regen CI jobs" This reverts commit 59c5fe1d4b624423b1c37891710f2757bb58d6af. This commit added two duplicate jobs on all validate pipelines, so we are reverting for now whilst we work out what the best way forward is. Ticket #23618 - - - - - 54bca324 by Alan Zimmerman at 2023-07-15T03:23:26-04:00 EPA: Simplify GHC/Parser.y sLL Follow up to !10743 - - - - - c8863828 by sheaf at 2023-07-15T03:24:06-04:00 Configure: canonicalise PythonCmd on Windows This change makes PythonCmd resolve to a canonical absolute path on Windows, which prevents HLS getting confused (now that we have a build-time dependency on python). fixes #23652 - - - - - ca1e636a by Rodrigo Mesquita at 2023-07-15T03:24:42-04:00 Improve Note [Binder-swap during float-out] - - - - - cf86f3ec by Matthew Craven at 2023-07-16T01:42:09+02:00 Equality of forall-types is visibility aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [ForAllCo] in GHC.Core.TyCo.Rep It also establishes a helpful new invariant for ForAllCo, and ForAllTy, when the bound variable is a CoVar:in that case the visibility must be coreTyLamForAllTyFlag. All this is well documented in revised Notes. - - - - - 7f13acbf by Vladislav Zavialov at 2023-07-16T01:56:27-04:00 List and Tuple<n>: update documentation Add the missing changelog.md entries and @since-annotations. - - - - - 2afbddb0 by Andrei Borzenkov at 2023-07-16T10:21:24+04:00 Type patterns (#22478, #18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - eb1a6ab1 by sheaf at 2023-07-16T09:20:45-04:00 Don't use substTyUnchecked in newMetaTyVar There were some comments that explained that we needed to use an unchecked substitution function because of issue #12931, but that has since been fixed, so we should be able to use substTy instead now. - - - - - c7bbad9a by sheaf at 2023-07-17T02:48:19-04:00 rnImports: var shouldn't import NoFldSelectors In an import declaration such as import M ( var ) the import of the variable "var" should **not** bring into scope record fields named "var" which are defined with NoFieldSelectors. Doing so can cause spurious "unused import" warnings, as reported in ticket #23557. Fixes #23557 - - - - - 1af2e773 by sheaf at 2023-07-17T02:48:19-04:00 Suggest similar names in imports This commit adds similar name suggestions when importing. For example module A where { spelling = 'o' } module B where { import B ( speling ) } will give rise to the error message: Module ‘A’ does not export ‘speling’. Suggested fix: Perhaps use ‘spelling’ This also provides hints when users try to import record fields defined with NoFieldSelectors. - - - - - 654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00 EPA: Store leading AnnSemi for decllist in al_rest This simplifies the markAnnListA implementation in ExactPrint - - - - - 22565506 by sheaf at 2023-07-17T21:12:59-04:00 base: add COMPLETE pragma to BufferCodec PatSyn This implements CLC proposal #178, rectifying an oversight in the implementation of CLC proposal #134 which could lead to spurious pattern match warnings. https://github.com/haskell/core-libraries-committee/issues/178 https://github.com/haskell/core-libraries-committee/issues/134 - - - - - 860f6269 by sheaf at 2023-07-17T21:13:00-04:00 exactprint: silence incomplete record update warnings - - - - - df706de3 by sheaf at 2023-07-17T21:13:00-04:00 Re-instate -Wincomplete-record-updates Commit e74fc066 refactored the handling of record updates to use the HsExpanded mechanism. This meant that the pattern matching inherent to a record update was considered to be "generated code", and thus we stopped emitting "incomplete record update" warnings entirely. This commit changes the "data Origin = Source | Generated" datatype, adding a field to the Generated constructor to indicate whether we still want to perform pattern-match checking. We also have to do a bit of plumbing with HsCase, to record that the HsCase arose from an HsExpansion of a RecUpd, so that the error message continues to mention record updates as opposed to a generic "incomplete pattern matches in case" error. Finally, this patch also changes the way we handle inaccessible code warnings. Commit e74fc066 was also a regression in this regard, as we were emitting "inaccessible code" warnings for case statements spuriously generated when desugaring a record update (remember: the desugaring mechanism happens before typechecking; it thus can't take into account e.g. GADT information in order to decide which constructors to include in the RHS of the desugaring of the record update). We fix this by changing the mechanism through which we disable inaccessible code warnings: we now check whether we are in generated code in GHC.Tc.Utils.TcMType.newImplication in order to determine whether to emit inaccessible code warnings. Fixes #23520 Updates haddock submodule, to avoid incomplete record update warnings - - - - - 1d05971e by sheaf at 2023-07-17T21:13:00-04:00 Propagate long-distance information in do-notation The preceding commit re-enabled pattern-match checking inside record updates. This revealed that #21360 was in fact NOT fixed by e74fc066. This commit makes sure we correctly propagate long-distance information in do blocks, e.g. in ```haskell data T = A { fld :: Int } | B f :: T -> Maybe T f r = do a at A{} <- Just r Just $ case a of { A _ -> A 9 } ``` we need to propagate the fact that "a" is headed by the constructor "A" to see that the case expression "case a of { A _ -> A 9 }" cannot fail. Fixes #21360 - - - - - bea0e323 by sheaf at 2023-07-17T21:13:00-04:00 Skip PMC for boring patterns Some patterns introduce no new information to the pattern-match checker (such as plain variable or wildcard patterns). We can thus skip doing any pattern-match checking on them when the sole purpose for doing so was introducing new long-distance information. See Note [Boring patterns] in GHC.Hs.Pat. Doing this avoids regressing in performance now that we do additional pattern-match checking inside do notation. - - - - - ddcdd88c by Rodrigo Mesquita at 2023-07-17T21:13:36-04:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Split off the `GHC.Platform.ArchOS` module from the `ghc-boot` package into this reinstallable standalone package which abides by the PVP, in part motivated by the ongoing work on `ghc-toolchain` towards runtime retargetability. - - - - - b55a8ea7 by Sylvain Henry at 2023-07-17T21:14:27-04:00 JS: better implementation for plusWord64 (#23597) - - - - - 889c2bbb by sheaf at 2023-07-18T06:37:32-04:00 Do primop rep-poly checks when instantiating This patch changes how we perform representation-polymorphism checking for primops (and other wired-in Ids such as coerce). When instantiating the primop, we check whether each type variable is required to instantiated to a concrete type, and if so we create a new concrete metavariable (a ConcreteTv) instead of a simple MetaTv. (A little subtlety is the need to apply the substitution obtained from instantiating to the ConcreteTvOrigins, see Note [substConcreteTvOrigin] in GHC.Tc.Utils.TcMType.) This allows us to prevent representation-polymorphism in non-argument position, as that is required for some of these primops. We can also remove the logic in tcRemainingValArgs, except for the part concerning representation-polymorphic unlifted newtypes. The function has been renamed rejectRepPolyNewtypes; all it does now is reject unsaturated occurrences of representation-polymorphic newtype constructors when the representation of its argument isn't a concrete RuntimeRep (i.e. still a PHASE 1 FixedRuntimeRep check). The Note [Eta-expanding rep-poly unlifted newtypes] in GHC.Tc.Gen.Head gives more explanation about a possible path to PHASE 2, which would be in line with the treatment for primops taken in this patch. We also update the Core Lint check to handle this new framework. This means Core Lint now checks representation-polymorphism in continuation position like needed for catch#. Fixes #21906 ------------------------- Metric Increase: LargeRecord ------------------------- - - - - - 00648e5d by Krzysztof Gogolewski at 2023-07-18T06:38:10-04:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 787bae96 by Krzysztof Gogolewski at 2023-07-18T06:38:50-04:00 Use extended literals when deriving Show This implements GHC proposal https://github.com/ghc-proposals/ghc-proposals/pull/596 Also add support for Int64# and Word64#; see testcase ShowPrim. - - - - - 257f1567 by Jaro Reinders at 2023-07-18T06:39:29-04:00 Add StgFromCore and StgCodeGen linting - - - - - 34d08a20 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Strictness - - - - - c5deaa27 by Ben Gamari at 2023-07-19T03:33:22-04:00 Reg.Liveness: Don't repeatedly construct UniqSets - - - - - b947250b by Ben Gamari at 2023-07-19T03:33:22-04:00 compiler/Types: Ensure that fromList-type operations can fuse In #20740 I noticed that mkUniqSet does not fuse. In practice, allowing it to do so makes a considerable difference in allocations due to the backend. Metric Decrease: T12707 T13379 T3294 T4801 T5321FD T5321Fun T783 - - - - - 6c88c2ba by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 Codegen: Implement MO_S_MulMayOflo for W16 - - - - - 5f1154e0 by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: MO_S_MulMayOflo better error message for rep > W64 It's useful to see which value made the pattern match fail. (If it ever occurs.) - - - - - e8c9a95f by Sven Tennie at 2023-07-19T03:33:59-04:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - a36f9dc9 by Sven Tennie at 2023-07-19T03:33:59-04:00 Add test for %mulmayoflo primop The test expects a perfect implementation with no false positives. - - - - - 38a36248 by Matthew Pickering at 2023-07-19T03:34:36-04:00 lint-ci-config: Generate jobs-metadata.json We also now save the jobs-metadata.json and jobs.yaml file as artifacts as: * It might be useful for someone who is modifying CI to copy jobs.yaml if they are having trouble regenerating locally. * jobs-metadata.json is very useful for downstream pipelines to work out the right job to download. Fixes #23654 - - - - - 1535a671 by Vladislav Zavialov at 2023-07-19T03:35:12-04:00 Initialize 9.10.1-notes.rst Create new release notes for the next GHC release (GHC 9.10) - - - - - 3bd4d5b5 by sheaf at 2023-07-19T03:35:53-04:00 Prioritise Parent when looking up class sub-binder When we look up children GlobalRdrElts of a given Parent, we sometimes would rather prioritise those GlobalRdrElts which have the right Parent, and sometimes prioritise those that have the right NameSpace: - in export lists, we should prioritise NameSpace - for class/instance binders, we should prioritise Parent See Note [childGREPriority] in GHC.Types.Name.Reader. fixes #23664 - - - - - 9c8fdda3 by Alan Zimmerman at 2023-07-19T03:36:29-04:00 EPA: Improve annotation management in getMonoBind Ensure the LHsDecl for a FunBind has the correct leading comments and trailing annotations. See the added note for details. - - - - - ff884b77 by Matthew Pickering at 2023-07-19T11:42:02+01:00 Remove unused files in .gitlab These were left over after 6078b429 - - - - - 29ef590c by Matthew Pickering at 2023-07-19T11:42:52+01:00 gen_ci: Add hie.yaml file This allows you to load `gen_ci.hs` into HLS, and now it is a huge module, that is quite useful. - - - - - 808b55cf by Matthew Pickering at 2023-07-19T12:24:41+01:00 ci: Make "fast-ci" the default validate configuration We are trying out a lighter weight validation pipeline where by default we just test on 5 platforms: * x86_64-deb10-slow-validate * windows * x86_64-fedora33-release * aarch64-darwin * aarch64-linux-deb10 In order to enable the "full" validation pipeline you can apply the `full-ci` label which will enable all the validation pipelines. All the validation jobs are still run on a marge batch. The goal is to reduce the overall CI capacity so that pipelines start faster for MRs and marge bot batches are faster. Fixes #23694 - - - - - 0b23db03 by Alan Zimmerman at 2023-07-20T05:28:47-04:00 EPA: Simplify GHC/Parser.y sL1 This is the next patch in a series simplifying location management in GHC/Parser.y This one simplifies sL1, to use the HasLoc instances introduced in !10743 (closed) - - - - - 3ece9856 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Explicitly set flags of text sections on Windows The binutils documentation (for COFF) claims, > If no flags are specified, the default flags depend upon the section > name. If the section name is not recognized, the default will be for the > section to be loaded and writable. We previously assumed that this would do the right thing for split sections (e.g. a section named `.text$foo` would be correctly inferred to be a text section). However, we have observed that this is not the case (at least under the clang toolchain used on Windows): when split-sections is enabled, text sections are treated by the assembler as data (matching the "default" behavior specified by the documentation). Avoid this by setting section flags explicitly. This should fix split sections on Windows. Fixes #22834. - - - - - db7f7240 by Ben Gamari at 2023-07-21T07:30:45-04:00 nativeGen: Set explicit section types on all platforms - - - - - b444c16f by Finley McIlwaine at 2023-07-21T07:31:28-04:00 Insert documentation into parsed signature modules Causes haddock comments in signature modules to be properly inserted into the AST (just as they are for regular modules) if the `-haddock` flag is given. Also adds a test that compares `-ddump-parsed-ast` output for a signature module to prevent further regressions. Fixes #23315 - - - - - c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - 6e993b1e by Jaro Reinders at 2023-07-31T16:09:52+02:00 Allow big arith on x86 - - - - - bc7b6911 by Jaro Reinders at 2023-07-31T16:09:52+02:00 More detailed panic in iselExpr64 - - - - - 8b1a9f5d by Jaro Reinders at 2023-07-31T16:09:52+02:00 Better debug message attempt 2 - - - - - 8972fe5d by Jaro Reinders at 2023-07-31T16:09:52+02:00 Implement negation - - - - - 7dce74df by Jaro Reinders at 2023-07-31T16:09:52+02:00 Add MO_Mul case in iselExpr64 - - - - - 09bbd7d5 by Jaro Reinders at 2023-07-31T16:09:53+02:00 Try fixing iselExpr64 for MO_Mul - - - - - 68e2d69c by Jaro Reinders at 2023-07-31T16:09:53+02:00 Fix MO_Mul some more - - - - - 3dbbe95d by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add AllowBigQuot option to StgToCmm - - - - - ee858258 by Jaro Reinders at 2023-07-31T16:09:53+02:00 Implement MO_Shl in iselExpr64 - - - - - 5bdc9180 by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add SHRD to regUsage - - - - - 366d8e0f by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add SHRD to patchRegs - - - - - ec7ba7df by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add SHRD to pprInstr - - - - - da7a0e1d by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add more shifts - - - - - 9d976f4d by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add bitwise operations - - - - - d4ef27ee by Jaro Reinders at 2023-07-31T16:09:53+02:00 Insert unconditional jumps before NEWBLOCK - - - - - d984eac2 by Jaro Reinders at 2023-07-31T16:09:53+02:00 Fix blocks - - - - - 0d97520e by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add condIntCode for 64-bit ints on i386 - - - - - 2f07668e by Jaro Reinders at 2023-07-31T16:09:53+02:00 Fix typo - - - - - 3ce2ae6c by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add MO_UU_Conv W64 W8 - - - - - a34b8e3b by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add CmmRegOff case to iselExpr64 - - - - - e8d135c4 by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add MO_UU_Conv W64 W16 - - - - - d4e629b1 by Jaro Reinders at 2023-07-31T16:09:53+02:00 Add MO_SS_Conv W16/W8 W64 - - - - - e95d88f9 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Revert confFltCode changes - - - - - 42ed133b by Jaro Reinders at 2023-07-31T16:09:54+02:00 Remove whitespace and add temporary quottish cases - - - - - 8d4ecd0b by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fixes - - - - - 423ffbad by Jaro Reinders at 2023-07-31T16:09:54+02:00 Add MO_UU_Conv w W64 - - - - - 4292e325 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fix MO_SS_Conv W8/16 W64 - - - - - 47268925 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fix MO_SS_Conv W8/16 W64 again - - - - - 8dd98e6c by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fix MO_SS_Conv W8/16 W64 again again - - - - - 7c76b72f by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fix MO_SS_Conv W8/16 W64 again again again - - - - - c7dc07cb by Jaro Reinders at 2023-07-31T16:09:54+02:00 Remove temporary quottish ops - - - - - ba938559 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fix condIntCode' - - - - - bc17b326 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fix condIntCode' again - - - - - 4749f1a4 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Fix whitespace and update comment - - - - - 0f472524 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Remove workarounds - - - - - 4cb45038 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Remove stray comment - - - - - a1103eff by Jaro Reinders at 2023-07-31T16:09:54+02:00 Remove redundant code and move note - - - - - da46cc16 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Add comments and abstract over common case. - - - - - 23eabdf5 by Jaro Reinders at 2023-07-31T16:09:54+02:00 Remove SAL and use the equivalent SHL instead - - - - - 15 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - − .gitlab/gen-ci.cabal - .gitlab/generate-ci/gen_ci.hs - .gitlab/hie.yaml → .gitlab/generate-ci/hie.yaml - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/PrimOps/Ids.hs - compiler/GHC/Builtin/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69cdcfe58588832e041fbb4f1967180fd82c36cf...23eabdf5b1123e489da5582b80f9c0fa6e52d205 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69cdcfe58588832e041fbb4f1967180fd82c36cf...23eabdf5b1123e489da5582b80f9c0fa6e52d205 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 15:50:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 31 Jul 2023 11:50:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: JS: implement getMonotonicTime (fix #23687) Message-ID: <64c7d85acf2d4_2f1200ba3882200a6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 95e56996 by Sylvain Henry at 2023-07-31T11:50:38-04:00 JS: implement getMonotonicTime (fix #23687) - - - - - 6c8ab5b4 by Bartłomiej Cieślar at 2023-07-31T11:50:40-04:00 Implementation of the Deprecated Instances proposal #575 This commit implements the ability to deprecate certain instances, which causes the compiler to emit the desired deprecation message whenever they are instantiated. For example: module A where class C t where instance {-# DEPRECATED "dont use" #-} C Int where module B where import A f :: C t => t f = undefined g :: Int g = f -- "dont use" emitted here The implementation is as follows: - In the parser, we parse deprecations/warnings attached to instances: instance {-# DEPRECATED "msg" #-} Show X deriving instance {-# WARNING "msg2" #-} Eq Y (Note that non-standalone deriving instance declarations do not support this mechanism.) - We store the resulting warning message in `ClsInstDecl` (respectively, `DerivDecl`). In `GHC.Tc.TyCl.Instance.tcClsInstDecl` (respectively, `GHC.Tc.Deriv.Utils.newDerivClsInst`), we pass on that information to `ClsInst` (and eventually store it in `IfaceClsInst` too). - Finally, when we solve a constraint using such an instance, in `GHC.Tc.Instance.Class.matchInstEnv`, we emit the appropriate warning that was stored in `ClsInst`. Note that we only emit a warning when the instance is used in a different module than it is defined, which keeps the behaviour in line with the deprecation of top-level identifiers. Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 01e7e875 by Matthew Pickering at 2023-07-31T11:50:41-04:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 24380ba3 by Bartłomiej Cieślar at 2023-07-31T11:50:45-04:00 Add cases to T23279: HasField for deprecated record fields This commit adds additional tests from ticket #23279 to ensure that we don't regress on reporting deprecated record fields in conjunction with HasField, either when using overloaded record dot syntax or directly through `getField`. Fixes #23279 - - - - - 36c95263 by Andreas Klebinger at 2023-07-31T11:50:46-04:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - 22ecc345 by Andreas Klebinger at 2023-07-31T11:50:46-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Unit/Module/Warnings.hs - docs/users_guide/exts/pragmas.rst - hadrian/ghci-cabal.in - hadrian/src/Settings/Builders/Cabal.hs - libraries/base/GHC/Clock.hsc The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db4314aa4917671c49c6602d4175256ec5c77e73...22ecc3454a5516a85eddbc69793b000785f7c6f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db4314aa4917671c49c6602d4175256ec5c77e73...22ecc3454a5516a85eddbc69793b000785f7c6f5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 15:59:57 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 31 Jul 2023 11:59:57 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Implement Or Patterns (Proposal 0522) Message-ID: <64c7da7d5defe_2f1200ba338232218@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 50f574d1 by David Knothe at 2023-07-31T17:59:42+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. stuff Implement empty one of Prohibit TyApps Remove unused update submodule haddock Update tests Parser.y - - - - - 30 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Types.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Utils/Outputable.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - + docs/users_guide/exts/or_patterns.rst - docs/users_guide/exts/patterns.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50f574d13ef9caec295e70455e3c1d0f44a3c40d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/50f574d13ef9caec295e70455e3c1d0f44a3c40d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 18:21:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 31 Jul 2023 14:21:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: JS: implement getMonotonicTime (fix #23687) Message-ID: <64c7fbb275206_2f120013c5237c2915ad@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b9db90f7 by Sylvain Henry at 2023-07-31T14:21:23-04:00 JS: implement getMonotonicTime (fix #23687) - - - - - 66a110c6 by Bartłomiej Cieślar at 2023-07-31T14:21:26-04:00 Implementation of the Deprecated Instances proposal #575 This commit implements the ability to deprecate certain instances, which causes the compiler to emit the desired deprecation message whenever they are instantiated. For example: module A where class C t where instance {-# DEPRECATED "dont use" #-} C Int where module B where import A f :: C t => t f = undefined g :: Int g = f -- "dont use" emitted here The implementation is as follows: - In the parser, we parse deprecations/warnings attached to instances: instance {-# DEPRECATED "msg" #-} Show X deriving instance {-# WARNING "msg2" #-} Eq Y (Note that non-standalone deriving instance declarations do not support this mechanism.) - We store the resulting warning message in `ClsInstDecl` (respectively, `DerivDecl`). In `GHC.Tc.TyCl.Instance.tcClsInstDecl` (respectively, `GHC.Tc.Deriv.Utils.newDerivClsInst`), we pass on that information to `ClsInst` (and eventually store it in `IfaceClsInst` too). - Finally, when we solve a constraint using such an instance, in `GHC.Tc.Instance.Class.matchInstEnv`, we emit the appropriate warning that was stored in `ClsInst`. Note that we only emit a warning when the instance is used in a different module than it is defined, which keeps the behaviour in line with the deprecation of top-level identifiers. Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 631379a9 by Matthew Pickering at 2023-07-31T14:21:27-04:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 3df79840 by Bartłomiej Cieślar at 2023-07-31T14:21:31-04:00 Add cases to T23279: HasField for deprecated record fields This commit adds additional tests from ticket #23279 to ensure that we don't regress on reporting deprecated record fields in conjunction with HasField, either when using overloaded record dot syntax or directly through `getField`. Fixes #23279 - - - - - ce1929a2 by Andreas Klebinger at 2023-07-31T14:21:32-04:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - e3f5762c by Andreas Klebinger at 2023-07-31T14:21:33-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Unit/Module/Warnings.hs - docs/users_guide/exts/pragmas.rst - hadrian/ghci-cabal.in - hadrian/src/Settings/Builders/Cabal.hs - libraries/base/GHC/Clock.hsc The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22ecc3454a5516a85eddbc69793b000785f7c6f5...e3f5762cd907191ee8d8c884e4efb2609272ceb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22ecc3454a5516a85eddbc69793b000785f7c6f5...e3f5762cd907191ee8d8c884e4efb2609272ceb4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 19:56:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 31 Jul 2023 15:56:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/refactor-atomicModifyMutVar2 Message-ID: <64c81208d490c_2f120013c523683251b2@gitlab.mail> Ben Gamari pushed new branch wip/tsan/refactor-atomicModifyMutVar2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/refactor-atomicModifyMutVar2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 19:58:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 31 Jul 2023 15:58:18 -0400 Subject: [Git][ghc/ghc][wip/tsan/prep] 28 commits: EPA: Simplify GHC/Parser.y comb4/comb5 Message-ID: <64c8125ac566e_2f1200ba360326833@gitlab.mail> Ben Gamari pushed to branch wip/tsan/prep at Glasgow Haskell Compiler / GHC Commits: 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - 116bbbd9 by Ben Gamari at 2023-07-31T15:58:08-04:00 compiler: Style fixes - - - - - 2149bfb8 by Ben Gamari at 2023-07-31T15:58:08-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 81379901 by Ben Gamari at 2023-07-31T15:58:09-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - 075030c4 by Ben Gamari at 2023-07-31T15:58:09-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 92f6b1e9 by Ben Gamari at 2023-07-31T15:58:09-04:00 rts: Introduce more principled fence operations - - - - - 98b7eb9f by Ben Gamari at 2023-07-31T15:58:09-04:00 rts: Introduce SET_INFO_RELAXED - - - - - 9959d41f by Ben Gamari at 2023-07-31T15:58:09-04:00 rts: Style fixes - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/CoreToIface.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65bd78267375d8c2b4bc0b4ac9fd7563c4050539...9959d41f182103d927033445b5fe82243585cadf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/65bd78267375d8c2b4bc0b4ac9fd7563c4050539...9959d41f182103d927033445b5fe82243585cadf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 20:08:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 31 Jul 2023 16:08:18 -0400 Subject: [Git][ghc/ghc][wip/T23554] 48 commits: primops: Introduce unsafeThawByteArray# Message-ID: <64c814b23a867_2f120013c825e0345228@gitlab.mail> Ben Gamari pushed to branch wip/T23554 at Glasgow Haskell Compiler / GHC Commits: c30cea53 by Ben Gamari at 2023-07-21T23:23:49-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 87f9bd47 by Ben Gamari at 2023-07-21T23:23:49-04:00 testsuite: Elaborate in interface stability README This discussion didn't make it into the original MR. - - - - - e4350b41 by Matthew Pickering at 2023-07-21T23:24:25-04:00 Allow users to override non-essential haddock options in a Flavour We now supply the non-essential options to haddock using the `extraArgs` field, which can be specified in a Flavour so that if an advanced user wants to change how documentation is generated then they can use something other than the `defaultHaddockExtraArgs`. This does have the potential to regress some packaging if a user has overridden `extraArgs` themselves, because now they also need to add the haddock options to extraArgs. This can easily be done by appending `defaultHaddockExtraArgs` to their extraArgs invocation but someone might not notice this behaviour has changed. In any case, I think passing the non-essential options in this manner is the right thing to do and matches what we do for the "ghc" builder, which by default doesn't pass any optmisation levels, and would likewise be very bad if someone didn't pass suitable `-O` levels for builds. Fixes #23625 - - - - - fc186b0c by Ilias Tsitsimpis at 2023-07-21T23:25:03-04:00 ghc-prim: Link against libatomic Commit b4d39adbb58 made 'hs_cmpxchg64()' available to all architectures. Unfortunately this made GHC to fail to build on armel, since armel needs libatomic to support atomic operations on 64-bit word sizes. Configure libraries/ghc-prim/ghc-prim.cabal to link against libatomic, the same way as we do in rts/rts.cabal. - - - - - 4f5538a8 by Matthew Pickering at 2023-07-21T23:25:39-04:00 simplifier: Correct InScopeSet in rule matching The in-scope set passedto the `exprIsLambda_maybe` call lacked all the in-scope binders. @simonpj suggests this fix where we augment the in-scope set with the free variables of expression which fixes this failure mode in quite a direct way. Fixes #23630 - - - - - 5ad8d597 by Krzysztof Gogolewski at 2023-07-21T23:26:17-04:00 Add a test for #23413 It was fixed by commit e1590ddc661d6: Add the SolverStage monad. - - - - - 7e05f6df by sheaf at 2023-07-21T23:26:56-04:00 Finish migration of diagnostics in GHC.Tc.Validity This patch finishes migrating the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It also refactors the error message datatypes for class and family instances, to common them up under a single datatype as much as possible. - - - - - 4876fddc by Matthew Pickering at 2023-07-21T23:27:33-04:00 ci: Enable some more jobs to run in a marge batch In !10907 I made the majority of jobs not run on a validate pipeline but then forgot to renable a select few jobs on the marge batch MR. - - - - - 026991d7 by Jens Petersen at 2023-07-21T23:28:13-04:00 user_guide/flags.py: python-3.12 no longer includes distutils packaging.version seems able to handle this fine - - - - - b91bbc2b by Matthew Pickering at 2023-07-21T23:28:50-04:00 ci: Mention ~full-ci label in MR template We mention that if you need a full validation pipeline then you can apply the ~full-ci label to your MR in order to test against the full validation pipeline (like we do for marge). - - - - - 42b05e9b by sheaf at 2023-07-22T12:36:00-04:00 RTS: declare setKeepCAFs symbol Commit 08ba8720 failed to declare the dependency of keepCAFsForGHCi on the symbol setKeepCAFs in the RTS, which led to undefined symbol errors on Windows, as exhibited by the testcase frontend001. Thanks to Moritz Angermann and Ryan Scott for the diagnosis and fix. Fixes #22961 - - - - - a72015d6 by sheaf at 2023-07-22T12:36:01-04:00 Mark plugins-external as broken on Windows This test is broken on Windows, so we explicitly mark it as such now that we stop skipping plugin tests on Windows. - - - - - cb9c93d7 by sheaf at 2023-07-22T12:36:01-04:00 Stop marking plugin tests as fragile on Windows Now that b2bb3e62 has landed we are in a better situation with regards to plugins on Windows, allowing us to unmark many plugin tests as fragile. Fixes #16405 - - - - - a7349217 by Krzysztof Gogolewski at 2023-07-22T12:36:37-04:00 Misc cleanup - Remove unused RDR names - Fix typos in comments - Deriving: simplify boxConTbl and remove unused litConTbl - chmod -x GHC/Exts.hs, this seems accidental - - - - - 33b6850a by Vladislav Zavialov at 2023-07-23T10:27:37-04:00 Visible forall in types of terms: Part 1 (#22326) This patch implements part 1 of GHC Proposal #281, introducing explicit `type` patterns and `type` arguments. Summary of the changes: 1. New extension flag: RequiredTypeArguments 2. New user-facing syntax: `type p` patterns (represented by EmbTyPat) `type e` expressions (represented by HsEmbTy) 3. Functions with required type arguments (visible forall) can now be defined and applied: idv :: forall a -> a -> a -- signature (relevant change: checkVdqOK in GHC/Tc/Validity.hs) idv (type a) (x :: a) = x -- definition (relevant change: tcPats in GHC/Tc/Gen/Pat.hs) x = idv (type Int) 42 -- usage (relevant change: tcInstFun in GHC/Tc/Gen/App.hs) 4. template-haskell support: TH.TypeE corresponds to HsEmbTy TH.TypeP corresponds to EmbTyPat 5. Test cases and a new User's Guide section Changes *not* included here are the t2t (term-to-type) transformation and term variable capture; those belong to part 2. - - - - - 73b5c7ce by sheaf at 2023-07-23T10:28:18-04:00 Add test for #22424 This is a simple Template Haskell test in which we refer to record selectors by their exact Names, in two different ways. Fixes #22424 - - - - - 83cbc672 by Ben Gamari at 2023-07-24T07:40:49+00:00 ghc-toolchain: Initial commit - - - - - 31dcd26c by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 ghc-toolchain: Toolchain Selection This commit integrates ghc-toolchain, the brand new way of configuring toolchains for GHC, with the Hadrian build system, with configure, and extends and improves the first iteration of ghc-toolchain. The general overview is * We introduce a program invoked `ghc-toolchain --triple=...` which, when run, produces a file with a `Target`. A `GHC.Toolchain.Target.Target` describes the properties of a target and the toolchain (executables and configured flags) to produce code for that target * Hadrian was modified to read Target files, and will both * Invoke the toolchain configured in the Target file as needed * Produce a `settings` file for GHC based on the Target file for that stage * `./configure` will invoke ghc-toolchain to generate target files, but it will also generate target files based on the flags configure itself configured (through `.in` files that are substituted) * By default, the Targets generated by configure are still (for now) the ones used by Hadrian * But we additionally validate the Target files generated by ghc-toolchain against the ones generated by configure, to get a head start on catching configuration bugs before we transition completely. * When we make that transition, we will want to drop a lot of the toolchain configuration logic from configure, but keep it otherwise. * For each compiler stage we should have 1 target file (up to a stage compiler we can't run in our machine) * We just have a HOST target file, which we use as the target for stage0 * And a TARGET target file, which we use for stage1 (and later stages, if not cross compiling) * Note there is no BUILD target file, because we only support cross compilation where BUILD=HOST * (for more details on cross-compilation see discussion on !9263) See also * Note [How we configure the bundled windows toolchain] * Note [ghc-toolchain consistency checking] * Note [ghc-toolchain overview] Ticket: #19877 MR: !9263 - - - - - a732b6d3 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Add flag to enable/disable ghc-toolchain based configurations This flag is disabled by default, and we'll use the configure-generated-toolchains by default until we remove the toolchain configuration logic from configure. - - - - - 61eea240 by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Split ghc-toolchain executable to new packge In light of #23690, we split the ghc-toolchain executable out of the library package to be able to ship it in the bindist using Hadrian. Ideally, we eventually revert this commit. - - - - - 38e795ff by Rodrigo Mesquita at 2023-07-24T07:40:49+00:00 Ship ghc-toolchain in the bindist Add the ghc-toolchain binary to the binary distribution we ship to users, and teach the bindist configure to use the existing ghc-toolchain. - - - - - 32cae784 by Matthew Craven at 2023-07-24T16:48:24-04:00 Kill off gen_bytearray_addr_access_ops.py The relevant primop descriptions are now generated directly by genprimopcode. This makes progress toward fixing #23490, but it is not a complete fix since there is more than one way in which cabal-reinstall (hadrian/build build-cabal) is broken. - - - - - 02e6a6ce by Matthew Pickering at 2023-07-24T16:49:00-04:00 compiler: Remove unused `containers.h` include Fixes #23712 - - - - - 822ef66b by Matthew Pickering at 2023-07-25T08:44:50-04:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - e7b38ede by Matthew Pickering at 2023-07-25T08:45:28-04:00 ci-images: Bump to commit which has 9.6 image The test-bootstrap job has been failing for 9.6 because we accidentally used a non-master commit. - - - - - bb408936 by Matthew Pickering at 2023-07-25T08:45:28-04:00 Update bootstrap plans for 9.6.2 and 9.4.5 - - - - - 355e1792 by Alan Zimmerman at 2023-07-26T10:17:32-04:00 EPA: Simplify GHC/Parser.y comb4/comb5 Use the HasLoc instance from Ast.hs to allow comb4/comb5 to work with anything with a SrcSpan Also get rid of some more now unnecessary reLoc calls. - - - - - 9393df83 by Gavin Zhao at 2023-07-26T10:18:16-04:00 compiler: make -ddump-asm work with wasm backend NCG Fixes #23503. Now the `-ddump-asm` flag is respected in the wasm backend NCG, so developers can directly view the generated ASM instead of needing to pass `-S` or `-keep-tmp-files` and manually find & open the assembly file. Ideally, we should be able to output the assembly files in smaller chunks like in other NCG backends. This would also make dumping assembly stats easier. However, this would require a large refactoring, so for short-term debugging purposes I think the current approach works fine. Signed-off-by: Gavin Zhao <git at gzgz.dev> - - - - - 79463036 by Krzysztof Gogolewski at 2023-07-26T10:18:54-04:00 llvm: Restore accidentally deleted code in 0fc5cb97 Fixes #23711 - - - - - 20db7e26 by Rodrigo Mesquita at 2023-07-26T10:19:33-04:00 configure: Default missing options to False when preparing ghc-toolchain Targets This commit fixes building ghc with 9.2 as the boostrap compiler. The ghc-toolchain patch assumed all _STAGE0 options were available, and forgot to account for this missing information in 9.2. Ghc 9.2 does not have in settings whether ar supports -l, hence can't report it with --info (unliked 9.4 upwards). The fix is to default the missing information (we default "ar supports -l" and other missing options to False) - - - - - fac9e84e by Naïm Favier at 2023-07-26T10:20:16-04:00 docs: Fix typo - - - - - 503fd647 by Bartłomiej Cieślar at 2023-07-26T17:23:10-04:00 This MR is an implementation of the proposal #516. It adds a warning -Wincomplete-record-selectors for usages of a record field access function (either a record selector or getField @"rec"), while trying to silence the warning whenever it can be sure that a constructor without the record field would not be invoked (which would otherwise cause the program to fail). For example: data T = T1 | T2 {x :: Bool} f a = x a -- this would throw an error g T1 = True g a = x a -- this would not throw an error h :: HasField "x" r Bool => r -> Bool h = getField @"x" j :: T -> Bool j = h -- this would throw an error because of the `HasField` -- constraint being solved See the tests DsIncompleteRecSel* and TcIncompleteRecSel for more examples of the warning. See Note [Detecting incomplete record selectors] in GHC.HsToCore.Expr for implementation details - - - - - af6fdf42 by Arnaud Spiwack at 2023-07-26T17:23:52-04:00 Fix user-facing label in MR template - - - - - 5d45b92a by Matthew Pickering at 2023-07-27T05:46:46-04:00 ci: Test bootstrapping configurations with full-ci and on marge batches There have been two incidents recently where bootstrapping has been broken by removing support for building with 9.2.*. The process for bumping the minimum required version starts with bumping the configure version and then other CI jobs such as the bootstrap jobs have to be updated. We must not silently bump the minimum required version. Now we are running a slimmed down validate pipeline it seems worthwile to test these bootstrap configurations in the full-ci pipeline. - - - - - 25d4fee7 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Remove ghc-9_2_* plans We are anticipating shortly making it necessary to use ghc-9.4 to boot the compiler. - - - - - 2f66da16 by Matthew Pickering at 2023-07-27T05:46:46-04:00 Update bootstrap plans for ghc-platform and ghc-toolchain dependencies Fixes #23735 - - - - - c8c6eab1 by Matthew Pickering at 2023-07-27T05:46:46-04:00 bootstrap: Disable -selftest flag from bootstrap plans This saves on building one dependency (QuickCheck) which is unecessary for bootstrapping. - - - - - a80ca086 by Bodigrim at 2023-07-27T05:47:26-04:00 Link reference paper and package from System.Mem.{StableName,Weak} - - - - - a5319358 by David Knothe at 2023-07-28T13:13:10-04:00 Update Match Datatype EquationInfo currently contains a list of the equation's patterns together with a CoreExpr that is to be evaluated after a successful match on this equation. All the match-functions only operate on the first pattern of an equation - after successfully matching it, match is called recursively on the tail of the pattern list. We can express this more clearly and make the code a little more elegant by updating the datatype of EquationInfo as follows: data EquationInfo = EqnMatch { eqn_pat = Pat GhcTc, eqn_rest = EquationInfo } | EqnDone { eqn_rhs = MatchResult CoreExpr } An EquationInfo now explicitly exposes its first pattern which most functions operate on, and exposes the equation that remains after processing the first pattern. An EqnDone signifies an empty equation where the CoreExpr can now be evaluated. - - - - - 86ad1af9 by David Binder at 2023-07-28T13:13:53-04:00 Improve documentation for Data.Fixed - - - - - f8fa1d08 by Ben Gamari at 2023-07-28T13:14:31-04:00 ghc-prim: Use C11 atomics Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*` family of C builtins. Here we refactor these to rather use the appropriate C11 atomic equivalents, allowing us to be more explicit about the expected ordering semantics. - - - - - 0bfc8908 by Finley McIlwaine at 2023-07-28T18:46:26-04:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 40425c50 by Andreas Klebinger at 2023-07-28T18:47:02-04:00 Aarch64 NCG: Use encoded immediates for literals. Try to generate instr x2, <imm> instead of mov x1, lit instr x2, x1 When possible. This get's rid if quite a few redundant mov instructions. I believe this causes a metric decrease for LargeRecords as we reduce register pressure. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - e9a0fa3f by Bodigrim at 2023-07-28T18:47:42-04:00 Bump filepath submodule to 1.4.100.4 Resolves #23741 Metric Decrease: MultiComponentModules MultiComponentModulesRecomp MultiLayerModules MultiLayerModulesRecomp T10421 T12234 T12425 T13035 T13701 T13719 T16875 T18304 T18698a T18698b T21839c T9198 TcPlugin_RewritePerf hard_hole_fits Metric decrease on Windows can be probably attributed to https://github.com/haskell/filepath/pull/183 - - - - - ee93edfd by Bodigrim at 2023-07-28T18:48:21-04:00 Add since pragmas to GHC.IO.Handle.FD - - - - - d0369802 by Simon Peyton Jones at 2023-07-30T09:24:48+01:00 Make the occurrence analyser smarter about join points This MR addresses #22404. There is a big Note Note [Occurrence analysis for join points] that explains it all. Significant changes * New field occ_join_points in OccEnv * The NonRec case of occAnalBind splits into two cases: one for existing join points (which does the special magic for Note [Occurrence analysis for join points], and one for other bindings. * mkOneOcc adds in info from occ_join_points. * All "bring into scope" activity is centralised in the new function `addInScope`. * I made a local data type LocalOcc for use inside the occurrence analyser It is like OccInfo, but lacks IAmDead and IAmALoopBreaker, which in turn makes computationns over it simpler and more efficient. * I found quite a bit of allocation in GHC.Core.Rules.getRules so I optimised it a bit. More minor changes * I found I was using (Maybe Arity) a lot, so I defined a new data type JoinPointHood and used it everwhere. This touches a lot of non-occ-anal files, but it makes everything more perspicuous. * Renamed data constructor WithUsageDetails to WUD, and WithTailUsageDetails to WTUD This also fixes #21128, on the way. --------- Compiler perf ----------- I spent quite a time on performance tuning, so even though it does more than before, the occurrence analyser runs slightly faster on average. Here are the compile-time allocation changes over 0.5% CoOpt_Read(normal) ghc/alloc 766,025,520 754,561,992 -1.5% CoOpt_Singletons(normal) ghc/alloc 759,436,840 762,925,512 +0.5% LargeRecord(normal) ghc/alloc 1,814,482,440 1,799,530,456 -0.8% PmSeriesT(normal) ghc/alloc 68,159,272 67,519,720 -0.9% T10858(normal) ghc/alloc 120,805,224 118,746,968 -1.7% T11374(normal) ghc/alloc 164,901,104 164,070,624 -0.5% T11545(normal) ghc/alloc 79,851,808 78,964,704 -1.1% T12150(optasm) ghc/alloc 73,903,664 71,237,544 -3.6% GOOD T12227(normal) ghc/alloc 333,663,200 331,625,864 -0.6% T12234(optasm) ghc/alloc 52,583,224 52,340,344 -0.5% T12425(optasm) ghc/alloc 81,943,216 81,566,720 -0.5% T13056(optasm) ghc/alloc 294,517,928 289,642,512 -1.7% T13253-spj(normal) ghc/alloc 118,271,264 59,859,040 -49.4% GOOD T15164(normal) ghc/alloc 1,102,630,352 1,091,841,296 -1.0% T15304(normal) ghc/alloc 1,196,084,000 1,166,733,000 -2.5% T15630(normal) ghc/alloc 148,729,632 147,261,064 -1.0% T15703(normal) ghc/alloc 379,366,664 377,600,008 -0.5% T16875(normal) ghc/alloc 32,907,120 32,670,976 -0.7% T17516(normal) ghc/alloc 1,658,001,888 1,627,863,848 -1.8% T17836(normal) ghc/alloc 395,329,400 393,080,248 -0.6% T18140(normal) ghc/alloc 71,968,824 73,243,040 +1.8% T18223(normal) ghc/alloc 456,852,568 453,059,088 -0.8% T18282(normal) ghc/alloc 129,105,576 131,397,064 +1.8% T18304(normal) ghc/alloc 71,311,712 70,722,720 -0.8% T18698a(normal) ghc/alloc 208,795,112 210,102,904 +0.6% T18698b(normal) ghc/alloc 230,320,736 232,697,976 +1.0% BAD T19695(normal) ghc/alloc 1,483,648,128 1,504,702,976 +1.4% T20049(normal) ghc/alloc 85,612,024 85,114,376 -0.6% T21839c(normal) ghc/alloc 415,080,992 410,906,216 -1.0% GOOD T4801(normal) ghc/alloc 247,590,920 250,726,272 +1.3% T6048(optasm) ghc/alloc 95,699,416 95,080,680 -0.6% T783(normal) ghc/alloc 335,323,384 332,988,120 -0.7% T9233(normal) ghc/alloc 709,641,224 685,947,008 -3.3% GOOD T9630(normal) ghc/alloc 965,635,712 948,356,120 -1.8% T9675(optasm) ghc/alloc 444,604,152 428,987,216 -3.5% GOOD T9961(normal) ghc/alloc 303,064,592 308,798,800 +1.9% BAD WWRec(normal) ghc/alloc 503,728,832 498,102,272 -1.1% geo. mean -1.0% minimum -49.4% maximum +1.9% In fact these figures seem to vary between platforms; generally worse on i386 for some reason. The Windows numbers vary by 1% espec in benchmarks where the total allocation is low. But the geom mean stays solidly negative, which is good. The "increase/decrease" list below covers all platforms. The big win on T13253-spj comes because it has a big nest of join points, each occurring twice in the next one. The new occ-anal takes only one iteration of the simplifier to do the inlining; the old one took four. Moreover, we get much smaller code with the new one: New: Result size of Tidy Core = {terms: 429, types: 84, coercions: 0, joins: 14/14} Old: Result size of Tidy Core = {terms: 2,437, types: 304, coercions: 0, joins: 10/10} --------- Runtime perf ----------- No significant changes in nofib results, except a 1% reduction in compiler allocation. Metric Decrease: CoOpt_Read T13253-spj T9233 T9630 T9675 T12150 T21839c LargeRecord MultiComponentModulesRecomp T10421 T13701 T10421 T13701 T12425 Metric Increase: T18140 T9961 T18282 T18698a T18698b T19695 - - - - - 42aa7fbd by Julian Ospald at 2023-07-30T17:22:01-04:00 Improve documentation around IOException and ioe_filename See: * https://github.com/haskell/core-libraries-committee/issues/189 * https://github.com/haskell/unix/pull/279 * https://github.com/haskell/unix/pull/289 - - - - - e3f9adcf by Ben Gamari at 2023-07-31T16:08:04-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 29 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Wasm.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/afa124964e176db1d547d28f952bc86c63214395...e3f9adcfe544b75478c042754501b6e43a9d5841 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/afa124964e176db1d547d28f952bc86c63214395...e3f9adcfe544b75478c042754501b6e43a9d5841 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 20:09:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 31 Jul 2023 16:09:01 -0400 Subject: [Git][ghc/ghc][wip/unzip-deprecation] base: Push back deprecation of Data.List.NonEmpty.unzip Message-ID: <64c814dd40947_2f120013c825e034541@gitlab.mail> Ben Gamari pushed to branch wip/unzip-deprecation at Glasgow Haskell Compiler / GHC Commits: 8de88df5 by Ben Gamari at 2023-07-31T16:08:51-04:00 base: Push back deprecation of Data.List.NonEmpty.unzip As noted in #23640, !10189 didn't quite make GHC 9.8 and therefore will need to be pushed back by a release. - - - - - 1 changed file: - libraries/base/changelog.md Changes: ===================================== libraries/base/changelog.md ===================================== @@ -1,5 +1,8 @@ # Changelog for [`base` package](http://hackage.haskell.org/package/base) +## 4.20.0.0 *TBA* + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) + ## 4.19.0.0 *TBA* * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`. Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it. @@ -34,7 +37,6 @@ * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) * Make `Semigroup`'s `stimes` specializable. ([CLC proposal #8](https://github.com/haskell/core-libraries-committee/issues/8)) - * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8de88df5d22a8ad3e8672323750d3a984b58485b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8de88df5d22a8ad3e8672323750d3a984b58485b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 20:44:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 31 Jul 2023 16:44:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/thunk-note Message-ID: <64c81d3d3698a_2f1200ba3c436057a@gitlab.mail> Ben Gamari pushed new branch wip/thunk-note at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/thunk-note You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 20:45:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 31 Jul 2023 16:45:39 -0400 Subject: [Git][ghc/ghc][wip/thunk-note] Initial commit of Note [Thunks, blackholes, and indirections] Message-ID: <64c81d73a2ae0_2f120013c5236836408a@gitlab.mail> Ben Gamari pushed to branch wip/thunk-note at Glasgow Haskell Compiler / GHC Commits: d34a358a by Ben Gamari at 2023-07-31T16:45:33-04:00 Initial commit of Note [Thunks, blackholes, and indirections] This Note attempts to summarize the treatment of thunks, thunk update, and indirections. This fell out of work on #23185. - - - - - 1 changed file: - rts/Updates.h Changes: ===================================== rts/Updates.h ===================================== @@ -12,6 +12,406 @@ #include "BeginPrivate.h" #endif +/* Note [Thunks, blackholes, and indirections] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Consider the following STG binding: + * + * thnk = {fv_0, fv_1} \u [] g x y; + * + * This binding is a updatable thunk carrying free variables `fv_0` and `fv_1`. + * Over its lifetime, this closure may transition through three states: + * + * 1. it starts life as a thunk, which carries with it free variables + * 2. if a thread enters it, it may turn into a blackhole + * 3. if evaluation finishes, it will be "updated", turning it into an + * indirection pointing to the result of the evaluation + * + * On the heap, state (1) is represented as a closure with the following layout + * (embodied in the C runtime by the `StgThunk` struct): + * + * thnk + * ┌───────────────────────┐ ╮ + * │ blah_info │ │ + * ├────────────┬──────────┤ │ StgThunkHeader + * │ indirectee │ NULL │ │ + * ├────────────┼──────────┤ ╯ + * │ payload[0] │ fv_0 │ + * ├────────────┼──────────┤ + * │ payload[1] │ fv_1 │ + * └────────────┴──────────┘ + * + * Here `blah_info` is a pointer to the thunk's info table, which will be of + * type THUNK. The `indirectee` field (also known as the "SMP header") is + * initially NULL and is unused while the closure remains a thunk. However, as + * we will see, it will eventually point to the result of the thunk's + * evaluation. + * + * + * Entry + * ----- + * As usual, to enter `thnk` (step (2) of the lifetime) a mutator thread + * `tso_0` will jump to its entry code (which is recorded in or next to its + * info table, depending upon whether tables-next-to-code is enabled). This + * entry code will push an "update frame" (namely, either `stg_upd_frame` or + * `stg_bh_upd_frame`) to `tso_0`'s stack and begin the evaluation of the + * thunk's RHS. + * + * However, before commencing evaluation, the entry code may also mark the + * thunk as being under evaluation; this process is known a "blackholing". + * Whether this happens depends upon which of GHC's two blackholing strategies + * which was selected during the compilation of the defining module. We will + * discuss the simpler "eager blackholing" case first and later introduce the + * more-efficient "lazy blackholing" strategy. + * + * + * Eager blackholing + * ----------------- + * Under the eager blackholing strategy (which is enabled via the + * `-feager-blackholing` flag), a thunk's entry code (generated by + * `GHC.StgToCmm.Bind.emitBlackHoleCode`) will immediately turn the thunk into + * a blackhole, indicating that the thunk is under evaluation. Additionally, + * the indirectee field will be updated to point to the thread performing the + * evaluation, `tso_0`. Since we know statically that the thunk is now a + * `BLACKHOLE`, the thunk entry code will push an `stg_bh_upd_frame` to the + * stack in this case (in contrast to the lazy strategy, as we will see later). + * + * After this `thnk` will look like, + * + * thnk + * ┌───────────────────────┐ + * │ EAGER_BLACKHOLE_info │ + * ├────────────┬──────────┤ tso_0 + * │ indirectee │ tso_0 │─────────►┌──────┐ + * ├────────────┼──────────┤ │ ... │ + * │ payload[0] │ fv_0 │ └──────┘ + * ├────────────┼──────────┤ + * │ payload[1] │ fv_1 │ + * └────────────┴──────────┘ + * + * Note that blackholing in this way does not guarantee mutual exclusion: Two + * threads may indeed race to enter `thnk`. This will result in both threads + * performing evaluation and, in some cases, the blackhole being updated + * multiple times. + * + * + * Updating a thunk + * ---------------- + * When `tso_0` finishes the evaluation of `thnk`, it will return to the entry + * code of the update frame pushed when the thunk was entered (e.g. + * `stg_bh_upd_frame`). This code first checks whether the blackhole + * has already been updated by another thread; if it has then `tso_0` will + * throw out its result and reuse that which the earlier thread recorded in the + * blackhole's `indirectee` field. + * + * If the blackhole has not yet been updated then `tso_0` will: + * + * 1. set `thnk`'s `indirectee` field to point to the result of its + * evaluation, and + * 2. set its info table to `BLACKHOLE_info` + * + * N.B. You might notice that step (2) here appears to be redundant as we + * already set the info table pointer to `EAGER_BLACKHOLE_info` above. However, + * as we will see below, this may not be the case when lazy blackholing is in + * use. + * + * After these updates we will have the following: + * + * thnk + * ┌───────────────────────┐ + * │ BLACKHOLE_info │ + * ├────────────┬──────────┤ result + * │ indirectee │ result │─────────►┌────────┐ + * ├────────────┼──────────┤ │ ... │ + * │ payload[0] │ fv_0 │ └────────┘ + * ├────────────┼──────────┤ + * │ payload[1] │ fv_1 │ + * └────────────┴──────────┘ + * + * In addition, the code will check the blocking queues that were added to the + * blackhole (recorded in the `indirectee` field, as we will see below) and + * wake them up (see `Threads.c:updateThunk`). + * + * Note that we are using `BLACKHOLE_info` to represent two distinct states of + * a thunk: + * + * - if the indirectee points to a `TSO` or `BLOCKING_QUEUE`, then the + * `BLACKHOLE` represents a thunk currently being evaluated + * + * - otherwise `BLACKHOLE` is merely representing an evaluated thunk and + * serves as an indirection to the final result. + * + * This overloading may seem odd given that we also have `stg_IND_info`, which + * also represents an indirection. However, the overloading serves a purpose: + * it means that safely updating a blackhole (step (3) of the lifetime above) + * requires only a single store (namely the store to the `indirectee` field). + * + * If we were to instead use `stg_IND` to represent the updated thunk, we would + * require two stores and consequently have an awkward period where the info + * table and indirectee fields are inconsistent: + * + * - if we were to update the info table first, there would be a period where + * the `indirectee` field pointed to the TSO which did the evaluation and + * not the result as one would expect. + * + * - if we were to update the indirectee first, there would be a period where + * the closure is still a `BLACKHOLE_info` yet the indirectee points to the + * evaluation result. + * + * For this reason, it is simpler to use `BLACKHOLE` to represent both states + * (2) and (3), distinguishing them using the identity of the indirectee. The + * uses of `stg_IND` are few and will be discussed below. + * + * + * Lazy blackholing + * ---------------- + * While the strict blackholing strategy described above is simple and is + * faithful to the semantics of the STG machine, it is fairly costly on modern + * hardware. Specifically, thunk entry can be extremely common and in a + * parallel program blackholing may induce considerable pressure on the + * machine's memory subsystem. + * + * To mitigate this GHC by default uses a lazy blackholing strategy. Here we + * take advantage of the fact that redundant evaluation of a thunk is + * acceptable and defer blackholing until the thread returns to the scheduler. + * This is an optimisation as frequently we will finish evaluation *before* + * yielding; in this case we avoid incurring the memory writes necessary to + * blackhole the thunk (step (2)) and rather update the thunk straight to an + * indirection. + * + * When entering a thunk compiled with lazy blackholing, we push an + * `stg_upd_frame` (not `stg_upd_bh_frame`) frame to the stack and do not + * modify the thunk closure itself. + * + * If the thread yields before finishing evaluation, the thunk will be turned + * into a `BLACKHOLE` in `ThreadPaused.c:threadPaused`. This function traverses + * the stack of the yielding thread looking for update frames; when such a + * frame is encountered, it checks the info table of the updatee and: + * + * - if it is `BLACKHOLE` then thunk has already been claimed for evaluation + * by another thread and the yielding thread is instead added to the + * `BLACKHOLE`'s blocking queue (see Note [suspend duplicate work] in + * `ThreadPaused.c`). + * + * - if not, then it blackholes the thunk as done in eager blackholing (but + * using the `BLACKHOLE_info` info table instead of `EAGER_BLACKHOLE_info`). + * + * Update frames processed in this manner are rewritten to become + * `stg_marked_upd_frame`s. The stack traversal continues until a + * `stg_marked_upd_frame_info` frame is encountered, at which point we know + * that all subsequent frames have already been processed in a previous yield. + * + * The entry code of `stg_upd_frame` is considerably simpler than that of + * `stg_bh_upd_frame` since we know that the thunk has not accumulated any + * `BLOCKING_QUEUE`s in need of waking (since it was never blackhole'd). This + * is itself a small optimisation for the common case of uncontended thunk + * update. By contrast, the entry code of `stg_marked_upd_frame` is identical + * to that of `stg_bh_upd_frame` and must deal with waking of blocked threads. + * + * See `Note [suspend duplicate work]` in `ThreadPaused.c` for a subtle case + * involving the interaction between lazy and eager blackholing. + * + * See `Note [upd-black-hole]` in `Scav.c` for another subtle case. + * + * + * Blocking on a blackhole'd thunk + * ------------------------------- + * If another thread `tso_1` enters `thnk` while it is blackholed by `tso_0`, + * the entry code of `BLACKHOLE` will allocate a `MSG_BLACKHOLE` object + * `msg_bh_0`. This message will be sent to the capability where the thread + * owning the thunk resides (see `Messages.c:messageBlackHole`). This + * capability will allocate a `BLOCKING_QUEUE` object `bq_0` recording the fact + * that `tso_1` is waiting for the result of `thnk`'s evaluation and link it to + * `thnk` as follows: + * + * thnk + * ┌─►┌───────────────────────┐ + * │ │ EAGER_BLACKHOLE_info │ + * │ ├────────────┬──────────┤ + * │ │ indirectee │ bq_0 ├──────┐ + * │ ├────────────┼──────────┤ │ + * │ │ payload[0] │ fv_0 │ │ + * │ ├────────────┼──────────┤ │ + * │ │ payload[1] │ fv_1 │ │ + * │ └────────────┴──────────┘ │ + * │ │ msg_bh_0 + * │ ┌───────────────────────────┘ ┌──►┌───────────────────────────┐ + * │ │ │ │ MSG_BLACKHOLE_info │ + * │ │ │ ├───────────┬───────────────┤ + * │ │ bq_0 │ │ link │ END_TSO_QUEUE │ + * │ └─►┌──────────────────────┐ │ ├───────────┼───────────────┤ + * │ │ BLOCKING_QUEUE_info │ │ │ result │ NULL │ + * │ ├───────────┬──────────┤ │ ├───────────┼───────────────┤ tso_1 + * │ │ link │ NULL │ │ │ tso │ tso_1 ├────►┌──────┐ + * │ ├───────────┼──────────┤ │ └───────────┴───────────────┘ │ ... │ + * │ │ queue │ msg_bh_0 ├────┘ └──────┘ + * │ ├───────────┼──────────┤ tso_0 + * │ │ owner │ tso_0 ├───────►┌──────┐ + * │ ├───────────┼──────────┤ │ ... │ + * │ │ bh │ thnk ├────┐ └──────┘ + * │ └───────────┴──────────┘ │ + * │ │ + * └────────────────────────────────────┘ + * + * Additionally, the `BLOCKING_QUEUE` is added to the `bq` list of the owning + * TSO, which collects all blocking queue objects which are blocked on thunks + * owned by the thread. + * + * In addition to this book-keeping, the `MSG_BLACKHOLE` message result in + * `tso_0` being promoted in its capability's run queue in the hope that + * `tso_1` and other blocked threads may be unblocked more quickly. + * + * + * Waking up blocking queues + * ------------------------- + * As noted above, when a thread updates a `BLACKHOLE`'d thunk it may find that + * some threads have added themselves to the thunk's blocking queue. Naturally, + * we must ensure that these threads are woken up. However, this gets a bit + * subtle since multiple threads may have raced to enter the thunk. + * + * That is, we may end up in a situation like one of these (TODO audit): + * + * ### Race A + * + * Thread 0 Thread 1 Thread 2 + * -------------------------- -------------------------- ---------------------- + * enter thnk + * enter thnk + * thnk.indirectee := tso_0 + * thnk.indirectee := tso_1 + * thnk.info := BLACKHOLE + * thnk.info := BLACKHOLE + * enter, block on thnk + * send MSG_BLACKHOLE to tso_1->cap + * finishes evaluation + * thnk.indirectee := result + * handle MSG_BLACKHOLE + * add + * + * ### Race B + * + * Thread 0 Thread 1 Thread 2 + * -------------------------- -------------------------- ---------------------- + * enter thnk + * enter thnk + * thnk.indirectee := tso_0 + * thnk.indirectee := tso_1 + * thnk.info := BLACKHOLE + * thnk.info := BLACKHOLE + * enter, block on thnk + * send MSG_BLACKHOLE to tso_1->cap + * handle MSG_BLACKHOLE + * add + * finishes evaluation + * thnk.indirectee := result + * + * ### Race C + * + * Thread 0 Thread 1 Thread 2 + * -------------------------- -------------------------- ---------------------- + * enter thnk + * enter thnk + * thnk.indirectee := tso_0 + * thnk.info := BLACKHOLE + * enter, block on thnk + * send MSG_BLACKHOLE to tso_0->cap + * handle MSG_BLACKHOLE + * thnk.indirectee := + * new BLOCKING_QUEUE + * + * thnk.indirectee := tso_1 + * thnk.info := BLACKHOLE + * + * Exception handling + * ------------------ + * When an exception is thrown to a thread which is evaluating a thunk, it is + * important that we put things back into a state in which evaluation can + * be resumed by another thread. This is done by + * `RaiseAsync.c:raiseAsync` which walks the stack looking for update + * frames and rewrites the updatees into indirections pointing to an + * `AP_STACK` closure recording the aborted execution state. + * See `RaiseAsync.c:raiseAsync` for details. + * + * + * CAFs + * ---- + * Top-level thunks (CAFs) reuse much of this machinery. The only differences + * are: + * + * - CAF entry ensures mutual exclusion (see `Note [atomic CAF entry]` + * in `Storage.c` for why) + * + * - we have a distinct blackhole type, `stg_CAF_BLACKHOLE_info`; it is not + * clear that maintaining this distinction from `stg_EAGER_BLACKHOLE_info` + * is strictly necessary. + * + * See `Note [CAF management]` in `Storage.c` . + * + * + * Memory ordering + * --------------- + * The memory orderings necessary for safe concurrent thunk evaluation + * are rather subtle and described in Note [Heap memory barriers] in `SMP.h`. + * + * + * The uses of `stg_IND` + * --------------------- + * As noted above, `stg_IND_info` is not used for thunk evaluation. Instead, it + * merely serves as a general-purpose indirection in a few miscellaneous cases: + * + * * it is used to "short-out" `BLOCKING_QUEUE`s and `MVAR_TSO_QUEUES` that have + * already been woken-up. See Note [BLACKHOLE pointing to IND] in `Evac.c`. + * + * * It is used to perform indirection of selector thunks (see + * `Evac.c:unchain_thunk_selectors`). + * + * + * Indirection shortcutting + * ------------------------ + * Note that the garbage collector can "shortcut" both `IND` and + * `BLACKHOLE` indirections. That is, the heap: + * + * ref + * ┌──────────┐ evald_thunk + * │ ├────────►┌───────────────┬──────┐ + * └──────────┘ │ stg_IND_info │ │ + * ├───────────────┼──────┤ x + * │ indirectee │ ├────────►┌──────────────┐ + * └───────────────┴──────┘ │ ... │ + * │ │ + * └──────────────┘ + * Can be rewritten to: + * + * ref ┌────────────────────────────────────┐ + * ┌──────────┐ │ evald_thunk │ + * │ ├────┘ ┌───────────────┬──────┐ │ + * └──────────┘ │ stg_IND_info │ │ │ + * ├───────────────┼──────┤ ▼ x + * │ indirectee │ ├────────►┌──────────────┐ + * └───────────────┴──────┘ │ ... │ + * │ │ + * └──────────────┘ + * + * + * Selector optimisation + * --------------------- + * In addition to shortcutting indirections, the garbage collector can do a + * limited form of evaluation known as the "selector optimisation" + * [Wadler1987]. Specifically, the GC knows to rewrite a certain class of thunk + * (so-called "selector thunks", which are applications of selector functions + * like `fst`) into their result. For instance, given + * + * x = (a,b) + * y = fst x + * + * the GC can rewrite `y` into an indirection to `a`. References to `y` can + * then be further shortcutted via indirection shortcutting as described above. + * + * + * [Wadler1987]: + * Wadler, P. (1987), Fixing some space leaks with a garbage collector. Softw: Pract. Exper., 17: 595-608. https://doi.org/10.1002/spe.4380170904 + */ + + /* ----------------------------------------------------------------------------- Updates -------------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d34a358a6bfa8144ed602e793db4941107f9b921 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d34a358a6bfa8144ed602e793db4941107f9b921 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 20:53:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 31 Jul 2023 16:53:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 20 commits: JS: implement getMonotonicTime (fix #23687) Message-ID: <64c81f4ab9afe_2f1200ba3c43829d7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 909a2cf3 by Sylvain Henry at 2023-07-31T16:52:01-04:00 JS: implement getMonotonicTime (fix #23687) - - - - - fd514d64 by Bartłomiej Cieślar at 2023-07-31T16:52:04-04:00 Implementation of the Deprecated Instances proposal #575 This commit implements the ability to deprecate certain instances, which causes the compiler to emit the desired deprecation message whenever they are instantiated. For example: module A where class C t where instance {-# DEPRECATED "dont use" #-} C Int where module B where import A f :: C t => t f = undefined g :: Int g = f -- "dont use" emitted here The implementation is as follows: - In the parser, we parse deprecations/warnings attached to instances: instance {-# DEPRECATED "msg" #-} Show X deriving instance {-# WARNING "msg2" #-} Eq Y (Note that non-standalone deriving instance declarations do not support this mechanism.) - We store the resulting warning message in `ClsInstDecl` (respectively, `DerivDecl`). In `GHC.Tc.TyCl.Instance.tcClsInstDecl` (respectively, `GHC.Tc.Deriv.Utils.newDerivClsInst`), we pass on that information to `ClsInst` (and eventually store it in `IfaceClsInst` too). - Finally, when we solve a constraint using such an instance, in `GHC.Tc.Instance.Class.matchInstEnv`, we emit the appropriate warning that was stored in `ClsInst`. Note that we only emit a warning when the instance is used in a different module than it is defined, which keeps the behaviour in line with the deprecation of top-level identifiers. Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 4f4af4b5 by Matthew Pickering at 2023-07-31T16:52:04-04:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - abe68d62 by Ben Gamari at 2023-07-31T16:52:05-04:00 compiler: Style fixes - - - - - 6eb61e8c by Ben Gamari at 2023-07-31T16:52:05-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 5141a516 by Ben Gamari at 2023-07-31T16:52:05-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - 9d4f9af7 by Ben Gamari at 2023-07-31T16:52:05-04:00 testsuite: Add AtomicModifyIORef test - - - - - a1e53ab0 by Ben Gamari at 2023-07-31T16:52:05-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 0eac0768 by Ben Gamari at 2023-07-31T16:52:05-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 4ca661f7 by Ben Gamari at 2023-07-31T16:52:05-04:00 rts: Introduce more principled fence operations - - - - - c2bbdd24 by Ben Gamari at 2023-07-31T16:52:06-04:00 rts: Introduce SET_INFO_RELAXED - - - - - 0a8c809f by Ben Gamari at 2023-07-31T16:52:06-04:00 rts: Style fixes - - - - - b71528af by Ben Gamari at 2023-07-31T16:52:06-04:00 codeGen/tsan: Rework handling of spilling - - - - - 3eab8981 by Ben Gamari at 2023-07-31T16:52:06-04:00 hadrian: More debug information - - - - - 28145b04 by Ben Gamari at 2023-07-31T16:52:06-04:00 Improve TSAN documentation - - - - - eb970b0e by Ben Gamari at 2023-07-31T16:52:06-04:00 hadrian: More selective TSAN instrumentation - - - - - 0bb97c64 by Alan Zimmerman at 2023-07-31T16:52:07-04:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. Metric Decrease: T9961 T5205 Metric Increase: T13035 - - - - - 2c1dddef by Bartłomiej Cieślar at 2023-07-31T16:52:11-04:00 Add cases to T23279: HasField for deprecated record fields This commit adds additional tests from ticket #23279 to ensure that we don't regress on reporting deprecated record fields in conjunction with HasField, either when using overloaded record dot syntax or directly through `getField`. Fixes #23279 - - - - - e799483d by Andreas Klebinger at 2023-07-31T16:52:11-04:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - 929bb674 by Andreas Klebinger at 2023-07-31T16:52:12-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Unit/Module/Warnings.hs - docs/users_guide/exts/pragmas.rst - hadrian/ghci-cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3f5762cd907191ee8d8c884e4efb2609272ceb4...929bb674489e31e1f28d09d801c8ff79ad58c0fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3f5762cd907191ee8d8c884e4efb2609272ceb4...929bb674489e31e1f28d09d801c8ff79ad58c0fe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 22:43:55 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 31 Jul 2023 18:43:55 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Try effect of Message-ID: <64c8392b29f0_2f120013c52368408914@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: d8cb0ea9 by Simon Peyton Jones at 2023-07-31T23:33:52+01:00 Try effect of * making multi-branch cases not work free (fixes #22423) * use plan A for dataToTag and tagToEnum - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify/Inline.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Inline.hs ===================================== @@ -214,7 +214,7 @@ Reflections and wrinkles * See also Note [Do not add unfoldings to join points at birth] in GHC.Core.Opt.Simplify.Iteration -* The case total case depth is really the wrong thing; it will inhibit inlining of a +* The total case depth is really the wrong thing; it will inhibit inlining of a local function, just because there is some giant case nest further out. What we want is the /difference/ in case-depth between the binding site and the call site. That could be done quite easily by adding the case-depth to the Unfolding of the ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -59,7 +59,7 @@ import GHC.Types.Basic import GHC.Types.Tickish import GHC.Types.Var ( isTyCoVar ) import GHC.Types.Var.Set -import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) +import GHC.Builtin.PrimOps ( PrimOp (SeqOp, DataToTagOp, TagToEnumOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) @@ -3783,7 +3783,8 @@ mkDupableContWithDmds env _ where thumbsUpPlanA (StrictBind {}) = True thumbsUpPlanA (Stop {}) = True - thumbsUpPlanA (Select {}) = False -- Using Plan B benefits carryPropagate + thumbsUpPlanA (Select {}) = dup_fun fun +-- False -- Using Plan B benefits carryPropagate -- in nofib digits-of-e2 thumbsUpPlanA (StrictArg {}) = False thumbsUpPlanA (CastIt { sc_cont = k }) = thumbsUpPlanA k @@ -3791,6 +3792,14 @@ mkDupableContWithDmds env _ thumbsUpPlanA (ApplyToVal { sc_cont = k }) = thumbsUpPlanA k thumbsUpPlanA (ApplyToTy { sc_cont = k }) = thumbsUpPlanA k + dup_fun fun | Just op <- isPrimOpId_maybe (ai_fun fun) + = case op of + DataToTagOp -> True + TagToEnumOp -> True + _ -> False + | otherwise + = False + mkDupableContWithDmds env dmds (ApplyToTy { sc_cont = cont, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) = do { (floats, cont') <- mkDupableContWithDmds env dmds cont @@ -3955,8 +3964,7 @@ mkDupableAlt _env case_bndr jfloats (Alt con alt_bndrs alt_rhs_in) -- See Note [Duplicated env] ok_to_dup_alt :: OutId -> [OutVar] -> OutExpr -> Bool --- See Note [Duplicating alternatives] --- and Note [Duplicating join points] esp point (2) +-- See Note [Duplicating join points] esp points (DJ2,DJ3) ok_to_dup_alt case_bndr alt_bndrs alt_rhs | exprIsTrivial alt_rhs = True -- Includes things like (case x of {}) @@ -3964,7 +3972,7 @@ ok_to_dup_alt case_bndr alt_bndrs alt_rhs | (Var v, args) <- collectArgs alt_rhs , all exprIsTrivial args = if isJust (isDataConId_maybe v) - then -- See Note [Duplicating join points] for the + then -- See Note [Duplicating join points] (DJ3) for the -- reason for this apparently strange test exprsFreeIds args `subVarSet` bndr_set else True -- Duplicating a simple call (f a b c) is fine, @@ -4016,7 +4024,7 @@ Wrinkle where $j is a freshly-born join point. After case-of-known-constructor wo we end up substituting (join $j x = in jblah) for `y` in `blah`; and thus we re-simplify that join binding. In test T15630 this results in - masssive duplication. + massive duplication. So in `simplLetUnfolding` we spot this case a bit hackily; a freshly-born join point will have OccInfo of ManyOccs, unlike an existing join point which @@ -4027,30 +4035,6 @@ I can't quite articulate precisely why this is so important. But it makes a MAS difference in T15630 (a fantastic test case); and at worst it'll merely delay inlining join points by one simplifier iteration. -Note [Duplicating alternatives] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When should we duplicate an alternative, and when should we make a join point? -We don't want to make a join point if it will /definitely/ be inlined; that -just takes extra work to build, and an extra Simplifier iteration to do the -inlining. So consider - - case (case x of True -> e2; False -> e2) of - K1 a b -> f b a - K2 x -> g x v - K3 v -> Just v - -The (f b a) would turn into a join point like - $j1 a b = f b a -which would immediately inline again because the call is not smaller than the RHS. -On the other hand, the (g x v) turns into - $j2 x = g x v -which won't imediately inline, because the call $j2 x is smaller than the RHS -(g x v). Finally the (Just v) would turn into - $j3 v = Just v -and you might think that would immediately inline. - -TODO -- more here - Note [Fusing case continuations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's important to fuse two successive case continuations when the @@ -4094,7 +4078,7 @@ inlining join points. Consider K g y -> blah[g,y] Here the join-point RHS is very small, just a constructor -application (K x y). So we might inline it to get +application (K f x). So we might inline it to get case (case v of ) ( p1 -> K f x1 ) of ( p2 -> K f x2 ) @@ -4115,50 +4099,55 @@ what `f` is, instead of lambda-abstracting over it. To achieve this: -1. Do not postInlineUnconditionally a join point, ever. Doing +(DJ1) Do not postInlineUnconditionally a join point, ever. Doing postInlineUnconditionally is primarily to push allocation into cold branches; but a join point doesn't allocate, so that's a non-motivation. -2. In mkDupableAlt and mkDupableStrictBind, generate an alterative for all - alternatives, except for exprIsTrival RHSs (see `ok_to_dup_alt`). Previously - we used exprIsDupable. This generates a lot more join points, but makes them - much more case-of-case friendly. - - We are happy to duplicate - j a b = K b a - where all the arguments of the constructor are parameters of the join point - because then the "massive difference" described above can't happen. - - It is definitely worth checking for exprIsTrivial, otherwise we get - an extra Simplifier iteration, because it is inlined in the next - round. - -3. By the same token we want to use Plan B in - Note [Duplicating StrictArg] when the RHS of the new join point - is a data constructor application. See the call to isDataConId in - the StrictArg case of mkDupableContWithDmds. - - That same Note [Duplicating StrictArg] explains why we sometimes - want Plan A when the RHS of the new join point would be a - non-data-constructor application - -4. You might worry that $j will be inlined by the call-site inliner, - but it won't because the call-site context for a join is usually - extremely boring (the arguments come from the pattern match). - And if not, then perhaps inlining it would be a good idea. - - You might also wonder if we get UnfWhen, because the RHS of the - join point is no bigger than the call. But in the cases we care - about it will be a little bigger, because of that free `f` in - $j x = K f x - So for now we don't do anything special in callSiteInline - -There is a bit of tension between (2) and (3). Do we want to retain +(DJ2) In mkDupableAlt and mkDupableStrictBind, generate an alterative for /all/ + alternatives, /except/ for ones that will definitely inline unconditionally + straight away. (In that case it's silly to make a join point in the first + place; it just takes an extra Simplifier iteration to undo.) This choice is + made by `ok_to_dup_alt`. + + This plan generates a lot of join points, but makes them much more + case-of-case friendly. + +(DJ3) When does a join point definitely inline unconditionally? That is, when + the UnfoldingGuidance is UnfWhen: the rhs of the join point is smaller than + the call. More specifically `ok_to_dup_alt` looks for + * (exprIsTrivial rhs); this includes uses of unsafeEqualityProof etc; seee + the defn of exprIsTrivial. + * the RHS is a call (f x y z), where the arguments are all trivial and f is not + data constructor + * if the RHS /is/ a data constructor we check whether all the args are bound by + the join-point lambdas; if so there is no point in creating a join point. But + if not (e.g. j x = K f x), then we /do/ want to creat a join point; see + the discussion of #19996 above. + +(DJ4) By the same token we want to use Plan B in Note [Duplicating StrictArg] when + the RHS of the new join point is a data constructor application. See the + call to isDataConId in the StrictArg case of mkDupableContWithDmds. + + That same Note [Duplicating StrictArg] explains why we sometimes want Plan A + when the RHS of the new join point would be a non-data-constructor + application + +(DJ5) You might worry that $j will be inlined by the call-site inliner, but it + won't because the call-site context for a join is usually extremely boring + (the arguments come from the pattern match). And if not, then perhaps + inlining it would be a good idea. + + You might also wonder if we get UnfWhen, because the RHS of the join point is + no bigger than the call. But in the cases we care about it will be a little + bigger, because of that free `f` in $j x = K f x So for now we don't do + anything special in callSiteInline + +There is a bit of tension between (DJ2) and (DJ3). Do we want to retain the join point only when the RHS is * a constructor application? or * just non-trivial? Currently, a bit ad-hoc, but we definitely want to retain the join -point for data constructors in mkDupableALt (point 2); that is the +point for data constructors in mkDupableALt (DJ2); that is the whole point of #19996 described above. Historical Note [Case binders and join points] @@ -4567,17 +4556,6 @@ Wrinkles in GHC.Core.Opt.Simplify.Utils. We uphold this because the join-point case (bind_cxt = BC_Join {}) doesn't use eta_expand. -Note [Heavily used join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -After inining join points we can end up with - let $j x = - in case x1 of - True -> case x2 of - True -> $j blah1 - False -> $j blah2 - False -> case x3 of .... -with a huge case tree - Note [Force bottoming field] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We need to force bottoming, or the new unfolding holds ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1266,8 +1266,11 @@ exprIsCheapX ok_app e go _ (Type {}) = True go _ (Coercion {}) = True go n (Cast e _) = go n e - go n (Case scrut _ _ alts) = ok scrut && - and [ go n rhs | Alt _ _ rhs <- alts ] + go n (Case scrut _ _ alts) + | [Alt _ _ rhs] <- alts = ok scrut && ok rhs + | otherwise = False +-- go n (Case scrut _ _ alts) = ok scrut && +-- and [ go n rhs | Alt _ _ rhs <- alts ] go n (Tick t e) | tickishCounts t = False | otherwise = go n e go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8cb0ea96671889e2c39245f82952454af4ba86e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8cb0ea96671889e2c39245f82952454af4ba86e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 23:23:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 31 Jul 2023 19:23:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 20 commits: JS: implement getMonotonicTime (fix #23687) Message-ID: <64c8426e9373e_2f1200ba3c44281cb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 26eb6c21 by Sylvain Henry at 2023-07-31T19:23:09-04:00 JS: implement getMonotonicTime (fix #23687) - - - - - 20fca42d by Bartłomiej Cieślar at 2023-07-31T19:23:12-04:00 Implementation of the Deprecated Instances proposal #575 This commit implements the ability to deprecate certain instances, which causes the compiler to emit the desired deprecation message whenever they are instantiated. For example: module A where class C t where instance {-# DEPRECATED "dont use" #-} C Int where module B where import A f :: C t => t f = undefined g :: Int g = f -- "dont use" emitted here The implementation is as follows: - In the parser, we parse deprecations/warnings attached to instances: instance {-# DEPRECATED "msg" #-} Show X deriving instance {-# WARNING "msg2" #-} Eq Y (Note that non-standalone deriving instance declarations do not support this mechanism.) - We store the resulting warning message in `ClsInstDecl` (respectively, `DerivDecl`). In `GHC.Tc.TyCl.Instance.tcClsInstDecl` (respectively, `GHC.Tc.Deriv.Utils.newDerivClsInst`), we pass on that information to `ClsInst` (and eventually store it in `IfaceClsInst` too). - Finally, when we solve a constraint using such an instance, in `GHC.Tc.Instance.Class.matchInstEnv`, we emit the appropriate warning that was stored in `ClsInst`. Note that we only emit a warning when the instance is used in a different module than it is defined, which keeps the behaviour in line with the deprecation of top-level identifiers. Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - edd428fc by Matthew Pickering at 2023-07-31T19:23:13-04:00 ci: Pass -Werror when building hadrian in hadrian-ghc-in-ghci job Warnings when building Hadrian can end up cluttering the output of HLS, and we've had bug reports in the past about these warnings when building Hadrian. It would be nice to turn on -Werror on at least one build of Hadrian in CI to avoid a patch introducing warnings when building Hadrian. Fixes #23638 - - - - - 0d3ec9bf by Ben Gamari at 2023-07-31T19:23:14-04:00 compiler: Style fixes - - - - - e07ebd26 by Ben Gamari at 2023-07-31T19:23:14-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 0f186181 by Ben Gamari at 2023-07-31T19:23:14-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - b0e7aa27 by Ben Gamari at 2023-07-31T19:23:14-04:00 testsuite: Add AtomicModifyIORef test - - - - - 2b99bbd3 by Ben Gamari at 2023-07-31T19:23:14-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 942a5b6b by Ben Gamari at 2023-07-31T19:23:14-04:00 rts: Simplify atomicModifyMutVar2# implementation Previously we would perform a redundant load in the non-threaded RTS in atomicModifyMutVar2# implementation for the benefit of the non-moving GC's write barrier. Eliminate this. - - - - - 3f11fff0 by Ben Gamari at 2023-07-31T19:23:14-04:00 rts: Introduce more principled fence operations - - - - - aead566d by Ben Gamari at 2023-07-31T19:23:14-04:00 rts: Introduce SET_INFO_RELAXED - - - - - abfbac1b by Ben Gamari at 2023-07-31T19:23:14-04:00 rts: Style fixes - - - - - 95bc1222 by Ben Gamari at 2023-07-31T19:23:14-04:00 codeGen/tsan: Rework handling of spilling - - - - - 3547febc by Ben Gamari at 2023-07-31T19:23:14-04:00 hadrian: More debug information - - - - - 07ff8bba by Ben Gamari at 2023-07-31T19:23:14-04:00 Improve TSAN documentation - - - - - 3d633a32 by Ben Gamari at 2023-07-31T19:23:14-04:00 hadrian: More selective TSAN instrumentation - - - - - 6204a771 by Alan Zimmerman at 2023-07-31T19:23:15-04:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. Metric Decrease: T9961 T5205 Metric Increase: T13035 - - - - - 116de499 by Bartłomiej Cieślar at 2023-07-31T19:23:19-04:00 Add cases to T23279: HasField for deprecated record fields This commit adds additional tests from ticket #23279 to ensure that we don't regress on reporting deprecated record fields in conjunction with HasField, either when using overloaded record dot syntax or directly through `getField`. Fixes #23279 - - - - - 76985e7c by Andreas Klebinger at 2023-07-31T19:23:20-04:00 AArch NCG: Pure refactor Combine some alternatives. Add some line breaks for overly long lines - - - - - 52036ca4 by Andreas Klebinger at 2023-07-31T19:23:20-04:00 Aarch ncg: Optimize immediate use for address calculations When the offset doesn't fit into the immediate we now just reuse the general getRegister' code path which is well optimized to compute the offset into a register instead of a special case for CmmRegOff. This means we generate a lot less code under certain conditions which is why performance metrics for these improve. ------------------------- Metric Decrease: T4801 T5321FD T5321Fun ------------------------- - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Unit/Module/Warnings.hs - docs/users_guide/exts/pragmas.rst - hadrian/ghci-cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/929bb674489e31e1f28d09d801c8ff79ad58c0fe...52036ca4bbdf1e883f6a009b06daa8233d1e4529 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/929bb674489e31e1f28d09d801c8ff79ad58c0fe...52036ca4bbdf1e883f6a009b06daa8233d1e4529 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Jul 31 23:36:18 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 31 Jul 2023 19:36:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/dlsym-cache Message-ID: <64c845727ed06_2f1200ba3604437f4@gitlab.mail> Ben Gamari pushed new branch wip/dlsym-cache at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/dlsym-cache You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: